diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 246eb7e..ab6549c 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -75,6 +75,7 @@ import Control.Monad.Logger import Data.Aeson import Data.HexString (HexString(..), toText) import Data.Maybe +import Data.Scientific (Scientific, scientific) import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Time.Clock.POSIX (posixSecondsToUTCTime) @@ -119,10 +120,10 @@ import Zenith.Types import Zenith.Utils ( displayTaz , displayZec + , getChainTip , isRecipientValid , isRecipientValidGUI , jsonNumber - , parseAddressUA , showAddress , validBarValue ) @@ -159,7 +160,7 @@ makeLenses ''DialogInput data SendInput = SendInput { _sendTo :: !T.Text - , _sendAmt :: !Float + , _sendAmt :: !Scientific , _sendMemo :: !T.Text , _policyField :: !PrivacyPolicy } deriving (Show) @@ -174,7 +175,7 @@ data AdrBookEntry = AdrBookEntry makeLenses ''AdrBookEntry newtype ShDshEntry = ShDshEntry - { _shAmt :: Float + { _shAmt :: Scientific } deriving (Show) makeLenses ''ShDshEntry @@ -701,8 +702,8 @@ mkSendForm bal = , label "Memo: " @@= editTextField sendMemo MemoField (Just 1) ] where - isAmountValid :: Integer -> Float -> Bool - isAmountValid b i = (fromIntegral b / 100000000.0) >= i + isAmountValid :: Integer -> Scientific -> Bool + isAmountValid b i = fromIntegral b >= (i * scientific 1 8) label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w @@ -713,8 +714,8 @@ mkDeshieldForm tbal = editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal) ] where - isAmountValid :: Integer -> Float -> Bool - isAmountValid b i = (fromIntegral b / 100000000.0) >= i + isAmountValid :: Integer -> Scientific -> Bool + isAmountValid b i = fromIntegral b >= (i * scientific 1 8) label s 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 $ "dbBlock: " <> T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) - when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock let sb = if chkBlock == dbBlock then max dbBlock b else max chkBlock b + when (chkBlock /= dbBlock && chkBlock /= 1) $ rewindWalletData pool sb if sb > zgb_blocks bStatus || sb < 1 then do liftIO $ @@ -1201,7 +1202,8 @@ appEvent (BT.VtyEvent e) = do Just (_k, w) -> return w fs1 <- BT.zoom txForm $ BT.gets formState bl <- - liftIO $ getLastSyncBlock pool $ entityKey selWal + liftIO $ + getChainTip (s ^. zebraHost) (s ^. zebraPort) _ <- liftIO $ forkIO $ @@ -1212,7 +1214,7 @@ appEvent (BT.VtyEvent e) = do (s ^. zebraPort) (s ^. network) (entityKey selAcc) - bl + (bl + 5) (fs1 ^. sendAmt) (fs1 ^. sendTo) (fs1 ^. sendMemo) @@ -1292,7 +1294,8 @@ appEvent (BT.VtyEvent e) = do getUA . walletAddressUAddress) (entityVal selAddr))) bl <- - liftIO $ getLastSyncBlock pool $ entityKey selWal + liftIO $ + getChainTip (s ^. zebraHost) (s ^. zebraPort) case tAddrMaybe of Nothing -> do BT.modify $ @@ -1994,7 +1997,7 @@ sendTransaction :: -> ZcashNet -> ZcashAccountId -> Int - -> Float + -> Scientific -> T.Text -> T.Text -> 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" Just outUA -> do res <- - runNoLoggingT $ + runStderrLoggingT $ prepareTxV2 pool zHost @@ -2021,10 +2024,10 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do else Just memo) ] policy - BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." case res of Left e -> BC.writeBChan chan $ TickMsg $ show e Right rawTx -> do + BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." resp <- makeZebraCall zHost @@ -2073,7 +2076,7 @@ deshieldTransaction :: -> IO () deshieldTransaction pool chan zHost zPort znet accId bl pnote = do 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 Left e -> BC.writeBChan chan $ TickMsg $ show e Right rawTx -> do diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 5354440..9cdb015 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -23,11 +23,11 @@ import Data.Aeson import Data.Binary.Get hiding (getBytes) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS -import Data.Digest.Pure.MD5 -import Data.HexString (HexString, hexString, toBytes, toText) +import Data.HexString (HexString, toBytes, toText) +import Data.Int (Int64) import Data.List 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.Encoding as E import Data.Time @@ -116,20 +116,25 @@ checkBlockChain nodeHost nodePort = do -- | Get commitment trees from Zebra getCommitmentTrees :: - T.Text -- ^ Host where `zebrad` is avaiable + ConnectionPool + -> T.Text -- ^ Host where `zebrad` is avaiable -> Int -- ^ Port where `zebrad` is available -> Int -- ^ Block height -> IO ZebraTreeInfo -getCommitmentTrees nodeHost nodePort block = do - r <- - makeZebraCall - nodeHost - nodePort - "z_gettreestate" - [Data.Aeson.String $ T.pack $ show block] - case r of - Left e -> throwIO $ userError e - Right zti -> return zti +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 <- + makeZebraCall + nodeHost + nodePort + "z_gettreestate" + [Data.Aeson.String $ toText bh] + case r of + Left e -> throwIO $ userError e + Right zti -> return zti -- * Spending Keys -- | Create an Orchard Spending Key for the given wallet and account index @@ -280,7 +285,7 @@ findSaplingOutputs :: -> Int -- ^ the starting block -> ZcashNetDB -- ^ The network -> Entity ZcashAccount -- ^ The account to use - -> LoggingT IO () + -> NoLoggingT IO () findSaplingOutputs config b znet za = do let dbPath = c_dbPath config let zebraHost = c_zebraHost config @@ -288,7 +293,7 @@ findSaplingOutputs config b znet za = do let zn = getNet znet pool <- liftIO $ runNoLoggingT $ initPool dbPath 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" let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees case sT of @@ -307,7 +312,7 @@ findSaplingOutputs config b znet za = do -> ZcashNet -> ConnectionPool -> [(Entity ZcashTransaction, Entity ShieldOutput)] - -> LoggingT IO () + -> NoLoggingT IO () decryptNotes _ _ _ [] = return () decryptNotes st n pool ((zt, o):txs) = do let updatedTree = @@ -395,7 +400,7 @@ findOrchardActions config b znet za = do let zn = getNet znet pool <- runNoLoggingT $ initPool dbPath tList <- getOrchardActions pool b znet - trees <- getCommitmentTrees zebraHost zebraPort (b - 1) + trees <- getCommitmentTrees pool zebraHost zebraPort (b - 1) let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees case sT of Nothing -> throwIO $ userError "Failed to read Orchard commitment tree" @@ -478,7 +483,7 @@ updateSaplingWitnesses pool = do updateOneNote maxId n = do let noteSync = walletSapNoteWitPos $ entityVal n 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 newWitness = updateSaplingWitness @@ -496,7 +501,7 @@ updateOrchardWitnesses pool = do updateOneNote maxId n = do let noteSync = walletOrchNoteWitPos $ entityVal n 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 newWitness = updateOrchardWitness @@ -534,7 +539,7 @@ prepareTx :: -> ZcashNet -> ZcashAccountId -> Int - -> Float + -> Scientific -> UnifiedAddress -> T.Text -> 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) logDebugN $ T.pack $ show recipient 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 oT = OrchardCommitmentTree $ ztiOrchard trees case accRead of @@ -564,76 +569,97 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do return $ Left ZHError Just acc -> do logDebugN $ T.pack $ show acc - let zats = floorFloatInteger $ amt * (10 ^ 8) - logDebugN $ T.pack $ show zats - {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} - --let fee = calculateTxFee firstPass $ fst recipient - --logDebugN $ T.pack $ "calculated fee " ++ show fee - (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000) - logDebugN "selected notes" - logDebugN $ T.pack $ show tList - logDebugN $ T.pack $ show sList - logDebugN $ T.pack $ show oList - let noteTotal = getTotalAmount (tList, sList, oList) - tSpends <- - liftIO $ - prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList - --print tSpends - sSpends <- - liftIO $ - prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList - --print sSpends - oSpends <- - liftIO $ - prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList - --print oSpends - dummy <- - liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats) - logDebugN "Calculating fee" - let feeResponse = - createTransaction - (Just sT) - (Just oT) - tSpends - sSpends - oSpends - dummy - zn - (bh + 3) - False - case feeResponse of - Left e1 -> return $ Left Fee - Right fee -> do - let feeAmt = - fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee) - (tList1, sList1, oList1) <- - liftIO $ selectUnspentNotes pool za (zats + feeAmt) - logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt + let zats' = toBoundedInteger $ amt * scientific 1 8 + case zats' of + Nothing -> return $ Left ZHError + Just zats -> do + logDebugN $ T.pack $ show (zats :: Int64) + {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} + --let fee = calculateTxFee firstPass $ fst recipient + --logDebugN $ T.pack $ "calculated fee " ++ show fee + (tList, sList, oList) <- + liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000) + logDebugN "selected notes" logDebugN $ T.pack $ show tList logDebugN $ T.pack $ show sList logDebugN $ T.pack $ show oList - outgoing <- - liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats) - logDebugN $ T.pack $ show outgoing - let tx = + let noteTotal = getTotalAmount (tList, sList, oList) + tSpends <- + liftIO $ + prepTSpends + (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) + tList + --print tSpends + sSpends <- + liftIO $ + prepSSpends + (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) + sList + --print sSpends + oSpends <- + liftIO $ + prepOSpends + (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) + oList + --print oSpends + dummy <- + liftIO $ + makeOutgoing + acc + recipient + zats + (fromInteger noteTotal - 5000 - zats) + logDebugN "Calculating fee" + let feeResponse = createTransaction (Just sT) (Just oT) tSpends sSpends oSpends - outgoing + dummy zn - (bh + 3) - True - logDebugN $ T.pack $ show tx - return tx + bh + False + case feeResponse of + Left e1 -> return $ Left Fee + Right fee -> do + let feeAmt = + fromIntegral + (runGet getInt64le $ LBS.fromStrict $ toBytes fee) + (tList1, sList1, oList1) <- + liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt) + logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt + logDebugN $ T.pack $ show tList + logDebugN $ T.pack $ show sList + logDebugN $ T.pack $ show oList + outgoing <- + liftIO $ + makeOutgoing + acc + recipient + zats + (fromInteger noteTotal - fromInteger feeAmt - zats) + logDebugN $ T.pack $ show outgoing + let tx = + createTransaction + (Just sT) + (Just oT) + tSpends + sSpends + oSpends + outgoing + zn + bh + True + logDebugN $ T.pack $ show tx + return tx where makeOutgoing :: Entity ZcashAccount -> (Int, BS.ByteString) - -> Integer - -> Integer + -> Int64 + -> Int64 -> IO [OutgoingNote] makeOutgoing acc (k, recvr) zats chg = do chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc @@ -752,11 +778,11 @@ deshieldNotes :: -> ZcashAccountId -> Int -> ProposedNote - -> NoLoggingT IO (Either TxError HexString) + -> LoggingT IO (Either TxError HexString) deshieldNotes pool zebraHost zebraPort znet za bh pnote = do bal <- liftIO $ getShieldedBalance pool za - let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8) - if bal > (20000 + zats) + let zats = pn_amt pnote * scientific 1 8 + if fromInteger bal > (scientific 2 4 + zats) then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low else return $ Left InsufficientFunds @@ -771,9 +797,11 @@ shieldTransparentNotes :: shieldTransparentNotes pool zebraHost zebraPort znet za bh = do accRead <- liftIO $ getAccountById pool za logDebugN $ T.pack $ "Target block: " ++ show bh - trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh - let sT = SaplingCommitmentTree $ ztiSapling trees - let oT = OrchardCommitmentTree $ ztiOrchard trees + {- + -trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh + -let sT = SaplingCommitmentTree $ ztiSapling trees + -let oT = OrchardCommitmentTree $ ztiOrchard trees + -} case accRead of Nothing -> do logErrorN "Can't find Account" @@ -810,8 +838,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do True let tx = createTransaction - (Just sT) - (Just oT) + Nothing + Nothing tSpends [] [] @@ -871,15 +899,17 @@ prepareTxV2 :: -> Int -> [ProposedNote] -> PrivacyPolicy - -> NoLoggingT IO (Either TxError HexString) + -> LoggingT IO (Either TxError HexString) prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do accRead <- liftIO $ getAccountById pool za let recipients = map extractReceiver pnotes logDebugN $ T.pack $ show recipients logDebugN $ T.pack $ "Target block: " ++ show bh - trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh - let sT = SaplingCommitmentTree $ ztiSapling trees - let oT = OrchardCommitmentTree $ ztiOrchard trees + {- + -trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh + -let sT = SaplingCommitmentTree $ ztiSapling trees + -let oT = OrchardCommitmentTree $ ztiOrchard trees + -} case accRead of Nothing -> do logErrorN "Can't find Account" @@ -887,164 +917,199 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do Just acc -> do logDebugN $ T.pack $ show acc let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes - let zats = ceilingFloatInteger $ amt * (10 ^ 8) - logDebugN $ "amt: " <> T.pack (show amt) - logDebugN $ "zats: " <> T.pack (show zats) - {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} - --let fee = calculateTxFee firstPass $ fst recipient - --logDebugN $ T.pack $ "calculated fee " ++ show fee - notePlan <- - liftIO $ - selectUnspentNotesV2 - pool - za - (zats + 10000) - (map (\(x, _, _, _) -> x) recipients) - policy - case notePlan of - Right (tList, sList, oList) -> do - logDebugN "selected notes" - logDebugN $ T.pack $ show tList - logDebugN $ T.pack $ show sList - logDebugN $ T.pack $ show oList - let noteTotal = getTotalAmount (tList, sList, oList) - logDebugN $ "noteTotal: " <> T.pack (show noteTotal) - tSpends <- + 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 $ "zats: " <> T.pack (show zats) + {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} + --let fee = calculateTxFee firstPass $ fst recipient + --logDebugN $ T.pack $ "calculated fee " ++ show fee + notePlan <- liftIO $ - prepTSpends - (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) - tList - --print tSpends - sSpends <- - liftIO $ - prepSSpends - (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) - sList - --print sSpends - oSpends <- - liftIO $ - prepOSpends - (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) - oList - --print oSpends - dummy' <- - liftIO $ - makeOutgoing acc recipients (noteTotal - 5000 - zats) policy - case dummy' of - Left e -> return $ Left e - Right dummy -> do - logDebugN "Calculating fee" - let feeResponse = - createTransaction - (Just sT) - (Just oT) - tSpends - sSpends - oSpends - dummy - zn - bh - False - case feeResponse of - Left e1 -> return $ Left Fee - Right fee -> do - let feeAmt = - fromIntegral - (runGet getInt64le $ LBS.fromStrict $ toBytes fee) - finalNotePlan <- - liftIO $ - selectUnspentNotesV2 - pool - za - (zats + feeAmt) - (map (\(x, _, _, _) -> x) recipients) - policy - 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 <- + selectUnspentNotesV2 + pool + za + (zats + 10000) + (map (\(x, _, _, _) -> x) recipients) + policy + case notePlan of + Right (tList, sList, oList) -> do + logDebugN "selected notes" + logDebugN $ T.pack $ show tList + logDebugN $ T.pack $ show sList + logDebugN $ T.pack $ show oList + let noteTotal = getTotalAmount (tList, sList, oList) + logDebugN $ "noteTotal: " <> T.pack (show noteTotal) + tSpends <- + liftIO $ + prepTSpends + (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) + tList + --print tSpends + sSpends <- + liftIO $ + prepSSpends + (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) + sList + --print sSpends + oSpends <- + liftIO $ + prepOSpends + (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) + oList + --print oSpends + dummy' <- + liftIO $ + makeOutgoing + acc + recipients + (noteTotal - 5000 - fromIntegral zats) + policy + case dummy' of + Left e -> return $ Left e + Right dummy -> do + logDebugN "Calculating fee" + let feeResponse = + createTransaction + Nothing + Nothing + tSpends + sSpends + oSpends + dummy + zn + bh + False + case feeResponse of + Left e1 -> return $ Left Fee + Right fee -> do + let feeAmt = + fromIntegral + (runGet getInt64le $ LBS.fromStrict $ toBytes fee) + finalNotePlan <- 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 - recipients - (noteTotal1 - feeAmt - zats) + selectUnspentNotesV2 + pool + za + (fromIntegral zats + feeAmt) + (map (\(x, _, _, _) -> x) recipients) policy - logDebugN $ T.pack $ show outgoing' - case outgoing' of + 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 + recipients + (noteTotal1 - feeAmt - fromIntegral zats) + policy + logDebugN $ T.pack $ show outgoing' + case outgoing' of + Left e -> return $ Left e + Right outgoing -> do + let tx = + createTransaction + Nothing + Nothing + tSpends1 + sSpends1 + oSpends1 + outgoing + zn + bh + True + logDebugN $ T.pack $ show tx + return tx Left e -> return $ Left e - Right outgoing -> do - let tx = - createTransaction - (Just sT) - (Just oT) - tSpends1 - sSpends1 - oSpends1 - outgoing - zn - bh - True - logDebugN $ T.pack $ show tx - return tx - Left e -> return $ Left e - Left e -> do - logErrorN $ T.pack $ show e - return $ Left e + Left e -> do + logErrorN $ T.pack $ show e + return $ Left e where - extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text) + extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int64, T.Text) extractReceiver (ProposedNote (ValidAddressAPI va) amt m) = - let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) - in case va of - Unified ua -> - case o_rec ua of - Nothing -> - case s_rec ua of + let zats' = toBoundedInteger $ amt * scientific 1 8 + in case zats' of + Nothing -> (0, "", 0, "") + Just zats -> + case va of + Unified ua -> + case o_rec ua of Nothing -> - case t_rec ua of - Nothing -> (0, "", 0, "") - Just r3 -> - case tr_type r3 of - P2PKH -> - (1, toBytes $ tr_bytes r3, zats, fromMaybe "" m) - P2SH -> - (2, toBytes $ tr_bytes r3, zats, fromMaybe "" m) - Just r2 -> (3, getBytes r2, zats, fromMaybe "" m) - Just r1 -> (4, getBytes r1, zats, fromMaybe "" m) - Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m) - Transparent ta -> - case tr_type (ta_receiver ta) of - P2PKH -> - (1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) - P2SH -> - (2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) - Exchange ea -> - case tr_type (ex_address ea) of - P2PKH -> - (5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) - P2SH -> - (6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) + case s_rec ua of + Nothing -> + case t_rec ua of + Nothing -> (0, "", 0, "") + Just r3 -> + case tr_type r3 of + P2PKH -> + ( 1 + , toBytes $ tr_bytes r3 + , zats + , fromMaybe "" m) + P2SH -> + ( 2 + , toBytes $ tr_bytes r3 + , zats + , fromMaybe "" m) + Just r2 -> (3, getBytes r2, zats, fromMaybe "" m) + Just r1 -> (4, getBytes r1, zats, fromMaybe "" m) + Sapling sa -> + (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m) + Transparent ta -> + case tr_type (ta_receiver ta) of + P2PKH -> + ( 1 + , toBytes $ tr_bytes (ta_receiver ta) + , zats + , fromMaybe "" m) + P2SH -> + ( 2 + , toBytes $ tr_bytes (ta_receiver ta) + , zats + , fromMaybe "" m) + Exchange ea -> + case tr_type (ex_address ea) of + P2PKH -> + ( 5 + , toBytes $ tr_bytes (ex_address ea) + , zats + , fromMaybe "" m) + P2SH -> + ( 6 + , toBytes $ tr_bytes (ex_address ea) + , zats + , fromMaybe "" m) prepareOutgoingNote :: - ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote + ZcashAccount -> (Int, BS.ByteString, Int64, T.Text) -> OutgoingNote prepareOutgoingNote zac (k, r, a, m) = OutgoingNote (if k == 5 @@ -1062,8 +1127,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do False makeOutgoing :: Entity ZcashAccount - -> [(Int, BS.ByteString, Int, T.Text)] - -> Integer + -> [(Int, BS.ByteString, Int64, T.Text)] + -> Int64 -> PrivacyPolicy -> IO (Either TxError [OutgoingNote]) makeOutgoing acc recvs chg pol = do @@ -1195,7 +1260,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do ( [Entity WalletTrNote] , [Entity WalletSapNote] , [Entity WalletOrchNote]) - -> Integer + -> Int64 getTotalAmount (t, s, o) = sum (map (fromIntegral . walletTrNoteValue . entityVal) t) + sum (map (fromIntegral . walletSapNoteValue . entityVal) s) + @@ -1300,16 +1365,18 @@ syncWallet config w = do let startBlock = if lastBlock > 0 then lastBlock - else zcashWalletBirthdayHeight $ entityVal w + else 1 + zcashWalletBirthdayHeight (entityVal w) logDebugN $ "start block: " <> T.pack (show startBlock) mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs logDebugN "processed transparent notes" mapM_ (liftIO . findTransparentSpends pool . entityKey) accs logDebugN "processed transparent spends" - mapM_ - (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) - accs + liftIO $ + runNoLoggingT $ + mapM_ + (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) + accs logDebugN "processed sapling outputs" liftIO $ mapM_ diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 50a33cc..18882cc 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -698,6 +698,7 @@ saveAddress pool w = runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w +-- * Block -- | Save a block to the database saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock) saveBlock pool b = @@ -714,6 +715,20 @@ getBlock pool b = where_ $ bl ^. ZcashBlockHeight ==. val b 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 saveTransaction :: ConnectionPool -- ^ the database path @@ -1776,12 +1791,16 @@ getUnspentSapNotes pool = do where_ (n ^. WalletSapNoteSpent ==. val False) pure n -getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB] -getSaplingCmus pool zt = do +getSaplingCmus :: + ConnectionPool + -> ShieldOutputId + -> ShieldOutputId + -> IO [Value HexStringDB] +getSaplingCmus pool zt m = do PS.runSqlPool (select $ do n <- from $ table @ShieldOutput - where_ (n ^. ShieldOutputId >. val zt) + where_ (n ^. ShieldOutputId >. val zt &&. n ^. ShieldOutputId <=. val m) orderBy [asc $ n ^. ShieldOutputId] pure $ n ^. ShieldOutputCmu) pool @@ -1840,12 +1859,13 @@ getUnspentOrchNotes pool = do where_ (n ^. WalletOrchNoteSpent ==. val False) pure n -getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB] -getOrchardCmxs pool zt = do +getOrchardCmxs :: + ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB] +getOrchardCmxs pool zt m = do PS.runSqlPool (select $ do n <- from $ table @OrchAction - where_ (n ^. OrchActionId >. val zt) + where_ (n ^. OrchActionId >. val zt &&. n ^. OrchActionId <=. val m) orderBy [asc $ n ^. OrchActionId] pure $ n ^. OrchActionCmx) pool @@ -2339,7 +2359,7 @@ selectUnspentNotes pool za amt = do selectUnspentNotesV2 :: ConnectionPool -> ZcashAccountId - -> Integer + -> Int64 -> [Int] -> PrivacyPolicy -> IO diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 8d71d0a..19003a0 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -17,6 +17,7 @@ import Data.Aeson import qualified Data.ByteString as BS import Data.HexString (toText) import Data.Maybe (fromMaybe, isJust, isNothing) +import Data.Scientific (Scientific, fromFloatDigits) import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Time.Clock.POSIX (posixSecondsToUTCTime) @@ -1244,7 +1245,7 @@ handleEvent wenv node model evt = (model ^. network) (entityKey acc) (zcashWalletLastSync $ entityVal wal) - (model ^. sendAmount) + (fromFloatDigits $ model ^. sendAmount) (model ^. sendRecipient) (model ^. sendMemo) (model ^. privacyChoice) @@ -1631,12 +1632,12 @@ scanZebra dbPath zHost zPort net sendMsg = do if syncChk then sendMsg (ShowError "Sync already in progress") else do - unless (chkBlock == dbBlock) $ - runStderrLoggingT $ rewindWalletData pool chkBlock let sb = if chkBlock == dbBlock then max dbBlock b else max chkBlock b + unless (chkBlock == dbBlock || chkBlock == 1) $ + runStderrLoggingT $ rewindWalletData pool sb if sb > zgb_blocks bStatus || sb < 1 then sendMsg (ShowError "Invalid starting block for scan") else do @@ -1701,7 +1702,7 @@ sendTransaction :: -> ZcashNet -> ZcashAccountId -> Int - -> Float + -> Scientific -> T.Text -> T.Text -> PrivacyPolicy @@ -1717,7 +1718,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do let zPort = c_zebraPort config pool <- runNoLoggingT $ initPool dbPath res <- - runNoLoggingT $ + runStderrLoggingT $ prepareTxV2 pool zHost diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index 898b662..a88e014 100644 --- a/src/Zenith/RPC.hs +++ b/src/Zenith/RPC.hs @@ -833,7 +833,7 @@ zenithServer state = getinfo :<|> handleRPC forkIO $ do res <- liftIO $ - runNoLoggingT $ + runStderrLoggingT $ prepareTxV2 pool zHost @@ -892,12 +892,12 @@ scanZebra dbPath zHost zPort net = do chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 syncChk <- isSyncing pool unless syncChk $ do - unless (chkBlock == dbBlock) $ - runStderrLoggingT $ rewindWalletData pool chkBlock let sb = if chkBlock == dbBlock then max dbBlock b else max chkBlock b + unless (chkBlock == dbBlock || chkBlock == 1) $ + runStderrLoggingT $ rewindWalletData pool sb unless (sb > zgb_blocks bStatus || sb < 1) $ do let bList = [(sb + 1) .. (zgb_blocks bStatus)] unless (null bList) $ do diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 4692327..f71b6c3 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as C import Data.HexString import Data.Int (Int64) import Data.Maybe (fromMaybe) +import Data.Scientific (Scientific) import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Text.Encoding.Error (lenientDecode) @@ -241,7 +242,7 @@ instance ToJSON ValidAddressAPI where data ProposedNote = ProposedNote { pn_addr :: !ValidAddressAPI - , pn_amt :: !Float + , pn_amt :: !Scientific , pn_memo :: !(Maybe T.Text) } deriving (Eq, Prelude.Show) diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index b9355f0..c3b74ee 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -13,26 +13,31 @@ import qualified Data.Text.Encoding as E import System.Directory import System.Process (createProcess_, shell) import Text.Regex.Posix -import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress) +import ZcashHaskell.Orchard + ( encodeUnifiedAddress + , isValidUnifiedAddress + , parseAddress + ) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent ( decodeExchangeAddress , decodeTransparentAddress ) import ZcashHaskell.Types - ( SaplingAddress(..) + ( ExchangeAddress(..) + , SaplingAddress(..) , TransparentAddress(..) , UnifiedAddress(..) - , ZcashNet(..) , ValidAddress(..) - , ExchangeAddress(..) + , ZcashNet(..) ) +import ZcashHaskell.Utils (makeZebraCall) import Zenith.Types ( AddressGroup(..) + , PrivacyPolicy(..) , UnifiedAddressDB(..) , ZcashAddress(..) , ZcashPool(..) - , PrivacyPolicy(..) ) -- | Helper function to convert numbers into JSON @@ -127,9 +132,9 @@ isRecipientValid a = do isUnifiedAddressValid :: T.Text -> Bool isUnifiedAddressValid ua = - case isValidUnifiedAddress (E.encodeUtf8 ua) of - Just _a1 -> True - Nothing -> False + case isValidUnifiedAddress (E.encodeUtf8 ua) of + Just _a1 -> True + Nothing -> False isSaplingAddressValid :: T.Text -> Bool isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa) @@ -137,8 +142,8 @@ isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa) isTransparentAddressValid :: T.Text -> Bool isTransparentAddressValid ta = case decodeTransparentAddress (E.encodeUtf8 ta) of - Just _a3 -> True - Nothing -> False + Just _a3 -> True + Nothing -> False isExchangeAddressValid :: T.Text -> Bool isExchangeAddressValid xa = @@ -147,40 +152,44 @@ isExchangeAddressValid xa = Nothing -> False isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool -isRecipientValidGUI p a = do +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 - _ -> False - Nothing -> False - None -> case adr of - Just a -> - case a of - Transparent ta -> True - Exchange ea -> True - _ -> False - Nothing -> False + 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 + _ -> 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 :: T.Text -> Bool isZecAddressValid a = do case isValidUnifiedAddress (E.encodeUtf8 a) of Just _a1 -> True @@ -232,3 +241,10 @@ padWithZero n s isEmpty :: [a] -> Bool isEmpty [] = True 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 diff --git a/test/Spec.hs b/test/Spec.hs index d827eb2..fac84fd 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,6 +2,7 @@ import Control.Monad (when) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) +import Data.Aeson import Data.HexString import Data.Maybe (fromJust) import qualified Data.Text.Encoding as E @@ -33,8 +34,10 @@ import ZcashHaskell.Types , Scope(..) , ShieldedOutput(..) , TxError(..) + , ValidAddress(..) , ZcashNet(..) ) +import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction) import Zenith.Core import Zenith.DB import Zenith.Types @@ -182,6 +185,12 @@ main = do a `shouldBe` Just "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 xit "Check Orchard notes" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" @@ -573,3 +582,17 @@ main = do case tx of Left e -> assertFailure $ show e 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