Make applyHistoricalBlock return (), and fix moving-target bug.

Author: matt-noonan

wallet-new/src/Cardano/Wallet/Kernel/DB/AcidState.hs

@@ -265,9 +265,9 @@ applyHistoricalBlock :: SecurityParameter
                      -> InDb SlotId
                      -> SlotCount
                      -> Map HdAccountId PrefilteredBlock
-                     -> Update DB (Map HdAccountId (Set TxId))
+                     -> Update DB ()
 applyHistoricalBlock k (InDb slotId) slotCount blocks =
-  runUpdateNoErrors $ zoom dbHdWallets $
+  void $ runUpdateNoErrors $ zoom dbHdWallets $
     updateAccounts =<< mkUpdates <$> use hdWalletsAccounts
   where
     mkUpdates :: IxSet HdAccount -> [AccountUpdate Void (Set TxId)]
@@ -319,12 +319,12 @@ applyHistoricalBlock k (InDb slotId) slotCount blocks =
 
         isUpToDate :: HdAccountWithinK -> Bool
         isUpToDate st = let cur = st ^. hdWithinKHistorical . currentCheckpoint
-                            tgt = st ^. hdWithinKCurrent . currentCheckpoint
+                            tgt = st ^. hdWithinKCurrent . oldestCheckpoint
                         in checkpointDistance cur tgt == 1
 
         isWithinK :: HdAccountOutsideK -> Bool
         isWithinK st =  let cur = st ^. hdOutsideKHistorical
-                            tgt = st ^. hdOutsideKCurrent . currentCheckpoint
+                            tgt = st ^. hdOutsideKCurrent . oldestCheckpoint
                             SecurityParameter k0 = k
                         in checkpointDistance cur tgt <= fromIntegral k0
 

wallet-new/src/Cardano/Wallet/Kernel/DB/Spec.hs

@@ -34,13 +34,16 @@ module Cardano.Wallet.Kernel.DB.Spec (
   , currentSlotId
   , currentAddressMeta
   , currentForeign
+    -- ** Convenience: accessors for other checkpoints
+  , oldestCheckpoint
   ) where
 
 import           Universum
 
-import           Control.Lens (from, _Wrapped)
+import           Control.Lens (Getter, from, to, _Wrapped)
 import           Control.Lens.TH (makeLenses)
 import           Data.Coerce (coerce)
+import qualified Data.List.NonEmpty as NE
 import           Data.SafeCopy (base, deriveSafeCopy)
 import           Formatting (bprint, build, (%))
 import qualified Formatting.Buildable
@@ -279,6 +282,13 @@ currentSlotId           = currentCheckpoint . cpSlotId
 currentAddressMeta addr = currentCheckpoint . cpAddressMeta addr
 currentForeign          = currentCheckpoint . cpForeign
 
+{-------------------------------------------------------------------------------
+  Convenience: accessors for other checkpoints
+-------------------------------------------------------------------------------}
+
+oldestCheckpoint :: Getter (NewestFirst NonEmpty c) c
+oldestCheckpoint = _Wrapped . to NE.last
+
 {-------------------------------------------------------------------------------
   Pretty-printing
 -------------------------------------------------------------------------------}

wallet-new/src/Cardano/Wallet/Kernel/Restore.hs

@@ -29,14 +29,13 @@ import           Cardano.Wallet.Kernel.DB.InDb (InDb (..))
 import           Cardano.Wallet.Kernel.DB.TxMeta.Types
 import           Cardano.Wallet.Kernel.Decrypt (decryptAddress)
 import           Cardano.Wallet.Kernel.Internal (WalletRestorationInfo (..),
-                     walletMeta, walletNode, walletRestorationTask,
-                     walletSubmission, wallets, wriCurrentSlot, wriTargetSlot)
+                     walletMeta, walletNode, walletRestorationTask, wallets,
+                     wriCurrentSlot, wriTargetSlot)
 import           Cardano.Wallet.Kernel.NodeStateAdaptor (LockContext (..),
                      SecurityParameter (..), getSecurityParameter,
                      getSlotCount, withNodeState)
 import           Cardano.Wallet.Kernel.PrefilterTx (PrefilteredBlock, WalletKey,
                      toHdAddressId)
-import qualified Cardano.Wallet.Kernel.Submission as Submission
 import           Cardano.Wallet.Kernel.Types (WalletId)
 
 import           Pos.Chain.Block (BlockHeader, Blund, HeaderHash, blockHeader,
@@ -158,9 +157,7 @@ restoreWalletHistoryAsync wallet wId target tgtSlot prefilter = do
             say ("  about to apply block for " <> pretty (mb ^. mainBlockSlot)
                  <> " with k=" <> pretty k0 <> " and slotCount=" <> pretty slotCount
                 <> " slotId=" <> pretty slotId <> ", tgtSlot=" <> pretty tgtSlot)
-            confirmed <- update (wallet ^. wallets)
-                        (ApplyHistoricalBlock k (InDb slotId) slotCount prefilteredBlocks)
-            modifyMVar_ (wallet ^. walletSubmission) (return . Submission.remPending confirmed)
+            update (wallet ^. wallets) (ApplyHistoricalBlock k (InDb slotId) slotCount prefilteredBlocks)
 
             -- Update our progress
             say "updating progress..."