diff --git a/hbs2-git3/app/GitRemoteHelper.hs b/hbs2-git3/app/GitRemoteHelper.hs index 26ab44f7..15ace050 100644 --- a/hbs2-git3/app/GitRemoteHelper.hs +++ b/hbs2-git3/app/GitRemoteHelper.hs @@ -114,8 +114,6 @@ localDict DeferredOps{..} = makeDict @C do t0 <- getTimeCoarse - -- waitRepo Nothing - importGitRefLog rrefs <- importedRefs diff --git a/hbs2-git3/lib/HBS2/Git3/Import.hs b/hbs2-git3/lib/HBS2/Git3/Import.hs index 9aa9f991..7a696d0c 100644 --- a/hbs2-git3/lib/HBS2/Git3/Import.hs +++ b/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 diff --git a/hbs2-git3/lib/HBS2/Git3/State.hs b/hbs2-git3/lib/HBS2/Git3/State.hs index 56fd1b60..6cb5b092 100644 --- a/hbs2-git3/lib/HBS2/Git3/State.hs +++ b/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 - unless (L.null missed) $ wait 2 next () + -- missed <- findMissedBlocks sto rv + 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 diff --git a/hbs2-git3/lib/HBS2/Git3/State/Internal/Index.hs b/hbs2-git3/lib/HBS2/Git3/State/Internal/Index.hs index ed7625be..b1b6e603 100644 --- a/hbs2-git3/lib/HBS2/Git3/State/Internal/Index.hs +++ b/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 diff --git a/hbs2-git3/lib/HBS2/Git3/State/Internal/RefLog.hs b/hbs2-git3/lib/HBS2/Git3/State/Internal/RefLog.hs index 7be46729..8133d77d 100644 --- a/hbs2-git3/lib/HBS2/Git3/State/Internal/RefLog.hs +++ b/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 diff --git a/nix/peer/shitty-net.sh b/nix/peer/shitty-net.sh index 35484a68..02b1e7fc 100755 --- a/nix/peer/shitty-net.sh +++ b/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%