Merge branch 'rav001' into rvv001

- fix transaction fee calculation

CHANGELOG.md

@@ -22,6 +22,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 	- `getoperationstatus` RPC method
 	- `sendmany` RPC method
 - Function `prepareTxV2` implementing `PrivacyPolicy`
+- Functionality to shield transparent balance
+- Functionality to de-shield shielded notes
 
 ### Changed
 

src/Zenith/CLI.hs

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

src/Zenith/Core.hs

@@ -23,11 +23,11 @@ import Data.Aeson
 import Data.Binary.Get hiding (getBytes)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
-import Data.Digest.Pure.MD5
+import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
-import Data.HexString (HexString, hexString, toBytes, toText)
+import Data.Int (Int64)
 import Data.List
 import Data.Maybe (fromJust, fromMaybe)
-import Data.Pool (Pool)
+import Data.Scientific (Scientific, scientific, toBoundedInteger)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time
@@ -116,11 +116,16 @@ checkBlockChain nodeHost nodePort = do
 
 -- | Get commitment trees from Zebra
 getCommitmentTrees ::
-     T.Text -- ^ Host where `zebrad` is avaiable
+     ConnectionPool
+  -> T.Text -- ^ Host where `zebrad` is avaiable
   -> Int -- ^ Port where `zebrad` is available
+  -> ZcashNetDB
   -> Int -- ^ Block height
   -> IO ZebraTreeInfo
-getCommitmentTrees nodeHost nodePort block = do
+getCommitmentTrees pool nodeHost nodePort znet block = do
+  bh' <- getBlockHash pool block znet
+  case bh' of
+    Nothing -> do
       r <-
         makeZebraCall
           nodeHost
@@ -130,6 +135,16 @@ getCommitmentTrees nodeHost nodePort block = do
       case r of
         Left e -> throwIO $ userError e
         Right zti -> return zti
+    Just bh -> do
+      r <-
+        makeZebraCall
+          nodeHost
+          nodePort
+          "z_gettreestate"
+          [Data.Aeson.String $ toText bh]
+      case r of
+        Left e -> throwIO $ userError e
+        Right zti -> return zti
 
 -- * Spending Keys
 -- | Create an Orchard Spending Key for the given wallet and account index
@@ -280,7 +295,7 @@ findSaplingOutputs ::
   -> Int -- ^ the starting block
   -> ZcashNetDB -- ^ The network
   -> Entity ZcashAccount -- ^ The account to use
-  -> LoggingT IO ()
+  -> NoLoggingT IO ()
 findSaplingOutputs config b znet za = do
   let dbPath = c_dbPath config
   let zebraHost = c_zebraHost config
@@ -288,7 +303,7 @@ findSaplingOutputs config b znet za = do
   let zn = getNet znet
   pool <- liftIO $ runNoLoggingT $ initPool dbPath
   tList <- liftIO $ getShieldedOutputs pool b znet
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
+  trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
   logDebugN "getting Sapling frontier"
   let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
   case sT of
@@ -307,7 +322,7 @@ findSaplingOutputs config b znet za = do
       -> ZcashNet
       -> ConnectionPool
       -> [(Entity ZcashTransaction, Entity ShieldOutput)]
-      -> LoggingT IO ()
+      -> NoLoggingT IO ()
     decryptNotes _ _ _ [] = return ()
     decryptNotes st n pool ((zt, o):txs) = do
       let updatedTree =
@@ -395,7 +410,7 @@ findOrchardActions config b znet za = do
   let zn = getNet znet
   pool <- runNoLoggingT $ initPool dbPath
   tList <- getOrchardActions pool b znet
-  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
+  trees <- getCommitmentTrees pool zebraHost zebraPort znet (b - 1)
   let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
   case sT of
     Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
@@ -478,7 +493,7 @@ updateSaplingWitnesses pool = do
     updateOneNote maxId n = do
       let noteSync = walletSapNoteWitPos $ entityVal n
       when (noteSync < maxId) $ do
-        cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
+        cmus <- liftIO $ getSaplingCmus pool noteSync maxId
         let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
         let newWitness =
               updateSaplingWitness
@@ -496,7 +511,7 @@ updateOrchardWitnesses pool = do
     updateOneNote maxId n = do
       let noteSync = walletOrchNoteWitPos $ entityVal n
       when (noteSync < maxId) $ do
-        cmxs <- liftIO $ getOrchardCmxs pool noteSync
+        cmxs <- liftIO $ getOrchardCmxs pool noteSync maxId
         let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
         let newWitness =
               updateOrchardWitness
@@ -507,243 +522,271 @@ updateOrchardWitnesses pool = do
 -- | Calculate fee per ZIP-317
 calculateTxFee ::
      ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
-  -> Int
+  -> [OutgoingNote]
-  -> Integer
+  -> Int64
-calculateTxFee (t, s, o) i =
+calculateTxFee (t, s, o) nout =
-  fromIntegral
+  fromIntegral $ 5000 * (tcount + saction + oaction)
-    (5000 * (max (length t) tout + max (length s) sout + length o + oout))
   where
     tout =
