fix: correct rewind for brand new wallets

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
 
@@ -839,11 +840,11 @@ scanZebra dbP zHost zPort b eChan znet = do
       logDebugN $
         "dbBlock: " <>
         T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
-      when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
       let sb =
             if chkBlock == dbBlock
               then max dbBlock b
               else max chkBlock b
+      when (chkBlock /= dbBlock && chkBlock /= 1) $ rewindWalletData pool sb
       if sb > zgb_blocks bStatus || sb < 1
         then do
           liftIO $
@@ -1201,7 +1202,8 @@ appEvent (BT.VtyEvent e) = do
                                     Just (_k, w) -> return w
                              fs1 <- BT.zoom txForm $ BT.gets formState
                              bl <-
-                               liftIO $ getLastSyncBlock pool $ entityKey selWal
+                               liftIO $
+                               getChainTip (s ^. zebraHost) (s ^. zebraPort)
                              _ <-
                                liftIO $
                                forkIO $
@@ -1212,7 +1214,7 @@ appEvent (BT.VtyEvent e) = do
                                  (s ^. zebraPort)
                                  (s ^. network)
                                  (entityKey selAcc)
-                                 bl
+                                 (bl + 5)
                                  (fs1 ^. sendAmt)
                                  (fs1 ^. sendTo)
                                  (fs1 ^. sendMemo)
@@ -1292,7 +1294,8 @@ appEvent (BT.VtyEvent e) = do
                                       getUA . walletAddressUAddress)
                                        (entityVal selAddr)))
                              bl <-
-                               liftIO $ getLastSyncBlock pool $ entityKey selWal
+                               liftIO $
+                               getChainTip (s ^. zebraHost) (s ^. zebraPort)
                              case tAddrMaybe of
                                Nothing -> do
                                  BT.modify $
@@ -1994,7 +1997,7 @@ sendTransaction ::
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> Float
+  -> Scientific
   -> T.Text
   -> T.Text
   -> PrivacyPolicy
@@ -2005,7 +2008,7 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
     Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
     Just outUA -> do
       res <-
-        runNoLoggingT $
+        runStderrLoggingT $
         prepareTxV2
           pool
           zHost
@@ -2021,10 +2024,10 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
                  else Just memo)
           ]
           policy
-      BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
       case res of
         Left e -> BC.writeBChan chan $ TickMsg $ show e
         Right rawTx -> do
+          BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
           resp <-
             makeZebraCall
               zHost
@@ -2073,7 +2076,7 @@ deshieldTransaction ::
   -> IO ()
 deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
   BC.writeBChan chan $ TickMsg "Deshielding funds..."
-  res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
+  res <- runStderrLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
   case res of
     Left e -> BC.writeBChan chan $ TickMsg $ show e
     Right rawTx -> do

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, 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,20 +116,25 @@ checkBlockChain nodeHost nodePort = do
 
 -- | Get commitment trees from Zebra
 getCommitmentTrees ::
-     T.Text -- ^ Host where `zebrad` is avaiable
+     ConnectionPool
+  -> T.Text -- ^ Host where `zebrad` is avaiable
   -> Int -- ^ Port where `zebrad` is available
   -> Int -- ^ Block height
   -> IO ZebraTreeInfo
-getCommitmentTrees nodeHost nodePort block = do
+getCommitmentTrees pool nodeHost nodePort block = do
-  r <-
+  bh' <- getBlockHash pool block
-    makeZebraCall
+  case bh' of
-      nodeHost
+    Nothing -> throwIO $ userError "couldn't get block hash"
-      nodePort
+    Just bh -> do
-      "z_gettreestate"
+      r <-
-      [Data.Aeson.String $ T.pack $ show block]
+        makeZebraCall
-  case r of
+          nodeHost
-    Left e -> throwIO $ userError e
+          nodePort
-    Right zti -> return zti
+          "z_gettreestate"
+          [Data.Aeson.String $ toText bh]
+      case r of
+        Left e -> throwIO $ userError e
+        Right zti -> return zti
 
 -- * Spending Keys
 -- | Create an Orchard Spending Key for the given wallet and account index
@@ -280,7 +285,7 @@ findSaplingOutputs ::
   -> Int -- ^ the starting block
   -> ZcashNetDB -- ^ The network
   -> Entity ZcashAccount -- ^ The account to use
