feat!: add block tracking to data model

Adds new `ZcashBlock` table to database to track block information and
creates a relationship between `ZcashTransaction` records and the block
they belong to.
Database getters and setters are updated to use the block record for
confirmations, height, time data.

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
 

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)) $
+              bi <-
-                bl_txs $ addTime blk blockTime
+                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

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)
+      notePlan <-
-      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
+        selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
-      --print tSpends
+      case notePlan of
-      sSpends <-
+        Right (tList, sList, oList) -> do
-        liftIO $
+          logDebugN "selected notes"
-        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
           logDebugN $ T.pack $ show tList
           logDebugN $ T.pack $ show sList
           logDebugN $ T.pack $ show oList
-          outgoing <-
+          let noteTotal = getTotalAmount (tList, sList, oList)
-            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
+          tSpends <-
-          logDebugN $ T.pack $ show outgoing
+            liftIO $
-          let tx =
+            prepTSpends
-                createTransaction
+              (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
-                  (Just sT)
+              tList
-                  (Just oT)
+            --print tSpends
-                  tSpends
+          sSpends <-
-                  sSpends
+            liftIO $
-                  oSpends
+            prepSSpends
-                  outgoing
+              (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                  zn
+              sList
-                  (bh + 3)
+            --print sSpends
-                  True
+          oSpends <-
-          logDebugN $ T.pack $ show tx
+            liftIO $
-          return tx
+            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]
+      -> PrivacyPolicy
-    makeOutgoing acc (k, recvr) zats chg = do
+      -> 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 =
+      case k of
-            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+        4 ->
-      return
+          case policy of
-        [ OutgoingNote
+            None ->
-            4
+              return $
-            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+              Left $
-            (getBytes chgRcvr)
+              PrivacyPolicyError "Recipient not allowed by privacy policy"
-            (fromIntegral chg)
+            _anyOther -> do
-            ""
+              let chgRcvr =
-            True
+                    fromJust $
-        , OutgoingNote
+                    o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-            (fromIntegral k)
+              return $
-            (case k of
+                Right
-               4 ->
+                  [ OutgoingNote
-                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
+                      4
-               3 ->
+                      (getBytes $
-                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
+                       getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-               _ -> "")
+                      (getBytes chgRcvr)
-            recvr
+                      (fromIntegral chg)
-            (fromIntegral zats)
+                      ""
-            (E.encodeUtf8 memo)
+                      True
-            False
+                  , 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]

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
+  ZcashBlock
-    block Int
+    height Int
-    txId HexStringDB
+    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
+        bls <- from $ table @ZcashBlock
-        where_ (txs ^. ZcashTransactionBlock >. val 0)
+        where_ (bls ^. ZcashBlockNetwork ==. val net)
-        where_ (txs ^. ZcashTransactionNetwork ==. val net)
+        orderBy [desc $ bls ^. ZcashBlockHeight]
-        orderBy [desc $ txs ^. ZcashTransactionBlock]
+        pure bls
-        pure txs
   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
+  -> ZcashBlockId -- ^ The block the transaction is in
-  -> ZcashNetDB -- ^ the network
   -> 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 <-
+    w <- insert $ ZcashTransaction bi (HexStringDB $ tx_id wt)
-      insert $
-      ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
     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
+      (blks :& txs) <-
-      where_ (txs ^. ZcashTransactionBlock >. val b)
+        from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
-      where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
+        (\(blks :& txs) ->
-      orderBy [asc $ txs ^. ZcashTransactionBlock]
+           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 <-
+      b <-
-        upsert
+        selectOne $ do
-          (WalletTransaction
+          blks <- from $ table @ZcashBlock
-             (zcashTransactionTxId zT')
+          where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zT'))
-             za
+          pure blks
-             (zcashTransactionBlock zT')
+      case b of
-             (zcashTransactionConf zT')
+        Nothing ->
-             (zcashTransactionTime zT'))
+          throw $ userError "invalid block for saving wallet transaction"
-          []
+        Just blk -> do
-      return $ entityKey t
+          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) <-
+            (blks :& txs :& tNotes) <-
-              from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
+              from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
-              (\(txs :& tNotes) ->
+              (\(blks :& txs) ->
+                 blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
+              table @TransparentNote `on`
+              (\(_ :& txs :& tNotes) ->
                  txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
-            where_ (txs ^. ZcashTransactionBlock >. val b)
+            where_ (blks ^. ZcashBlockHeight >. val b)
-            where_ (txs ^. ZcashTransactionNetwork ==. val net)
+            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')
+             (zcashBlockHeight b)
-             (zcashTransactionConf zT')
+             (zcashBlockConf b)
-             (zcashTransactionTime zT'))
+             (zcashBlockTime b))
           []
       insert_ $
         WalletTrNote
@@ -1042,12 +1066,15 @@ getShieldedOutputs pool b net =
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     select $ do
-      (txs :& sOutputs) <-
+      (blks :& txs :& sOutputs) <-
-        from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
+        from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
-        (\(txs :& sOutputs) ->
+        (\(blks :& txs) ->
+           blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
+        table @ShieldOutput `on`
+        (\(_ :& txs :& sOutputs) ->
            txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
-      where_ (txs ^. ZcashTransactionBlock >=. val b)
+      where_ (blks ^. ZcashBlockHeight >=. val b)
-      where_ (txs ^. ZcashTransactionNetwork ==. val net)
+      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) <-
+      (blks :& txs :& oActions) <-
-        from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
+        from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
-        (\(txs :& oActions) ->
+        (\(blks :& txs) ->
+           blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
+        table @OrchAction `on`
+        (\(_ :& txs :& oActions) ->
            txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
-      where_ (txs ^. ZcashTransactionBlock >=. val b)
+      where_ (blks ^. ZcashBlockHeight >=. val b)
-      where_ (txs ^. ZcashTransactionNetwork ==. val net)
+      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 =
+upsertWalTx zt za = do
-  upsert
+  blk <-
-    (WalletTransaction
+    selectOne $ do
-       (zcashTransactionTxId zt)
+      blks <- from $ table @ZcashBlock
-       za
+      where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zt))
-       (zcashTransactionBlock zt)
+      pure blks
-       (zcashTransactionConf zt)
+  case blk of
-       (zcashTransactionTime zt))
+    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

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)) $
+              bi <-
-                bl_txs $ addTime blk blockTime
+                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

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) $
+          bi <-
-            bl_txs $ addTime blk blockTime
+            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)

src/Zenith/Types.hs

@@ -199,10 +199,11 @@ $(deriveJSON defaultOptions ''ZenithStatus)
 derivePersistField "ZenithStatus"
 
 data PrivacyPolicy
-  = Full
+  = None
-  | Medium
   | Low
-  | None
+  | Medium
+  | Full
+  deriving (Eq, Show, Read, Ord)
 
 $(deriveJSON defaultOptions ''PrivacyPolicy)
 

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-}
+      describe "Notes" $ do
-        {-xit "To Orchard" $ do-}
+        it "Check Orchard notes" $ do
-          {-let uaRead =-}
+          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                {-isValidUnifiedAddress-}
+          oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
-                  {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
+          oNotes `shouldBe` []
-          {-case uaRead of-}
+        it "Check Sapling notes" $ do
-            {-Nothing -> assertFailure "wrong address"-}
+          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-            {-Just ua -> do-}
+          oNotes <- getWalletUnspentSapNotes pool (toSqlKey 1)
-              {-tx <--}
+          oNotes `shouldBe` []
-                {-prepareTx-}
+        it "Check transparent notes" $ do
-                  {-"zenith.db"-}
+          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                  {-TestNet-}
+          oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
-                  {-(toSqlKey 1)-}
+          oNotes `shouldBe` []
-                  {-2819811-}
+      describe "Creating Tx" $ do
-                  {-0.04-}
+        describe "Full" $ do
-                  {-ua-}
+          it "To Orchard" $ do
-                  {-"sent with Zenith, test"-}
+            let uaRead =
-              {-tx `shouldBe` Right (hexString "deadbeef")-}
+                  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")

zcash-haskell

@@ -1 +1 @@
-Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c
+Subproject commit 63a97b880cb32d8e008650f0efef2fdadc7d3d4a