2024-11-21 15:30:22 +00:00
9 changed files with 570 additions and 203 deletions
--- 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

--- 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
--- 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]
--- 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
--- 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
--- 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)
--- 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)

--- 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")
--- a/2
+++ b/2
@ -1 +1 @@
-Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c
+Subproject commit 63a97b880cb32d8e008650f0efef2fdadc7d3d4a