-  -> LoggingT IO ()
+  -> NoLoggingT IO ()
 findSaplingOutputs config b znet za = do
   let dbPath = c_dbPath config
   let zebraHost = c_zebraHost config
@@ -288,7 +293,7 @@ findSaplingOutputs config b znet za = do
   let zn = getNet znet
   pool <- liftIO $ runNoLoggingT $ initPool dbPath
   tList <- liftIO $ getShieldedOutputs pool b znet
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
+  trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort (b - 1)
   logDebugN "getting Sapling frontier"
   let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
   case sT of
@@ -307,7 +312,7 @@ findSaplingOutputs config b znet za = do
       -> ZcashNet
       -> ConnectionPool
       -> [(Entity ZcashTransaction, Entity ShieldOutput)]
-      -> LoggingT IO ()
+      -> NoLoggingT IO ()
     decryptNotes _ _ _ [] = return ()
     decryptNotes st n pool ((zt, o):txs) = do
       let updatedTree =
@@ -395,7 +400,7 @@ findOrchardActions config b znet za = do
   let zn = getNet znet
   pool <- runNoLoggingT $ initPool dbPath
   tList <- getOrchardActions pool b znet
-  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
+  trees <- getCommitmentTrees pool zebraHost zebraPort (b - 1)
   let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
   case sT of
     Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
@@ -478,7 +483,7 @@ updateSaplingWitnesses pool = do
     updateOneNote maxId n = do
       let noteSync = walletSapNoteWitPos $ entityVal n
       when (noteSync < maxId) $ do
-        cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
+        cmus <- liftIO $ getSaplingCmus pool noteSync maxId
         let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
         let newWitness =
               updateSaplingWitness
@@ -496,7 +501,7 @@ updateOrchardWitnesses pool = do
     updateOneNote maxId n = do
       let noteSync = walletOrchNoteWitPos $ entityVal n
       when (noteSync < maxId) $ do
-        cmxs <- liftIO $ getOrchardCmxs pool noteSync
+        cmxs <- liftIO $ getOrchardCmxs pool noteSync maxId
         let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
         let newWitness =
               updateOrchardWitness
@@ -534,7 +539,7 @@ prepareTx ::
   -> ZcashNet
   -> ZcashAccountId
   -> Int
-  -> Float
+  -> Scientific
   -> UnifiedAddress
   -> T.Text
   -> LoggingT IO (Either TxError HexString)
@@ -555,7 +560,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
           Just r1 -> (4, getBytes r1)
   logDebugN $ T.pack $ show recipient
   logDebugN $ T.pack $ "Target block: " ++ show bh
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort bh
   let sT = SaplingCommitmentTree $ ztiSapling trees
   let oT = OrchardCommitmentTree $ ztiOrchard trees
   case accRead of
@@ -564,76 +569,97 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
       return $ Left ZHError
     Just acc -> do
       logDebugN $ T.pack $ show acc
