diff --git a/app/Main.hs b/app/Main.hs index 2547ab8..f3d4b4c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -230,6 +230,7 @@ main = do "gui" -> runZenithGUI myConfig "tui" -> runZenithTUI myConfig "rescan" -> rescanZebra zebraHost zebraPort dbFilePath + "resync" -> clearSync myConfig _ -> printUsage else printUsage diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 33626f5..3de9e91 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -91,6 +91,7 @@ import Zenith.DB import Zenith.Scanner (processTx, rescanZebra, updateConfs) import Zenith.Types ( Config(..) + , HexStringDB(..) , PhraseDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) @@ -765,16 +766,16 @@ scanZebra dbP zHost zPort b eChan znet = do Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Right hb -> do let blockTime = getBlockTime hb - mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $ - bl_txs $ addTime blk blockTime + bi <- + saveBlock pool $ + 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 - 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.AppEvent t) = do diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index abf064b..83f27d0 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -772,98 +772,254 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do {-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 <- + 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 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 + selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) 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 - outgoing <- - liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats) - logDebugN $ T.pack $ show outgoing - let tx = - createTransaction - (Just sT) - (Just oT) - tSpends - sSpends - oSpends - outgoing - zn - (bh + 3) - True - logDebugN $ T.pack $ show tx - return 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 (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 + 3) + 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) + (fst recipient) + 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 <- + 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 = + createTransaction + (Just sT) + (Just oT) + tSpends1 + sSpends1 + oSpends1 + outgoing + zn + (bh + 3) + True + logDebugN $ T.pack $ show tx + return tx + Left e -> return $ Left e + Left e -> do + logErrorN $ T.pack $ show e + return $ Left e where makeOutgoing :: Entity ZcashAccount -> (Int, BS.ByteString) -> Integer -> Integer - -> IO [OutgoingNote] - makeOutgoing acc (k, recvr) zats chg = do + -> PrivacyPolicy + -> IO (Either TxError [OutgoingNote]) + makeOutgoing acc (k, recvr) zats chg policy = do chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr - 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 -> - getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc - 3 -> - getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc - _ -> "") - recvr - (fromIntegral zats) - (E.encodeUtf8 memo) - False - ] + case k of + 4 -> + case policy of + 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 -> + case policy of + 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 + (fromIntegral zats) + (E.encodeUtf8 memo) + 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 :: ( [Entity WalletTrNote] , [Entity WalletSapNote] diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index b2b8db6..82645ae 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -18,7 +18,7 @@ module Zenith.DB where -import Control.Exception (SomeException(..), throwIO, try) +import Control.Exception (SomeException(..), throw, throwIO, try) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger (NoLoggingT, runNoLoggingT) @@ -69,6 +69,7 @@ import ZcashHaskell.Types , TransparentAddress(..) , TransparentBundle(..) , TransparentReceiver(..) + , TxError(..) , UnifiedAddress(..) , ValidAddress(..) , ZcashNet(..) @@ -78,6 +79,7 @@ import Zenith.Types , HexStringDB(..) , OrchardSpendingKeyDB(..) , PhraseDB(..) + , PrivacyPolicy(..) , RseedDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) @@ -202,13 +204,18 @@ share value Int64 UniqueOrchSpend tx accId deriving Show Eq - ZcashTransaction - block Int - txId HexStringDB + ZcashBlock + height Int + hash HexStringDB conf Int time Int network ZcashNetDB - UniqueTx block txId network + UniqueBlock height network + deriving Show Eq + ZcashTransaction + blockId ZcashBlockId OnDeleteCascade OnUpdateCascade + txId HexStringDB + UniqueTx blockId txId deriving Show Eq TransparentNote tx ZcashTransactionId @@ -579,14 +586,13 @@ getMaxBlock pool net = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do selectOne $ do - txs <- from $ table @ZcashTransaction - where_ (txs ^. ZcashTransactionBlock >. val 0) - where_ (txs ^. ZcashTransactionNetwork ==. val net) - orderBy [desc $ txs ^. ZcashTransactionBlock] - pure txs + bls <- from $ table @ZcashBlock + where_ (bls ^. ZcashBlockNetwork ==. val net) + orderBy [desc $ bls ^. ZcashBlockHeight] + pure bls case b of Nothing -> return $ -1 - Just x -> return $ zcashTransactionBlock $ entityVal x + Just x -> return $ zcashBlockHeight $ entityVal x -- | Returns a list of addresses associated with the given account getAddresses :: @@ -677,20 +683,22 @@ saveAddress pool w = runNoLoggingT $ 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 + -- | Save a transaction to the data model saveTransaction :: ConnectionPool -- ^ the database path - -> Int -- ^ block time - -> ZcashNetDB -- ^ the network + -> ZcashBlockId -- ^ The block the transaction is in -> Transaction -- ^ The transaction to save -> NoLoggingT IO (Key ZcashTransaction) -saveTransaction pool t n wt = +saveTransaction pool bi wt = PS.retryOnBusy $ flip PS.runSqlPool pool $ do let ix = [0 ..] - w <- - insert $ - ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n + w <- insert $ ZcashTransaction bi (HexStringDB $ tx_id wt) when (isJust $ tx_transpBundle wt) $ do _ <- insertMany_ $ @@ -776,10 +784,13 @@ getZcashTransactions pool b net = PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - txs <- from $ table @ZcashTransaction - where_ (txs ^. ZcashTransactionBlock >. val b) - where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net)) - orderBy [asc $ txs ^. ZcashTransactionBlock] + (blks :& txs) <- + from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` + (\(blks :& txs) -> + blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) + where_ (blks ^. ZcashBlockHeight >. val b) + where_ (blks ^. ZcashBlockNetwork ==. val (ZcashNetDB net)) + orderBy [asc $ blks ^. ZcashBlockHeight] return txs -- ** QR codes @@ -876,16 +887,25 @@ saveWalletTransaction pool za zt = do runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do - t <- - upsert - (WalletTransaction - (zcashTransactionTxId zT') - za - (zcashTransactionBlock zT') - (zcashTransactionConf zT') - (zcashTransactionTime zT')) - [] - return $ entityKey t + 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 <- + upsert + (WalletTransaction + (zcashTransactionTxId zT') + za + (zcashBlockHeight $ entityVal blk) + (zcashBlockConf $ entityVal blk) + (zcashBlockTime $ entityVal blk)) + [] + return $ entityKey t -- | Save a @WalletSapNote@ saveWalletSapNote :: @@ -976,14 +996,17 @@ findTransparentNotes pool b net t = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - (txs :& tNotes) <- - from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on` - (\(txs :& tNotes) -> + (blks :& txs :& tNotes) <- + from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` + (\(blks :& txs) -> + blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin` + table @TransparentNote `on` + (\(_ :& txs :& tNotes) -> txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx) - where_ (txs ^. ZcashTransactionBlock >. val b) - where_ (txs ^. ZcashTransactionNetwork ==. val net) + where_ (blks ^. ZcashBlockHeight >. val b) + where_ (blks ^. ZcashBlockNetwork ==. val net) where_ (tNotes ^. TransparentNoteScript ==. val s) - pure (txs, tNotes) + pure (blks, txs, tNotes) mapM_ (saveWalletTrNote pool @@ -999,10 +1022,11 @@ saveWalletTrNote :: -> Scope -> ZcashAccountId -> WalletAddressId - -> (Entity ZcashTransaction, Entity TransparentNote) + -> (Entity ZcashBlock, Entity ZcashTransaction, Entity TransparentNote) -> IO () -saveWalletTrNote pool ch za wa (zt, tn) = do +saveWalletTrNote pool ch za wa (blk, zt, tn) = do let zT' = entityVal zt + let b = entityVal blk runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do @@ -1011,9 +1035,9 @@ saveWalletTrNote pool ch za wa (zt, tn) = do (WalletTransaction (zcashTransactionTxId zT') za - (zcashTransactionBlock zT') - (zcashTransactionConf zT') - (zcashTransactionTime zT')) + (zcashBlockHeight b) + (zcashBlockConf b) + (zcashBlockTime b)) [] insert_ $ WalletTrNote @@ -1042,12 +1066,15 @@ getShieldedOutputs pool b net = PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - (txs :& sOutputs) <- - from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on` - (\(txs :& sOutputs) -> + (blks :& txs :& sOutputs) <- + from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` + (\(blks :& txs) -> + blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin` + table @ShieldOutput `on` + (\(_ :& txs :& sOutputs) -> txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) - where_ (txs ^. ZcashTransactionBlock >=. val b) - where_ (txs ^. ZcashTransactionNetwork ==. val net) + where_ (blks ^. ZcashBlockHeight >=. val b) + where_ (blks ^. ZcashBlockNetwork ==. val net) orderBy [ asc $ txs ^. ZcashTransactionId , asc $ sOutputs ^. ShieldOutputPosition @@ -1065,12 +1092,15 @@ getOrchardActions pool b net = PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - (txs :& oActions) <- - from $ table @ZcashTransaction `innerJoin` table @OrchAction `on` - (\(txs :& oActions) -> + (blks :& txs :& oActions) <- + from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` + (\(blks :& txs) -> + blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin` + table @OrchAction `on` + (\(_ :& txs :& oActions) -> txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) - where_ (txs ^. ZcashTransactionBlock >=. val b) - where_ (txs ^. ZcashTransactionNetwork ==. val net) + where_ (blks ^. ZcashBlockHeight >=. val b) + where_ (blks ^. ZcashBlockNetwork ==. val net) orderBy [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] pure (txs, oActions) @@ -1640,15 +1670,23 @@ upsertWalTx :: => ZcashTransaction -> ZcashAccountId -> SqlPersistT m (Entity WalletTransaction) -upsertWalTx zt za = - upsert - (WalletTransaction - (zcashTransactionTxId zt) - za - (zcashTransactionBlock zt) - (zcashTransactionConf zt) - (zcashTransactionTime zt)) - [] +upsertWalTx zt za = do + 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 + (WalletTransaction + (zcashTransactionTxId zt) + za + (zcashBlockHeight $ entityVal b) + (zcashBlockConf $ entityVal b) + (zcashBlockTime $ entityVal b)) + [] getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int getSaplingOutIndex pool i = do @@ -1982,6 +2020,130 @@ selectUnspentNotes pool za amt = do , n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)) 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 :: ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB)) getWalletTxId pool wId = do @@ -2013,6 +2175,9 @@ saveConfs pool b c = do update $ \t -> do set t [WalletTransactionConf =. val c] 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 readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 12d67c5..dadb35a 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -1481,16 +1481,16 @@ scanZebra dbPath zHost zPort net sendMsg = do Left e2 -> sendMsg (ShowError $ showt e2) Right hb -> do let blockTime = getBlockTime hb - mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $ - bl_txs $ addTime blk blockTime + bi <- + saveBlock pool $ + 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) - addTime :: BlockResponse -> Int -> BlockResponse - addTime bl t = - BlockResponse - (bl_confirmations bl) - (bl_height bl) - (fromIntegral t) - (bl_txs bl) sendTransaction :: Config diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index 61b890e..8fee929 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -27,7 +27,9 @@ import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import Zenith.Core (checkBlockChain, syncWallet) import Zenith.DB - ( clearWalletData + ( ZcashBlock(..) + , ZcashBlockId + , clearWalletData , clearWalletTransactions , getMaxBlock , getMinBirthdayHeight @@ -35,11 +37,12 @@ import Zenith.DB , getWallets , initDb , initPool + , saveBlock , saveConfs , saveTransaction , updateWalletSync ) -import Zenith.Types (Config(..), ZcashNetDB(..)) +import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..)) import Zenith.Utils (jsonNumber) -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database @@ -119,28 +122,26 @@ processBlock host port pool pg net b = do Left e2 -> liftIO $ throwIO $ userError e2 Right hb -> do let blockTime = getBlockTime hb - mapM_ (processTx host port blockTime pool net) $ - bl_txs $ addTime blk blockTime + bi <- + saveBlock pool $ + 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 - 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 processTx :: T.Text -- ^ Host name for `zebrad` -> Int -- ^ Port for `zebrad` - -> Int -- ^ Block time + -> ZcashBlockId -- ^ Block ID -> ConnectionPool -- ^ DB file path - -> ZcashNetDB -- ^ the network -> HexString -- ^ transaction id -> IO () -processTx host port bt pool net t = do +processTx host port bt pool t = do r <- liftIO $ makeZebraCall @@ -156,7 +157,7 @@ processTx host port bt pool net t = do Just rzt -> do _ <- runNoLoggingT $ - saveTransaction pool bt net $ + saveTransaction pool bt $ Transaction t (ztr_blockheight rawTx) diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index f9c09b4..d109ab3 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -199,10 +199,11 @@ $(deriveJSON defaultOptions ''ZenithStatus) derivePersistField "ZenithStatus" data PrivacyPolicy - = Full - | Medium + = None | Low - | None + | Medium + | Full + deriving (Eq, Show, Read, Ord) $(deriveJSON defaultOptions ''PrivacyPolicy) diff --git a/test/Spec.hs b/test/Spec.hs index 9b4995c..3e5a4f6 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,15 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} import Control.Monad (when) -import Control.Monad.Logger (runNoLoggingT) +import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Data.HexString +import Data.Maybe (fromJust) import qualified Data.Text.Encoding as E import Database.Persist import Database.Persist.Sqlite import System.Directory import Test.HUnit import Test.Hspec -import ZcashHaskell.Orchard (isValidUnifiedAddress) +import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress) import ZcashHaskell.Sapling ( decodeSaplingOutputEsk , encodeSaplingAddress @@ -172,15 +173,15 @@ main = do "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" describe "Note selection for Tx" $ do it "Value less than balance" $ do - pool <- runNoLoggingT $ initPool "zenith.db" + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" res <- selectUnspentNotes pool (toSqlKey 1) 14000000 res `shouldNotBe` ([], [], []) it "Value greater than balance" $ do - pool <- runNoLoggingT $ initPool "zenith.db" + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" let res = selectUnspentNotes pool (toSqlKey 1) 84000000 res `shouldThrow` anyIOException it "Fee calculation" $ do - pool <- runNoLoggingT $ initPool "zenith.db" + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" res <- selectUnspentNotes pool (toSqlKey 1) 14000000 calculateTxFee res 3 `shouldBe` 20000 describe "Testing validation" $ do @@ -209,7 +210,7 @@ main = do (case decodeTransparentAddress (E.encodeUtf8 a) of Just _a3 -> True Nothing -> - case decodeExchangeAddress (En.encodeUtf8 a) of + case decodeExchangeAddress (E.encodeUtf8 a) of Just _a4 -> True Nothing -> False)) it "Transparent" $ do @@ -233,21 +234,62 @@ main = do a `shouldBe` Just "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" - {-describe "Creating Tx" $ do-} - {-xit "To Orchard" $ do-} - {-let uaRead =-} - {-isValidUnifiedAddress-} - {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-} - {-case uaRead of-} - {-Nothing -> assertFailure "wrong address"-} - {-Just ua -> do-} - {-tx <--} - {-prepareTx-} - {-"zenith.db"-} - {-TestNet-} - {-(toSqlKey 1)-} - {-2819811-} - {-0.04-} - {-ua-} - {-"sent with Zenith, test"-} - {-tx `shouldBe` Right (hexString "deadbeef")-} + describe "Notes" $ do + it "Check Orchard notes" $ do + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" + oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1) + oNotes `shouldBe` [] + it "Check Sapling notes" $ do + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" + oNotes <- getWalletUnspentSapNotes pool (toSqlKey 1) + oNotes `shouldBe` [] + it "Check transparent notes" $ do + pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" + oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1) + oNotes `shouldBe` [] + describe "Creating Tx" $ do + describe "Full" $ do + it "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) + 2999946 + 0.005 + (fromJust uaRead) + "Sending memo to orchard" + Full + tx `shouldBe` Right (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 1) + 2999396 + 0.005 + (fromJust uaRead) + "Sending memo to orchard" + Full + tx `shouldBe` Right (hexString "deadbeef") diff --git a/zcash-haskell b/zcash-haskell index 7965dc3..63a97b8 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c +Subproject commit 63a97b880cb32d8e008650f0efef2fdadc7d3d4a