-      if i == 1 || i == 2
+      length $
-        then 1
+      filter
-        else 0
+        (\(OutgoingNote x _ _ _ _ _) -> x == 1 || x == 2 || x == 5 || x == 6)
-    sout =
+        nout
-      if i == 3
+    sout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 3) nout
-        then 1
+    oout = length $ filter (\(OutgoingNote x _ _ _ _ _) -> x == 4) nout
-        else 0
+    tcount = max (length t) tout
-    oout =
+    scount = max (length s) sout
-      if i == 4
+    ocount = max (length o) oout
-        then 1
+    saction =
-        else 0
+      if scount == 1
+        then 2
+        else scount
+    oaction =
+      if ocount == 1
+        then 2
+        else ocount
 
 -- | Prepare a transaction for sending
-prepareTx ::
+{-
-     ConnectionPool
+ -prepareTx ::
-  -> T.Text
+ -     ConnectionPool
-  -> Int
+ -  -> T.Text
-  -> ZcashNet
+ -  -> Int
-  -> ZcashAccountId
+ -  -> ZcashNet
-  -> Int
+ -  -> ZcashAccountId
-  -> Float
+ -  -> Int
-  -> UnifiedAddress
+ -  -> Scientific
-  -> T.Text
+ -  -> UnifiedAddress
-  -> LoggingT IO (Either TxError HexString)
+ -  -> T.Text
-prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
+ -  -> LoggingT IO (Either TxError HexString)
-  accRead <- liftIO $ getAccountById pool za
+ -prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
-  let recipient =
+ -  accRead <- liftIO $ getAccountById pool za
-        case o_rec ua of
+ -  let recipient =
-          Nothing ->
+ -        case o_rec ua of
-            case s_rec ua of
+ -          Nothing ->
-              Nothing ->
+ -            case s_rec ua of
-                case t_rec ua of
+ -              Nothing ->
-                  Nothing -> (0, "")
+ -                case t_rec ua of
-                  Just r3 ->
+ -                  Nothing -> (0, "")
-                    case tr_type r3 of
+ -                  Just r3 ->
-                      P2PKH -> (1, toBytes $ tr_bytes r3)
+ -                    case tr_type r3 of
-                      P2SH -> (2, toBytes $ tr_bytes r3)
+ -                      P2PKH -> (1, toBytes $ tr_bytes r3)
-              Just r2 -> (3, getBytes r2)
+ -                      P2SH -> (2, toBytes $ tr_bytes r3)
-          Just r1 -> (4, getBytes r1)
+ -              Just r2 -> (3, getBytes r2)
-  logDebugN $ T.pack $ show recipient
+ -          Just r1 -> (4, getBytes r1)
-  logDebugN $ T.pack $ "Target block: " ++ show bh
+ -  logDebugN $ T.pack $ show recipient
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+ -  logDebugN $ T.pack $ "Target block: " ++ show bh
-  let sT = SaplingCommitmentTree $ ztiSapling trees
+ -  trees <-
-  let oT = OrchardCommitmentTree $ ztiOrchard trees
+ -    liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
-  case accRead of
+ -  let sT = SaplingCommitmentTree $ ztiSapling trees
-    Nothing -> do
+ -  let oT = OrchardCommitmentTree $ ztiOrchard trees
-      logErrorN "Can't find Account"
+ -  case accRead of
-      return $ Left ZHError
+ -    Nothing -> do
-    Just acc -> do
+ -      logErrorN "Can't find Account"
-      logDebugN $ T.pack $ show acc
+ -      return $ Left ZHError
-      let zats = floorFloatInteger $ amt * (10 ^ 8)
+ -    Just acc -> do
-      logDebugN $ T.pack $ show zats
+ -      logDebugN $ T.pack $ show acc
-      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
+ -      let zats' = toBoundedInteger $ amt * scientific 1 8
-      --let fee = calculateTxFee firstPass $ fst recipient
+ -      case zats' of
-      --logDebugN $ T.pack $ "calculated fee " ++ show fee
+ -        Nothing -> return $ Left ZHError
-      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
+ -        Just zats -> do
-      logDebugN "selected notes"
+ -          logDebugN $ T.pack $ show (zats :: Int64)
-      logDebugN $ T.pack $ show tList
+ -          {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
-      logDebugN $ T.pack $ show sList
+ -          --let fee = calculateTxFee firstPass $ fst recipient
-      logDebugN $ T.pack $ show oList
+ -          --logDebugN $ T.pack $ "calculated fee " ++ show fee
-      let noteTotal = getTotalAmount (tList, sList, oList)
+ -          (tList, sList, oList) <-
-      tSpends <-
+ -            liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
-        liftIO $
+ -          logDebugN "selected notes"
-        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
+ -          logDebugN $ T.pack $ show tList
-      --print tSpends
+ -          logDebugN $ T.pack $ show sList
-      sSpends <-
+ -          logDebugN $ T.pack $ show oList
-        liftIO $
+ -          let noteTotal = getTotalAmount (tList, sList, oList)
-        prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
+ -          tSpends <-
-      --print sSpends
+ -            liftIO $
-      oSpends <-
+ -            prepTSpends
-        liftIO $
+ -              (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
-        prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
+ -              tList
-      --print oSpends
+ -          --print tSpends
-      dummy <-
+ -          sSpends <-
-        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
+ -            liftIO $
-      logDebugN "Calculating fee"
+ -            prepSSpends
-      let feeResponse =
+ -              (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-            createTransaction
+ -              sList
-              (Just sT)
+ -          --print sSpends
-              (Just oT)
+ -          oSpends <-
-              tSpends
+ -            liftIO $
-              sSpends
+ -            prepOSpends
-              oSpends
+ -              (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-              dummy
+ -              oList
-              zn
+ -          --print oSpends
-              (bh + 3)
+ -          dummy <-
-              False
+ -            liftIO $
-      case feeResponse of
+ -            makeOutgoing
-        Left e1 -> return $ Left Fee
+ -              acc
-        Right fee -> do
+ -              recipient
-          let feeAmt =
+ -              zats
-                fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
+ -              (fromInteger noteTotal - 5000 - zats)
-          (tList1, sList1, oList1) <-
+ -          logDebugN "Calculating fee"
-            liftIO $ selectUnspentNotes pool za (zats + feeAmt)
+ -          let feeResponse =
-          logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
+ -                createTransaction
-          logDebugN $ T.pack $ show tList
+ -                  (Just sT)
-          logDebugN $ T.pack $ show sList
+ -                  (Just oT)
-          logDebugN $ T.pack $ show oList
+ -                  tSpends
-          outgoing <-
+ -                  sSpends
-            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
+ -                  oSpends
-          logDebugN $ T.pack $ show outgoing
+ -                  dummy
-          let tx =
+ -                  zn
-                createTransaction
+ -                  bh
-                  (Just sT)
+ -                  False
-                  (Just oT)
+ -          case feeResponse of
-                  tSpends
+ -            Left e1 -> return $ Left Fee
-                  sSpends
+ -            Right fee -> do
-                  oSpends
+ -              let feeAmt =
-                  outgoing
+ -                    fromIntegral
-                  zn
+ -                      (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
-                  (bh + 3)
+ -              (tList1, sList1, oList1) <-
-                  True
+ -                liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
-          logDebugN $ T.pack $ show tx
+ -              logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
-          return tx
+ -              logDebugN $ T.pack $ show tList
-  where
+ -              logDebugN $ T.pack $ show sList
-    makeOutgoing ::
+ -              logDebugN $ T.pack $ show oList
-         Entity ZcashAccount
+ -              outgoing <-
-      -> (Int, BS.ByteString)
+ -                liftIO $
-      -> Integer
+ -                makeOutgoing
-      -> Integer
+ -                  acc
-      -> IO [OutgoingNote]
+ -                  recipient
-    makeOutgoing acc (k, recvr) zats chg = do
+ -                  zats
-      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
+ -                  (fromInteger noteTotal - fromInteger feeAmt - zats)
-      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
+ -              logDebugN $ T.pack $ show outgoing
-      let chgRcvr =
+ -              let tx =
-            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+ -                    createTransaction
-      return
+ -                      (Just sT)
-        [ OutgoingNote
+ -                      (Just oT)
-            4
+ -                      tSpends
-            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+ -                      sSpends
-            (getBytes chgRcvr)
+ -                      oSpends
-            (fromIntegral chg)
+ -                      outgoing
-            ""
+ -                      zn
-            True
+ -                      bh
-        , OutgoingNote
+ -                      True
-            (fromIntegral k)
+ -              logDebugN $ T.pack $ show tx
-            (case k of
+ -              return tx
-               4 ->
+ -  where
-                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
+ -    makeOutgoing ::
-               3 ->
+ -         Entity ZcashAccount
-                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
+ -      -> (Int, BS.ByteString)
-               _ -> "")
+ -      -> Int64
-            recvr
+ -      -> Int64
-            (fromIntegral zats)
+ -      -> IO [OutgoingNote]
-            (E.encodeUtf8 memo)
+ -    makeOutgoing acc (k, recvr) zats chg = do
-            False
+ -      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
-        ]
+ -      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
-    getTotalAmount ::
+ -      let chgRcvr =
-         ( [Entity WalletTrNote]
+ -            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-         , [Entity WalletSapNote]
+ -      return
-         , [Entity WalletOrchNote])
+ -        [ OutgoingNote
-      -> Integer
+ -            4
-    getTotalAmount (t, s, o) =
+ -            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
+ -            (getBytes chgRcvr)
-      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
+ -            (fromIntegral chg)
-      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
+ -            ""
-    prepTSpends ::
+ -            True
-         TransparentSpendingKey
+ -        , OutgoingNote
-      -> [Entity WalletTrNote]
+ -            (fromIntegral k)
-      -> IO [TransparentTxSpend]
+ -            (case k of
-    prepTSpends sk notes = do
+ -               4 ->
-      forM notes $ \n -> do
+ -                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
-        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
+ -               3 ->
-        case tAddRead of
+ -                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
-          Nothing -> throwIO $ userError "Couldn't read t-address"
+ -               _ -> "")
-          Just tAdd -> do
+ -            recvr
-            (XPrvKey _ _ _ _ (SecKey xp_key)) <-
+ -            (fromIntegral zats)
-              genTransparentSecretKey
+ -            (E.encodeUtf8 memo)
-                (walletAddressIndex $ entityVal tAdd)
+ -            False
-                (getScope $ walletAddressScope $ entityVal tAdd)
+ -        ]
-                sk
+ -    getTotalAmount ::
-            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
+ -         ( [Entity WalletTrNote]
-            case mReverseTxId of
+ -         , [Entity WalletSapNote]
-              Nothing -> throwIO $ userError "failed to get tx ID"
+ -         , [Entity WalletOrchNote])
-              Just (ESQ.Value reverseTxId) -> do
+ -      -> Integer
-                let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
+ -    getTotalAmount (t, s, o) =
-                return $
+ -      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
-                  TransparentTxSpend
+ -      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
-                    xp_key
+ -      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
-                    (RawOutPoint
+ -    prepTSpends ::
-                       flipTxId
+ -         TransparentSpendingKey
-                       (fromIntegral $ walletTrNotePosition $ entityVal n))
+ -      -> [Entity WalletTrNote]
-                    (RawTxOut
+ -      -> IO [TransparentTxSpend]
-                       (fromIntegral $ walletTrNoteValue $ entityVal n)
+ -    prepTSpends sk notes = do
-                       (walletTrNoteScript $ entityVal n))
+ -      forM notes $ \n -> do
-    prepSSpends ::
+ -        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
-         SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
+ -        case tAddRead of
-    prepSSpends sk notes = do
+ -          Nothing -> throwIO $ userError "Couldn't read t-address"
-      forM notes $ \n -> do
+ -          Just tAdd -> do
-        return $
+ -            (XPrvKey _ _ _ _ (SecKey xp_key)) <-
-          SaplingTxSpend
+ -              genTransparentSecretKey
-            (getBytes sk)
+ -                (walletAddressIndex $ entityVal tAdd)
-            (DecodedNote
+ -                (getScope $ walletAddressScope $ entityVal tAdd)
-               (fromIntegral $ walletSapNoteValue $ entityVal n)
+ -                sk
-               (walletSapNoteRecipient $ entityVal n)
+ -            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
-               (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
+ -            case mReverseTxId of
-               (getHex $ walletSapNoteNullifier $ entityVal n)
+ -              Nothing -> throwIO $ userError "failed to get tx ID"
-               ""
+ -              Just (ESQ.Value reverseTxId) -> do
-               (getRseed $ walletSapNoteRseed $ entityVal n))
+ -                let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
-            (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
+ -                return $
-    prepOSpends ::
+ -                  TransparentTxSpend
-         OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
+ -                    xp_key
-    prepOSpends sk notes = do
+ -                    (RawOutPoint
-      forM notes $ \n -> do
+ -                       flipTxId
-        return $
+ -                       (fromIntegral $ walletTrNotePosition $ entityVal n))
-          OrchardTxSpend
+ -                    (RawTxOut
-            (getBytes sk)
+ -                       (fromIntegral $ walletTrNoteValue $ entityVal n)
-            (DecodedNote
+ -                       (walletTrNoteScript $ entityVal n))
-               (fromIntegral $ walletOrchNoteValue $ entityVal n)
+ -    prepSSpends ::
-               (walletOrchNoteRecipient $ entityVal n)
+ -         SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
-               (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
+ -    prepSSpends sk notes = do
-               (getHex $ walletOrchNoteNullifier $ entityVal n)
+ -      forM notes $ \n -> do
-               (walletOrchNoteRho $ entityVal n)
+ -        return $
-               (getRseed $ walletOrchNoteRseed $ entityVal n))
+ -          SaplingTxSpend
-            (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
+ -            (getBytes sk)
-    sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
+ -            (DecodedNote
-    sapAnchor notes =
+ -               (fromIntegral $ walletSapNoteValue $ entityVal n)
-      if not (null notes)
+ -               (walletSapNoteRecipient $ entityVal n)
-        then Just $
+ -               (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
-             SaplingWitness $
+ -               (getHex $ walletSapNoteNullifier $ entityVal n)
-             getHex $ walletSapNoteWitness $ entityVal $ head notes
+ -               ""
-        else Nothing
+ -               (getRseed $ walletSapNoteRseed $ entityVal n))
-    orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
+ -            (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
-    orchAnchor notes =
+ -    prepOSpends ::
-      if not (null notes)
+ -         OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
-        then Just $
+ -    prepOSpends sk notes = do
-             OrchardWitness $
+ -      forM notes $ \n -> do
-             getHex $ walletOrchNoteWitness $ entityVal $ head notes
+ -        return $
-        else Nothing
+ -          OrchardTxSpend
-
+ -            (getBytes sk)
+ -            (DecodedNote
+ -               (fromIntegral $ walletOrchNoteValue $ entityVal n)
+ -               (walletOrchNoteRecipient $ entityVal n)
+ -               (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
+ -               (getHex $ walletOrchNoteNullifier $ entityVal n)
+ -               (walletOrchNoteRho $ entityVal n)
+ -               (getRseed $ walletOrchNoteRseed $ entityVal n))
+ -            (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
+ -    sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
+ -    sapAnchor notes =
+ -      if not (null notes)
+ -        then Just $
+ -             SaplingWitness $
+ -             getHex $ walletSapNoteWitness $ entityVal $ head notes
+ -        else Nothing
+ -    orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
+ -    orchAnchor notes =
+ -      if not (null notes)
+ -        then Just $
+ -             OrchardWitness $
+ -             getHex $ walletOrchNoteWitness $ entityVal $ head notes
+ -        else Nothing
+ -}
 deshieldNotes ::
      ConnectionPool
   -> T.Text
@@ -752,11 +795,11 @@ deshieldNotes ::
   -> ZcashAccountId
   -> Int
   -> ProposedNote
-  -> NoLoggingT IO (Either TxError HexString)
+  -> LoggingT IO (Either TxError HexString)
 deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
   bal <- liftIO $ getShieldedBalance pool za
-  let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
+  let zats = pn_amt pnote * scientific 1 8
-  if bal > (20000 + zats)
+  if fromInteger bal > (scientific 2 4 + zats)
     then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
     else return $ Left InsufficientFunds
 
@@ -771,9 +814,11 @@ shieldTransparentNotes ::
 shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
   accRead <- liftIO $ getAccountById pool za
   logDebugN $ T.pack $ "Target block: " ++ show bh
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  {-
-  let sT = SaplingCommitmentTree $ ztiSapling trees
+   -trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
-  let oT = OrchardCommitmentTree $ ztiOrchard trees
+   -let sT = SaplingCommitmentTree $ ztiSapling trees
+   -let oT = OrchardCommitmentTree $ ztiOrchard trees
+   -}
   case accRead of
     Nothing -> do
       logErrorN "Can't find Account"
@@ -788,7 +833,6 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
               dRecvs
       forM fNotes $ \trNotes -> do
         let noteTotal = getTotalAmount (trNotes, [], [])
-        let fee = calculateTxFee (trNotes, [], []) 4
         tSpends <-
           liftIO $
           prepTSpends
@@ -800,18 +844,28 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
         let oRcvr =
               fromJust $
               o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+        let dummy =
+              OutgoingNote
+                4
+                (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+                (getBytes oRcvr)
+                (fromIntegral $ noteTotal - 500)
+                ""
+                True
+        let feeAmt = calculateTxFee (trNotes, [], []) [dummy]
         let snote =
               OutgoingNote
                 4
                 (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
                 (getBytes oRcvr)
-                (fromIntegral $ noteTotal - fee)
+                (fromIntegral $ noteTotal - fromIntegral feeAmt)
                 ""
                 True
-        let tx =
+        tx <-
+          liftIO $
           createTransaction
-                (Just sT)
+            Nothing
-                (Just oT)
+            Nothing
             tSpends
             []
             []
@@ -871,13 +925,14 @@ prepareTxV2 ::
   -> Int
   -> [ProposedNote]
   -> PrivacyPolicy
-  -> NoLoggingT IO (Either TxError HexString)
+  -> LoggingT IO (Either TxError HexString)
 prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
   accRead <- liftIO $ getAccountById pool za
   let recipients = map extractReceiver pnotes
   logDebugN $ T.pack $ show recipients
   logDebugN $ T.pack $ "Target block: " ++ show bh
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  trees <-
+    liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) bh
   let sT = SaplingCommitmentTree $ ztiSapling trees
   let oT = OrchardCommitmentTree $ ztiOrchard trees
   case accRead of
@@ -887,7 +942,12 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
     Just acc -> do
       logDebugN $ T.pack $ show acc
       let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
-      let zats = ceilingFloatInteger $ amt * (10 ^ 8)
+      let zats' = toBoundedInteger $ amt * scientific 1 8
+      case zats' of
+        Nothing -> do
+          logErrorN "Failed to parse amount into zats"
+          return $ Left ZHError
+        Just zats -> do
           logDebugN $ "amt: " <> T.pack (show amt)
           logDebugN $ "zats: " <> T.pack (show zats)
           {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
@@ -898,7 +958,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
             selectUnspentNotesV2
               pool
               za
-          (zats + 10000)
+              (zats + 20000)
               (map (\(x, _, _, _) -> x) recipients)
               policy
           case notePlan of
@@ -927,42 +987,29 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
                   (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
                   oList
                 --print oSpends
-          dummy' <-
+              draft <-
                 liftIO $
-            makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
+                makeOutgoing
-          case dummy' of
+                  acc
+                  recipients
+                  (noteTotal - 5000 - fromIntegral zats)
+                  policy
+              case draft of
                 Left e -> return $ Left e
-            Right dummy -> do
+                Right draftOut -> do
-              logDebugN "Calculating fee"
+                  let fee = calculateTxFee (tList, sList, oList) draftOut
-              let feeResponse =
+                  logDebugN $ T.pack $ "calculated fee " ++ show fee
-                    createTransaction
-                      (Just sT)
-                      (Just oT)
-                      tSpends
-                      sSpends
-                      oSpends
-                      dummy
-                      zn
-                      bh
-                      False
-              case feeResponse of
-                Left e1 -> return $ Left Fee
-                Right fee -> do
-                  let feeAmt =
-                        fromIntegral
-                          (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
                   finalNotePlan <-
                     liftIO $
                     selectUnspentNotesV2
                       pool
                       za
-                      (zats + feeAmt)
+                      (zats + fee)
                       (map (\(x, _, _, _) -> x) recipients)
                       policy
                   case finalNotePlan of
                     Right (tList1, sList1, oList1) -> do
-                      logDebugN $
+                      logDebugN $ T.pack $ "selected notes with fee" ++ show fee
-                        T.pack $ "selected notes with fee" ++ show feeAmt
                       logDebugN $ T.pack $ show tList1
                       logDebugN $ T.pack $ show sList1
                       logDebugN $ T.pack $ show oList1
@@ -987,13 +1034,14 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
                         makeOutgoing
                           acc
                           recipients
-                          (noteTotal1 - feeAmt - zats)
+                          (noteTotal1 - fee - fromIntegral zats)
                           policy
                       logDebugN $ T.pack $ show outgoing'
                       case outgoing' of
                         Left e -> return $ Left e
                         Right outgoing -> do
-                          let tx =
+                          tx <-
+                            liftIO $
                             createTransaction
                               (Just sT)
                               (Just oT)
@@ -1011,10 +1059,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
               logErrorN $ T.pack $ show e
               return $ Left e
   where
-    extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text)
+    extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int64, T.Text)
     extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
-      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
+      let zats' = toBoundedInteger $ amt * scientific 1 8
-       in case va of
+       in case zats' of
+            Nothing -> (0, "", 0, "")
+            Just zats ->
+              case va of
                 Unified ua ->
                   case o_rec ua of
                     Nothing ->
@@ -1025,26 +1076,45 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
                             Just r3 ->
                               case tr_type r3 of
                                 P2PKH ->
-                              (1, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
+                                  ( 1
+                                  , toBytes $ tr_bytes r3
+                                  , zats
+                                  , fromMaybe "" m)
                                 P2SH ->
-                              (2, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
+                                  ( 2
+                                  , toBytes $ tr_bytes r3
+                                  , zats
+                                  , fromMaybe "" m)
                         Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
                     Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
-            Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
+                Sapling sa ->
+                  (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
                 Transparent ta ->
                   case tr_type (ta_receiver ta) of
                     P2PKH ->
-                  (1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
+                      ( 1
+                      , toBytes $ tr_bytes (ta_receiver ta)
+                      , zats
+                      , fromMaybe "" m)
                     P2SH ->
-                  (2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
+                      ( 2
+                      , toBytes $ tr_bytes (ta_receiver ta)
+                      , zats
+                      , fromMaybe "" m)
                 Exchange ea ->
                   case tr_type (ex_address ea) of
                     P2PKH ->
-                  (5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
+                      ( 5
+                      , toBytes $ tr_bytes (ex_address ea)
+                      , zats
+                      , fromMaybe "" m)
                     P2SH ->
-                  (6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
+                      ( 6
+                      , toBytes $ tr_bytes (ex_address ea)
+                      , zats
+                      , fromMaybe "" m)
     prepareOutgoingNote ::
-         ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote
+         ZcashAccount -> (Int, BS.ByteString, Int64, T.Text) -> OutgoingNote
     prepareOutgoingNote zac (k, r, a, m) =
       OutgoingNote
         (if k == 5
@@ -1062,8 +1132,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
         False
     makeOutgoing ::
          Entity ZcashAccount
-      -> [(Int, BS.ByteString, Int, T.Text)]
+      -> [(Int, BS.ByteString, Int64, T.Text)]
-      -> Integer
+      -> Int64
       -> PrivacyPolicy
       -> IO (Either TxError [OutgoingNote])
     makeOutgoing acc recvs chg pol = do
@@ -1195,7 +1265,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
          ( [Entity WalletTrNote]
          , [Entity WalletSapNote]
          , [Entity WalletOrchNote])
-      -> Integer
+      -> Int64
     getTotalAmount (t, s, o) =
       sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
       sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
@@ -1300,13 +1370,15 @@ syncWallet config w = do
   let startBlock =
         if lastBlock > 0
           then lastBlock
-          else zcashWalletBirthdayHeight $ entityVal w
+          else 1 + zcashWalletBirthdayHeight (entityVal w)
   logDebugN $ "start block: " <> T.pack (show startBlock)
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
   logDebugN "processed transparent notes"
   mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
   logDebugN "processed transparent spends"
+  liftIO $
+    runNoLoggingT $
     mapM_
       (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
       accs

src/Zenith/DB.hs

@@ -698,22 +698,42 @@ saveAddress pool w =
   runNoLoggingT $
   PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
 
+-- * Block
 -- | Save a block to the database
 saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
 saveBlock pool b =
   runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
 
 -- | Read a block by height
-getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
+getBlock ::
-getBlock pool b =
+     ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock))
+getBlock pool b znet =
   runNoLoggingT $
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     selectOne $ do
       bl <- from $ table @ZcashBlock
-      where_ $ bl ^. ZcashBlockHeight ==. val b
+      where_ $
+        bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
+        val znet
       pure bl
 
+getBlockHash :: ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe HexString)
+getBlockHash pool b znet = do
+  r <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        bl <- from $ table @ZcashBlock
+        where_ $
+          bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
+          val znet
+        pure $ bl ^. ZcashBlockHash
+  case r of
+    Nothing -> return Nothing
+    Just (Value h) -> return $ Just $ getHex h
+
 -- | Save a transaction to the data model
 saveTransaction ::
      ConnectionPool -- ^ the database path
@@ -1776,12 +1796,16 @@ getUnspentSapNotes pool = do
         where_ (n ^. WalletSapNoteSpent ==. val False)
         pure n
 
-getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
+getSaplingCmus ::
-getSaplingCmus pool zt = do
+     ConnectionPool
+  -> ShieldOutputId
+  -> ShieldOutputId
+  -> IO [Value HexStringDB]
+getSaplingCmus pool zt m = do
   PS.runSqlPool
     (select $ do
        n <- from $ table @ShieldOutput
-       where_ (n ^. ShieldOutputId >. val zt)
+       where_ (n ^. ShieldOutputId >. val zt &&. n ^. ShieldOutputId <=. val m)
        orderBy [asc $ n ^. ShieldOutputId]
        pure $ n ^. ShieldOutputCmu)
     pool
@@ -1840,12 +1864,13 @@ getUnspentOrchNotes pool = do
         where_ (n ^. WalletOrchNoteSpent ==. val False)
         pure n
 
-getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB]
+getOrchardCmxs ::
-getOrchardCmxs pool zt = do
+     ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB]
+getOrchardCmxs pool zt m = do
   PS.runSqlPool
     (select $ do
        n <- from $ table @OrchAction
-       where_ (n ^. OrchActionId >. val zt)
+       where_ (n ^. OrchActionId >. val zt &&. n ^. OrchActionId <=. val m)
        orderBy [asc $ n ^. OrchActionId]
        pure $ n ^. OrchActionCmx)
     pool
@@ -2339,7 +2364,7 @@ selectUnspentNotes pool za amt = do
 selectUnspentNotesV2 ::
      ConnectionPool
   -> ZcashAccountId
-  -> Integer
+  -> Int64
   -> [Int]
   -> PrivacyPolicy
   -> IO
@@ -2643,8 +2668,8 @@ completeSync pool st = do
   return ()
 
 -- | Rewind the data store to a given block height
-rewindWalletData :: ConnectionPool -> Int -> LoggingT IO ()
+rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO ()
-rewindWalletData pool b = do
+rewindWalletData pool b net = do
   logDebugN "Starting transaction rewind"
   liftIO $ clearWalletTransactions pool
   logDebugN "Completed transaction rewind"
@@ -2656,7 +2681,9 @@ rewindWalletData pool b = do
       oldBlocks <-
         select $ do
           blk <- from $ table @ZcashBlock
-          where_ $ blk ^. ZcashBlockHeight >. val b
+          where_
+            (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
+             val net)
           pure blk
       let oldBlkKeys = map entityKey oldBlocks
       oldTxs <-
@@ -2676,7 +2703,9 @@ rewindWalletData pool b = do
       oldBlocks <-
         select $ do
           blk <- from $ table @ZcashBlock
-          where_ $ blk ^. ZcashBlockHeight >. val b
+          where_
+            (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
+             val net)
           pure blk
       let oldBlkKeys = map entityKey oldBlocks
       oldTxs <-
@@ -2696,7 +2725,9 @@ rewindWalletData pool b = do
       oldBlocks <-
         select $ do
           blk <- from $ table @ZcashBlock
-          where_ $ blk ^. ZcashBlockHeight >. val b
+          where_
+            (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
+             val net)
           pure blk
       let oldBlkKeys = map entityKey oldBlocks
       oldTxs <-
@@ -2716,7 +2747,9 @@ rewindWalletData pool b = do
       oldBlocks <-
         select $ do
           blk <- from $ table @ZcashBlock
-          where_ $ blk ^. ZcashBlockHeight >. val b
+          where_
+            (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
+             val net)
           pure blk
       let oldBlkKeys = map entityKey oldBlocks
       oldTxs <-
@@ -2736,7 +2769,9 @@ rewindWalletData pool b = do
       oldBlocks <-
         select $ do
           blk <- from $ table @ZcashBlock
-          where_ $ blk ^. ZcashBlockHeight >. val b
+          where_
+            (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
+             val net)
           pure blk
       let oldBlkKeys = map entityKey oldBlocks
       oldTxs <-
@@ -2756,7 +2791,9 @@ rewindWalletData pool b = do
       oldBlocks <-
         select $ do
           blk <- from $ table @ZcashBlock
-          where_ $ blk ^. ZcashBlockHeight >. val b
+          where_
+            (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
+             val net)
           pure blk
       let oldBlkKeys = map entityKey oldBlocks
       oldTxs <-
@@ -2775,5 +2812,7 @@ rewindWalletData pool b = do
     flip PS.runSqlPool pool $ do
       delete $ do
         blk <- from $ table @ZcashBlock
-        where_ $ blk ^. ZcashBlockHeight >. val b
+        where_
+          (blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
+           val net)
   logDebugN "Completed data store rewind"

src/Zenith/GUI.hs

@@ -17,6 +17,7 @@ import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.HexString (toText)
 import Data.Maybe (fromMaybe, isJust, isNothing)
+import Data.Scientific (Scientific, fromFloatDigits)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@@ -1244,7 +1245,7 @@ handleEvent wenv node model evt =
                   (model ^. network)
                   (entityKey acc)
                   (zcashWalletLastSync $ entityVal wal)
-                  (model ^. sendAmount)
+                  (fromFloatDigits $ model ^. sendAmount)
                   (model ^. sendRecipient)
                   (model ^. sendMemo)
                   (model ^. privacyChoice)
@@ -1626,17 +1627,17 @@ scanZebra dbPath zHost zPort net sendMsg = do
   pool <- runNoLoggingT $ initPool dbPath
   b <- liftIO $ getMinBirthdayHeight pool
   dbBlock <- getMaxBlock pool $ ZcashNetDB net
-  chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
+  chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
   syncChk <- isSyncing pool
   if syncChk
     then sendMsg (ShowError "Sync already in progress")
     else do
-      unless (chkBlock == dbBlock) $
-        runStderrLoggingT $ rewindWalletData pool chkBlock
       let sb =
             if chkBlock == dbBlock
               then max dbBlock b
               else max chkBlock b
+      unless (chkBlock == dbBlock || chkBlock == 1) $
+        runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
       if sb > zgb_blocks bStatus || sb < 1
         then sendMsg (ShowError "Invalid starting block for scan")
         else do
@@ -1701,7 +1702,7 @@ sendTransaction ::
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> Float
+  -> Scientific
   -> T.Text
   -> T.Text
   -> PrivacyPolicy
@@ -1717,7 +1718,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
       let zPort = c_zebraPort config
       pool <- runNoLoggingT $ initPool dbPath
       res <-
-        runNoLoggingT $
+        runStderrLoggingT $
         prepareTxV2
           pool
           zHost

src/Zenith/RPC.hs

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

src/Zenith/Scanner.hs

@@ -246,10 +246,11 @@ checkIntegrity ::
      T.Text -- ^ Database path
   -> T.Text -- ^ Zebra host
   -> Int -- ^ Zebra port
+  -> ZcashNet -- ^ the network to scan
   -> Int -- ^ The block to start the check
   -> Int -- ^ depth
   -> IO Int
-checkIntegrity dbP zHost zPort b d =
+checkIntegrity dbP zHost zPort znet b d =
   if b < 1
     then return 1
     else do
@@ -263,10 +264,10 @@ checkIntegrity dbP zHost zPort b d =
         Left e -> throwIO $ userError e
         Right blk -> do
           pool <- runNoLoggingT $ initPool dbP
-          dbBlk <- getBlock pool b
+          dbBlk <- getBlock pool b $ ZcashNetDB znet
           case dbBlk of
-            Nothing -> throwIO $ userError "Block mismatch, rescan needed"
+            Nothing -> return 1
             Just dbBlk' ->
               if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
                 then return b
-                else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)
+                else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)

src/Zenith/Types.hs

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

src/Zenith/Utils.hs

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

test/Spec.hs

@@ -2,6 +2,7 @@
 
 import Control.Monad (when)
 import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
+import Data.Aeson
 import Data.HexString
 import Data.Maybe (fromJust)
 import qualified Data.Text.Encoding as E
@@ -33,8 +34,10 @@ import ZcashHaskell.Types
   , Scope(..)
   , ShieldedOutput(..)
   , TxError(..)
+  , ValidAddress(..)
   , ZcashNet(..)
   )
+import ZcashHaskell.Utils (f4Jumble, makeZebraCall, readZebraTransaction)
 import Zenith.Core
 import Zenith.DB
 import Zenith.Types
@@ -182,6 +185,12 @@ main = do
           a `shouldBe`
             Just
               "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+      describe "Witnesses" $ do
+        describe "Sapling" $ do
+          it "max output id" $ do
+            pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+            sId <- getMaxSaplingNote pool
+            sId `shouldBe` toSqlKey 0
       describe "Notes" $ do
         xit "Check Orchard notes" $ do
           pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@@ -222,7 +231,7 @@ main = do
                   Full
               case tx of
                 Left e -> assertFailure $ show e
-                  Right h -> h `shouldBe` (hexString "deadbeef")
+                Right h -> h `shouldNotBe` hexString "deadbeef"
         it "To Sapling" $ do
           let uaRead =
                 parseAddress
@@ -248,7 +257,7 @@ main = do
                   Full
               case tx of
                 Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
+                Right h -> h `shouldNotBe` hexString "deadbeef"
         it "To Transparent" $ do
           let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
           case uaRead of
@@ -271,8 +280,7 @@ main = do
                   ]
                   Full
               tx `shouldBe`
-                  Left
+                Left (PrivacyPolicyError "Receiver not capable of Full privacy")
-                    (PrivacyPolicyError "Receiver not capable of Full privacy")
         it "To mixed shielded receivers" $ do
           let uaRead =
                 parseAddress
@@ -333,7 +341,7 @@ main = do
                   Medium
               case tx of
                 Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
+                Right h -> h `shouldNotBe` hexString "deadbeef"
         it "To Sapling" $ do
           let uaRead =
                 parseAddress
@@ -359,7 +367,7 @@ main = do
                   Medium
               case tx of
                 Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
+                Right h -> h `shouldNotBe` (hexString "00")
         it "To Transparent" $ do
           let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ"
           case uaRead of
@@ -572,4 +580,4 @@ main = do
                   None
               case tx of
                 Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
+                Right h -> h `shouldNotBe` hexString "deadbeef"

zcash-haskell

@@ -1 +1 @@
-Subproject commit 662a0d1148d3f52e2683157a4c9280bb8e81b0cb
+Subproject commit 6d4b6840d30fe1631902acd0388bef0040fee9e8

zenith.cabal

@@ -141,6 +141,7 @@ test-suite zenith-tests
   build-depends:
       base >=4.12 && <5
     , bytestring
+    , aeson
     , configurator
     , monad-logger
     , data-default