-      let zats = floorFloatInteger $ amt * (10 ^ 8)
+      let zats' = toBoundedInteger $ amt * scientific 1 8
-      logDebugN $ T.pack $ show zats
+      case zats' of
-      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
+        Nothing -> return $ Left ZHError
-      --let fee = calculateTxFee firstPass $ fst recipient
+        Just zats -> do
-      --logDebugN $ T.pack $ "calculated fee " ++ show fee
+          logDebugN $ T.pack $ show (zats :: Int64)
-      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
+          {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
-      logDebugN "selected notes"
+          --let fee = calculateTxFee firstPass $ fst recipient
-      logDebugN $ T.pack $ show tList
+          --logDebugN $ T.pack $ "calculated fee " ++ show fee
-      logDebugN $ T.pack $ show sList
+          (tList, sList, oList) <-
-      logDebugN $ T.pack $ show oList
+            liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
-      let noteTotal = getTotalAmount (tList, sList, oList)
+          logDebugN "selected notes"
-      tSpends <-
-        liftIO $
-        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
-      --print tSpends
-      sSpends <-
-        liftIO $
-        prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
-      --print sSpends
-      oSpends <-
-        liftIO $
-        prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
-      --print oSpends
-      dummy <-
-        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
-      logDebugN "Calculating fee"
-      let feeResponse =
-            createTransaction
-              (Just sT)
-              (Just oT)
-              tSpends
-              sSpends
-              oSpends
-              dummy
-              zn
-              (bh + 3)
-              False
-      case feeResponse of
-        Left e1 -> return $ Left Fee
-        Right fee -> do
-          let feeAmt =
-                fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
-          (tList1, sList1, oList1) <-
-            liftIO $ selectUnspentNotes pool za (zats + feeAmt)
-          logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
           logDebugN $ T.pack $ show tList
           logDebugN $ T.pack $ show sList
           logDebugN $ T.pack $ show oList
-          outgoing <-
+          let noteTotal = getTotalAmount (tList, sList, oList)
-            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
+          tSpends <-
-          logDebugN $ T.pack $ show outgoing
+            liftIO $
-          let tx =
+            prepTSpends
+              (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
+              tList
+          --print tSpends
+          sSpends <-
+            liftIO $
+            prepSSpends
+              (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
+              sList
+          --print sSpends
+          oSpends <-
+            liftIO $
+            prepOSpends
+              (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+              oList
+          --print oSpends
+          dummy <-
+            liftIO $
+            makeOutgoing
+              acc
+              recipient
+              zats
+              (fromInteger noteTotal - 5000 - zats)
+          logDebugN "Calculating fee"
+          let feeResponse =
                 createTransaction
                   (Just sT)
                   (Just oT)
                   tSpends
                   sSpends
                   oSpends
-                  outgoing
+                  dummy
                   zn
-                  (bh + 3)
+                  bh
-                  True
+                  False
-          logDebugN $ T.pack $ show tx
+          case feeResponse of
-          return tx
+            Left e1 -> return $ Left Fee
+            Right fee -> do
+              let feeAmt =
+                    fromIntegral
+                      (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
+              (tList1, sList1, oList1) <-
+                liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
+              logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
+              logDebugN $ T.pack $ show tList
+              logDebugN $ T.pack $ show sList
+              logDebugN $ T.pack $ show oList
+              outgoing <-
+                liftIO $
+                makeOutgoing
+                  acc
+                  recipient
+                  zats
+                  (fromInteger noteTotal - fromInteger feeAmt - zats)
+              logDebugN $ T.pack $ show outgoing
+              let tx =
+                    createTransaction
+                      (Just sT)
+                      (Just oT)
+                      tSpends
+                      sSpends
+                      oSpends
+                      outgoing
+                      zn
+                      bh
+                      True
+              logDebugN $ T.pack $ show tx
+              return tx
   where
     makeOutgoing ::
          Entity ZcashAccount
       -> (Int, BS.ByteString)
-      -> Integer
+      -> Int64
-      -> Integer
+      -> Int64
       -> IO [OutgoingNote]
     makeOutgoing acc (k, recvr) zats chg = do
       chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
@@ -752,11 +778,11 @@ deshieldNotes ::
   -> ZcashAccountId
   -> Int
   -> ProposedNote
-  -> NoLoggingT IO (Either TxError HexString)
+  -> LoggingT IO (Either TxError HexString)
 deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
   bal <- liftIO $ getShieldedBalance pool za
-  let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
+  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 +797,11 @@ shieldTransparentNotes ::
 shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
   accRead <- liftIO $ getAccountById pool za
   logDebugN $ T.pack $ "Target block: " ++ show bh
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  {-
-  let sT = SaplingCommitmentTree $ ztiSapling trees
+   -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"
@@ -810,8 +838,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
                 True
         let tx =
               createTransaction
-                (Just sT)
+                Nothing
-                (Just oT)
+                Nothing
                 tSpends
                 []
                 []
@@ -871,15 +899,17 @@ prepareTxV2 ::
   -> Int
   -> [ProposedNote]
   -> PrivacyPolicy
-  -> NoLoggingT IO (Either TxError HexString)
+  -> LoggingT IO (Either TxError HexString)
 prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
   accRead <- liftIO $ getAccountById pool za
   let recipients = map extractReceiver pnotes
   logDebugN $ T.pack $ show recipients
   logDebugN $ T.pack $ "Target block: " ++ show bh
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  {-
-  let sT = SaplingCommitmentTree $ ztiSapling trees
+   -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"
@@ -887,164 +917,199 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
     Just acc -> do
       logDebugN $ T.pack $ show acc
       let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
-      let zats = ceilingFloatInteger $ amt * (10 ^ 8)
+      let zats' = toBoundedInteger $ amt * scientific 1 8
-      logDebugN $ "amt: " <> T.pack (show amt)
+      case zats' of
-      logDebugN $ "zats: " <> T.pack (show zats)
+        Nothing -> do
-      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
+          logErrorN "Failed to parse amount into zats"
-      --let fee = calculateTxFee firstPass $ fst recipient
+          return $ Left ZHError
-      --logDebugN $ T.pack $ "calculated fee " ++ show fee
+        Just zats -> do
-      notePlan <-
+          logDebugN $ "amt: " <> T.pack (show amt)
-        liftIO $
+          logDebugN $ "zats: " <> T.pack (show zats)
-        selectUnspentNotesV2
+          {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
-          pool
+          --let fee = calculateTxFee firstPass $ fst recipient
-          za
+          --logDebugN $ T.pack $ "calculated fee " ++ show fee
-          (zats + 10000)
+          notePlan <-
-          (map (\(x, _, _, _) -> x) recipients)
-          policy
-      case notePlan of
-        Right (tList, sList, oList) -> do
-          logDebugN "selected notes"
-          logDebugN $ T.pack $ show tList
-          logDebugN $ T.pack $ show sList
-          logDebugN $ T.pack $ show oList
-          let noteTotal = getTotalAmount (tList, sList, oList)
-          logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
-          tSpends <-
             liftIO $
-            prepTSpends
+            selectUnspentNotesV2
-              (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
+              pool
-              tList
+              za
-            --print tSpends
+              (zats + 10000)
-          sSpends <-
+              (map (\(x, _, _, _) -> x) recipients)
-            liftIO $
+              policy
-            prepSSpends
+          case notePlan of
-              (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
+            Right (tList, sList, oList) -> do
-              sList
+              logDebugN "selected notes"
-            --print sSpends
+              logDebugN $ T.pack $ show tList
-          oSpends <-
+              logDebugN $ T.pack $ show sList
-            liftIO $
+              logDebugN $ T.pack $ show oList
-            prepOSpends
+              let noteTotal = getTotalAmount (tList, sList, oList)
-              (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+              logDebugN $ "noteTotal: " <> T.pack (show noteTotal)
-              oList
+              tSpends <-
-            --print oSpends
+                liftIO $
-          dummy' <-
+                prepTSpends
-            liftIO $
+                  (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
-            makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
+                  tList
-          case dummy' of
+                --print tSpends
-            Left e -> return $ Left e
+              sSpends <-
-            Right dummy -> do
+                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
+              dummy' <-
-                      False
+                liftIO $
-              case feeResponse of
+                makeOutgoing
-                Left e1 -> return $ Left Fee
+                  acc
-                Right fee -> do
+                  recipients
-                  let feeAmt =
+                  (noteTotal - 5000 - fromIntegral zats)
-                        fromIntegral
+                  policy
-                          (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
+              case dummy' of
-                  finalNotePlan <-
+                Left e -> return $ Left e
-                    liftIO $
+                Right dummy -> do
-                    selectUnspentNotesV2
+                  logDebugN "Calculating fee"
-                      pool
+                  let feeResponse =
-                      za
+                        createTransaction
-                      (zats + feeAmt)
+                          Nothing
-                      (map (\(x, _, _, _) -> x) recipients)
+                          Nothing
-                      policy
+                          tSpends
-                  case finalNotePlan of
+                          sSpends
-                    Right (tList1, sList1, oList1) -> do
+                          oSpends
-                      logDebugN $
+                          dummy
-                        T.pack $ "selected notes with fee" ++ show feeAmt
+                          zn
-                      logDebugN $ T.pack $ show tList1
+                          bh
-                      logDebugN $ T.pack $ show sList1
+                          False
-                      logDebugN $ T.pack $ show oList1
+                  case feeResponse of
-                      tSpends1 <-
+                    Left e1 -> return $ Left Fee
+                    Right fee -> do
+                      let feeAmt =
+                            fromIntegral
+                              (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
+                      finalNotePlan <-
                         liftIO $
-                        prepTSpends
+                        selectUnspentNotesV2
-                          (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
+                          pool
-                          tList1
+                          za
-                      sSpends1 <-
+                          (fromIntegral zats + feeAmt)
-                        liftIO $
+                          (map (\(x, _, _, _) -> x) recipients)
-                        prepSSpends
-                          (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                          sList1
-                      oSpends1 <-
-                        liftIO $
-                        prepOSpends
-                          (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-                          oList1
-                      let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
-                      outgoing' <-
-                        liftIO $
-                        makeOutgoing
-                          acc
-                          recipients
-                          (noteTotal1 - feeAmt - zats)
                           policy
-                      logDebugN $ T.pack $ show outgoing'
+                      case finalNotePlan of
-                      case outgoing' of
+                        Right (tList1, sList1, oList1) -> do
+                          logDebugN $
+                            T.pack $ "selected notes with fee" ++ show feeAmt
+                          logDebugN $ T.pack $ show tList1
+                          logDebugN $ T.pack $ show sList1
+                          logDebugN $ T.pack $ show oList1
+                          tSpends1 <-
+                            liftIO $
+                            prepTSpends
+                              (getTranSK $
+                               zcashAccountTPrivateKey $ entityVal acc)
+                              tList1
+                          sSpends1 <-
+                            liftIO $
+                            prepSSpends
+                              (getSapSK $
+                               zcashAccountSapSpendKey $ entityVal acc)
+                              sList1
+                          oSpends1 <-
+                            liftIO $
+                            prepOSpends
+                              (getOrchSK $
+                               zcashAccountOrchSpendKey $ entityVal acc)
+                              oList1
+                          let noteTotal1 =
+                                getTotalAmount (tList1, sList1, oList1)
+                          outgoing' <-
+                            liftIO $
+                            makeOutgoing
+                              acc
+                              recipients
+                              (noteTotal1 - feeAmt - fromIntegral zats)
+                              policy
+                          logDebugN $ T.pack $ show outgoing'
+                          case outgoing' of
+                            Left e -> return $ Left e
+                            Right outgoing -> do
+                              let tx =
+                                    createTransaction
+                                      Nothing
+                                      Nothing
+                                      tSpends1
+                                      sSpends1
+                                      oSpends1
+                                      outgoing
+                                      zn
+                                      bh
+                                      True
+                              logDebugN $ T.pack $ show tx
+                              return tx
                         Left e -> return $ Left e
-                        Right outgoing -> do
+            Left e -> do
-                          let tx =
+              logErrorN $ T.pack $ show e
-                                createTransaction
+              return $ Left e
-                                  (Just sT)
-                                  (Just oT)
-                                  tSpends1
-                                  sSpends1
-                                  oSpends1
-                                  outgoing
-                                  zn
-                                  bh
-                                  True
-                          logDebugN $ T.pack $ show tx
-                          return tx
-                    Left e -> return $ Left e
-        Left e -> do
-          logErrorN $ T.pack $ show e
-          return $ Left e
   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
-            Unified ua ->
+            Nothing -> (0, "", 0, "")
-              case o_rec ua of
+            Just zats ->
-                Nothing ->
+              case va of
-                  case s_rec ua of
+                Unified ua ->
+                  case o_rec ua of
                     Nothing ->
-                      case t_rec ua of
+                      case s_rec ua of
-                        Nothing -> (0, "", 0, "")
+                        Nothing ->
-                        Just r3 ->
+                          case t_rec ua of
-                          case tr_type r3 of
+                            Nothing -> (0, "", 0, "")
-                            P2PKH ->
+                            Just r3 ->
-                              (1, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
+                              case tr_type r3 of
-                            P2SH ->
+                                P2PKH ->
-                              (2, toBytes $ tr_bytes r3, zats, fromMaybe "" m)
+                                  ( 1
-                    Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
+                                  , toBytes $ tr_bytes r3
-                Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
+                                  , zats
-            Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
+                                  , fromMaybe "" m)
-            Transparent ta ->
+                                P2SH ->
-              case tr_type (ta_receiver ta) of
+                                  ( 2
-                P2PKH ->
+                                  , toBytes $ tr_bytes r3
-                  (1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
+                                  , zats
-                P2SH ->
+                                  , fromMaybe "" m)
-                  (2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m)
+                        Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
-            Exchange ea ->
+                    Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
-              case tr_type (ex_address ea) of
+                Sapling sa ->
-                P2PKH ->
+                  (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
-                  (5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
+                Transparent ta ->
-                P2SH ->
+                  case tr_type (ta_receiver ta) of
-                  (6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m)
+                    P2PKH ->
+                      ( 1
+                      , toBytes $ tr_bytes (ta_receiver ta)
+                      , zats
+                      , fromMaybe "" m)
+                    P2SH ->
+                      ( 2
+                      , toBytes $ tr_bytes (ta_receiver ta)
+                      , zats
+                      , fromMaybe "" m)
+                Exchange ea ->
+                  case tr_type (ex_address ea) of
+                    P2PKH ->
+                      ( 5
+                      , toBytes $ tr_bytes (ex_address ea)
+                      , zats
+                      , fromMaybe "" m)
+                    P2SH ->
+                      ( 6
+                      , toBytes $ tr_bytes (ex_address ea)
+                      , zats
+                      , fromMaybe "" m)
     prepareOutgoingNote ::
-         ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote
+         ZcashAccount -> (Int, BS.ByteString, Int64, T.Text) -> OutgoingNote
     prepareOutgoingNote zac (k, r, a, m) =
       OutgoingNote
         (if k == 5
@@ -1062,8 +1127,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
         False
     makeOutgoing ::
          Entity ZcashAccount
-      -> [(Int, BS.ByteString, Int, T.Text)]
+      -> [(Int, BS.ByteString, Int64, T.Text)]
-      -> Integer
+      -> Int64
       -> PrivacyPolicy
       -> IO (Either TxError [OutgoingNote])
     makeOutgoing acc recvs chg pol = do
@@ -1195,7 +1260,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
          ( [Entity WalletTrNote]
          , [Entity WalletSapNote]
          , [Entity WalletOrchNote])
-      -> Integer
+      -> Int64
     getTotalAmount (t, s, o) =
       sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
       sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
@@ -1300,16 +1365,18 @@ syncWallet config w = do
   let startBlock =
         if lastBlock > 0
           then lastBlock
-          else zcashWalletBirthdayHeight $ entityVal w
+          else 1 + zcashWalletBirthdayHeight (entityVal w)
   logDebugN $ "start block: " <> T.pack (show startBlock)
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
   logDebugN "processed transparent notes"
   mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
   logDebugN "processed transparent spends"
-  mapM_
+  liftIO $
-    (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
+    runNoLoggingT $
-    accs
+    mapM_
+      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
+      accs
   logDebugN "processed sapling outputs"
   liftIO $
     mapM_

src/Zenith/DB.hs

@@ -698,6 +698,7 @@ saveAddress pool w =
   runNoLoggingT $
   PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
 
+-- * Block
 -- | Save a block to the database
 saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
 saveBlock pool b =
@@ -714,6 +715,20 @@ getBlock pool b =
       where_ $ bl ^. ZcashBlockHeight ==. val b
       pure bl
 
+getBlockHash :: ConnectionPool -> Int -> IO (Maybe HexString)
+getBlockHash pool b = do
+  r <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        bl <- from $ table @ZcashBlock
+        where_ $ bl ^. ZcashBlockHeight ==. val b
+        pure $ bl ^. ZcashBlockHash
+  case r of
+    Nothing -> return Nothing
+    Just (Value h) -> return $ Just $ getHex h
+
 -- | Save a transaction to the data model
 saveTransaction ::
      ConnectionPool -- ^ the database path
@@ -1776,12 +1791,16 @@ getUnspentSapNotes pool = do
         where_ (n ^. WalletSapNoteSpent ==. val False)
         pure n
 
-getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
+getSaplingCmus ::
-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 +1859,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 +2359,7 @@ selectUnspentNotes pool za amt = do
 selectUnspentNotesV2 ::
      ConnectionPool
   -> ZcashAccountId
-  -> Integer
+  -> Int64
   -> [Int]
   -> PrivacyPolicy
   -> IO

src/Zenith/GUI.hs

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

src/Zenith/RPC.hs

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

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
@@ -127,9 +132,9 @@ isRecipientValid a = do
 
 isUnifiedAddressValid :: T.Text -> Bool
 isUnifiedAddressValid ua =
-    case isValidUnifiedAddress (E.encodeUtf8 ua)  of
+  case isValidUnifiedAddress (E.encodeUtf8 ua) of
-            Just _a1 -> True
+    Just _a1 -> True
-            Nothing -> False
+    Nothing -> False
 
 isSaplingAddressValid :: T.Text -> Bool
 isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
@@ -137,8 +142,8 @@ isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
 isTransparentAddressValid :: T.Text -> Bool
 isTransparentAddressValid ta =
   case decodeTransparentAddress (E.encodeUtf8 ta) of
-         Just _a3 -> True
+    Just _a3 -> True
-         Nothing -> False
+    Nothing -> False
 
 isExchangeAddressValid :: T.Text -> Bool
 isExchangeAddressValid xa =
@@ -147,40 +152,44 @@ isExchangeAddressValid xa =
     Nothing -> False
 
 isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
-isRecipientValidGUI p a  = do
+isRecipientValidGUI p a = do
   let adr = parseAddress (E.encodeUtf8 a)
-  case p of 
+  case p of
-    Full -> case adr of  
+    Full ->
-              Just a -> 
+      case adr of
-                case a of  
+        Just a ->
-                    Unified ua -> True
+          case a of
-                    Sapling sa -> True
+            Unified ua -> True
-                    _ -> False
+            Sapling sa -> True
-              Nothing -> False
+            _ -> False
-    Medium -> case adr of 
+        Nothing -> False
-                Just a -> 
+    Medium ->
-                  case a of  
+      case adr of
-                      Unified ua -> True
+        Just a ->
-                      Sapling sa -> True
+          case a of
-                      _ -> False
+            Unified ua -> True
-                Nothing -> False
+            Sapling sa -> True
-    Low -> case adr of  
+            _ -> False
-              Just a -> 
+        Nothing -> False
-                case a of  
+    Low ->
-                    Unified ua -> True
+      case adr of
-                    Sapling sa -> True
+        Just a ->
-                    Transparent ta -> True
+          case a of
-                    _ -> False
+            Unified ua -> True
-              Nothing -> False
+            Sapling sa -> True
-    None -> case adr of  
+            Transparent ta -> True
-              Just a -> 
+            _ -> False
-                case a of  
+        Nothing -> False
-                    Transparent ta -> True
+    None ->
-                    Exchange ea -> True
+      case adr of
-                    _ -> False
+        Just a ->
-              Nothing -> False
+          case a of
+            Transparent ta -> True
+            Exchange ea -> True
+            _ -> False
+        Nothing -> False
 
-isZecAddressValid ::  T.Text -> Bool
+isZecAddressValid :: T.Text -> Bool
 isZecAddressValid a = do
   case isValidUnifiedAddress (E.encodeUtf8 a) of
     Just _a1 -> True
@@ -232,3 +241,10 @@ padWithZero n s
 isEmpty :: [a] -> Bool
 isEmpty [] = True
 isEmpty _ = False
+
+getChainTip :: T.Text -> Int -> IO Int
+getChainTip zHost zPort = do
+  r <- makeZebraCall zHost zPort "getblockcount" []
+  case r of
+    Left e1 -> pure 0
+    Right i -> pure i

test/Spec.hs

@@ -2,6 +2,7 @@
 
 import Control.Monad (when)
 import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
+import Data.Aeson
 import Data.HexString
 import Data.Maybe (fromJust)
 import qualified Data.Text.Encoding as E
@@ -33,8 +34,10 @@ import ZcashHaskell.Types
   , Scope(..)
   , ShieldedOutput(..)
   , TxError(..)
+  , ValidAddress(..)
   , ZcashNet(..)
   )
+import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
 import Zenith.Core
 import Zenith.DB
 import Zenith.Types
@@ -182,6 +185,12 @@ main = do
           a `shouldBe`
             Just
               "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+      describe "Witnesses" $ do
+        describe "Sapling" $ do
+          it "max output id" $ do
+            pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+            sId <- getMaxSaplingNote pool
+            sId `shouldBe` toSqlKey 0
       describe "Notes" $ do
         xit "Check Orchard notes" $ do
           pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@@ -573,3 +582,17 @@ main = do
                 case tx of
                   Left e -> assertFailure $ show e
                   Right h -> h `shouldNotBe` (hexString "deadbeef")
+    describe "Quick tests" $ do
+      it "validate comm trees" $ do
+        blockTree <- getCommitmentTrees "localhost" 18232 3034848
+        hashTree <-
+          makeZebraCall
+            "localhost"
+            18232
+            "z_gettreestate"
+            [ Data.Aeson.String
+                "000f8a912c6c5caf476e70fa0616c17ab4e7e8c1f42e24bddeacda275d545473"
+            ]
+        case hashTree of
+          Left e -> assertFailure e
+          Right hT -> blockTree `shouldBe` hT