wip

hbs2-git3/app/GitRemoteHelper.hs

@@ -114,8 +114,6 @@ localDict DeferredOps{..} = makeDict @C do
 
       t0 <- getTimeCoarse
 
-      -- waitRepo Nothing
-
       importGitRefLog
 
       rrefs <- importedRefs

hbs2-git3/lib/HBS2/Git3/Import.hs

@@ -7,6 +7,7 @@ import HBS2.Git3.State
 import HBS2.Git3.Git
 import HBS2.Git3.Git.Pack
 
+import HBS2.Data.Detect (ScanLevel(..), deepScan)
 import HBS2.Storage.Operations.Missed
 import HBS2.CLI.Run.Internal.Merkle (getTreeContents)
 import HBS2.Data.Log.Structured
@@ -53,7 +54,7 @@ writeAsGitPack dir href = do
     seen_ <- newTVarIO (mempty :: HashSet GitHash)
 
     source <- liftIO (runExceptT (getTreeContents sto href))
-                >>= orThrow MissedBlockError
+                >>= orThrow (MissedBlockError2 (show $ pretty href))
 
     lbs' <- decompressSegmentLBS source
 
@@ -139,7 +140,16 @@ importGitRefLog = withStateDo do
     ([], r) -> pure (gitTxTree <$> r)
     (TxSegment{}:xs, l) -> next (xs, l)
     (cp@(TxCheckpoint n tree) : xs, l) -> do
-      full <- findMissedBlocks sto tree <&> L.null
+
+      -- full <- findMissedBlocks sto tree <&> L.null
+      missed_ <- newTVarIO 0
+      deepScan ScanDeep (\_ -> atomically $ modifyTVar missed_ succ)
+                        (coerce tree)
+                        (getBlock sto)
+                        (const none)
+
+      full <- readTVarIO missed_ <&> (==0)
+
       if full && Just n > (getGitTxRank <$> l) then do
         next (xs, Just cp)
       else do

hbs2-git3/lib/HBS2/Git3/State.hs

@@ -212,6 +212,7 @@ data CWRepo =
   | CCheckManifest (LWWRef HBS2Basic)
   | CAborted
 
+
 waitRepo :: forall m . HBS2GitPerks m => Maybe (Timeout 'Seconds) -> Git3 m ()
 waitRepo timeout = do
   repoKey <- getGitRepoKey >>= orThrow GitRepoRefNotSet
@@ -288,8 +289,15 @@ waitRepo timeout = do
 
         flip fix () $ \next _ -> do
            notice $ "wait for data (2)" <+> pretty (AsBase58 reflog)
-           missed <- findMissedBlocks sto rv
+           -- missed <- findMissedBlocks sto rv
-           unless (L.null missed) $ wait 2 next ()
+           missed_ <- newTVarIO 0
+           lift $ deepScan ScanDeep (\_ -> atomically $ modifyTVar missed_ succ) (coerce rv) (getBlock sto) (const none)
+           missed <- readTVarIO missed_
+
+           when (missed > 0) do
+            notice $ "still missed blocks:" <+> pretty missed
+            wait 5 next ()
+
            atomically $ writeTMVar okay True
 
         pWait <- ContT $ withAsync $ race ( pause (fromMaybe 300 timeout) ) do

hbs2-git3/lib/HBS2/Git3/State/Internal/Index.hs

@@ -333,7 +333,7 @@ updateReflogIndex = do
 
                   -- FIXME: error logging
                   source <- liftIO (runExceptT (getTreeContents sto href))
-                               >>= orThrow MissedBlockError
+                               >>= orThrow (MissedBlockError2 (show $ pretty href))
 
                   what <- decompressSegmentLBS source
                              >>= toMPlus

hbs2-git3/lib/HBS2/Git3/State/Internal/RefLog.hs

@@ -82,7 +82,7 @@ txList filt mhref = do
            Nothing -> lift refLogRef >>= toMPlus
 
     hxs <- S.toList_ $ walkMerkle @[HashRef] (coerce rv) (getBlock sto) $ \case
-      Left{} -> throwIO MissedBlockError
+      Left{} -> throwIO (MissedBlockError2 "txList")
       Right hs -> filterM (lift . lift . filt) hs >>= S.each
 
     S.toList_ $ for_ hxs $ \h -> do

nix/peer/shitty-net.sh

@@ -1,4 +1,4 @@
-NIC=ve-hbs2-test
+NIC=$1
 
 sudo tc qdisc del dev $NIC root
 sudo tc qdisc add dev $NIC root netem delay 200ms 40ms loss 1%