From d69a2d7595c146bd364f958dacfb9482f83328d4 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Fri, 11 Jul 2025 07:10:13 +0300 Subject: [PATCH] wip --- hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs | 30 +++++++++++++++++------ hbs2-tests/test/TestNCQ.hs | 17 ++++++------- 2 files changed, 30 insertions(+), 17 deletions(-) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs index 94057922..542ddfbd 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs @@ -107,6 +107,13 @@ newtype NCQEntry = NCQEntry ByteString type Shard = TVar (HashMap HashRef NCQEntry) +type NCQOffset = Word64 +type NCQSize = Word32 + +data Location = + InFossil ByteString NCQOffset NCQSize + | InMemory ByteString + data NCQStorage2 = NCQStorage2 { ncqRoot :: FilePath @@ -228,15 +235,22 @@ ncqPutBS ncq@NCQStorage2{..} mtp mhref bs' = do ncqLookupEntry :: MonadUnliftIO m => NCQStorage2 -> HashRef -> m (Maybe NCQEntry) ncqLookupEntry sto hash = atomically (ncqLookupEntrySTM sto hash) -ncqReadEntry :: ByteString -> Word64 -> Word32 -> ByteString -ncqReadEntry mmaped off size = BS.take (fromIntegral size) $ BS.drop (fromIntegral off) mmaped -{-# INLINE ncqReadEntry #-} +ncqGetEntryBS :: NCQStorage2 -> Location -> ByteString +ncqGetEntryBS _ = \case + InMemory bs -> bs + InFossil mmap off size -> do + BS.take (fromIntegral size) $ BS.drop (fromIntegral off) mmap -ncqSearchBS :: MonadUnliftIO m => NCQStorage2 -> HashRef -> m (Maybe ByteString) -ncqSearchBS ncq@NCQStorage2{..} href = flip runContT pure $ callCC \exit -> do +ncqEntrySize :: forall a . Integral a => Location -> a +ncqEntrySize = \case + InFossil _ _ size -> fromIntegral size + InMemory bs -> fromIntegral (BS.length bs) + +ncqLocate2 :: MonadUnliftIO m => NCQStorage2 -> HashRef -> m (Maybe Location) +ncqLocate2 ncq@NCQStorage2{..} href = flip runContT pure $ callCC \exit -> do now <- getTimeCoarse - lift (ncqLookupEntry ncq href) >>= maybe none (exit . Just . coerce) + lift (ncqLookupEntry ncq href) >>= maybe none (exit . Just . InMemory . coerce) tracked <- readTVarIO ncqTrackedFiles <&> HPSQ.toList @@ -246,7 +260,7 @@ ncqSearchBS ncq@NCQStorage2{..} href = flip runContT pure $ callCC \exit -> do Nothing -> none Just (offset,size) -> do atomically $ writeTVar cachedTs now - exit (Just $ ncqReadEntry cachedMmapedData offset size) + exit (Just $ InFossil cachedMmapedData offset size) Nothing -> do let indexFile = ncqGetFileName ncq (toFileName (IndexFile fk)) @@ -268,7 +282,7 @@ ncqSearchBS ncq@NCQStorage2{..} href = flip runContT pure $ callCC \exit -> do modifyTVar ncqCachedEntries (+1) evictIfNeededSTM ncq (Just 1) - exit $ Just (ncqReadEntry datBs offset size) + exit $ Just (InFossil datBs offset size) pure mzero diff --git a/hbs2-tests/test/TestNCQ.hs b/hbs2-tests/test/TestNCQ.hs index 8dfc8586..2776a142 100644 --- a/hbs2-tests/test/TestNCQ.hs +++ b/hbs2-tests/test/TestNCQ.hs @@ -610,18 +610,17 @@ testNCQ2Simple1 TestEnv{..} = do for bz $ \z -> do h <- ncqPutBS sto (Just B) Nothing z atomically $ writeTQueue q h - found <- ncqSearchBS sto h <&> maybe (-1) BS.length + found <- ncqLocate2 sto h <&> maybe (-1) ncqEntrySize assertBool (show $ "found-immediate" <+> pretty h) (found > 0) ncqWithStorage ncqDir $ \sto -> liftIO do hashes <- atomically (STM.flushTQueue q) for_ hashes $ \ha -> do - found <- ncqSearchBS sto ha <&> maybe (-1) BS.length + found <- ncqLocate2 sto ha <&> maybe (-1) ncqEntrySize assertBool (show $ "found-immediate" <+> pretty ha) (found > 0) -- debug $ fill 44 (pretty ha) <+> fill 8 (pretty found) - testFilterEmulate1 :: MonadUnliftIO m => Int -> TestEnv @@ -670,14 +669,14 @@ testFilterEmulate1 n TestEnv{..} = do (t1,_) <- timeItT do for_ allShit $ \ha -> do - ncqSearchBS sto ha <&> maybe (-1) BS.length + ncqLocate2 sto ha <&> maybe (-1) ncqEntrySize notice $ "lookup-no-filter" <+> pretty (realToFrac @_ @(Fixed E3) t1) (t2,_) <- timeItT do for_ allShit $ \ha -> do unless (HS.member ha noHs) do - void $ ncqSearchBS sto ha <&> maybe (-1) BS.length + void $ ncqLocate2 sto ha <&> maybe (-1) ncqEntrySize notice $ "lookup-fake-filter" <+> pretty (realToFrac @_ @(Fixed E3) t2) @@ -685,7 +684,7 @@ testFilterEmulate1 n TestEnv{..} = do for_ allShit $ \ha -> do let here = IntSet.member (bucno ha) dumb when here do - void $ ncqSearchBS sto ha <&> maybe (-1) BS.length + void $ ncqLocate2 sto ha <&> maybe (-1) ncqEntrySize notice $ "lookup-dumb-filter" <+> pretty (realToFrac @_ @(Fixed E3) t3) @@ -693,7 +692,7 @@ testFilterEmulate1 n TestEnv{..} = do for_ allShit $ \ha -> do let here = Bloom.elem (coerce ha) bloom when here do - void $ ncqSearchBS sto ha <&> maybe (-1) BS.length + void $ ncqLocate2 sto ha <&> maybe (-1) ncqEntrySize notice $ "lookup-simple-bloom-filter" <+> pretty (realToFrac @_ @(Fixed E3) t4) @@ -718,7 +717,7 @@ testNCQ2Repair1 TestEnv{..} = do for_ bz $ \z -> do h <- ncqPutBS sto (Just B) Nothing z atomically $ writeTQueue q h - found <- ncqSearchBS sto h <&> maybe (-1) BS.length + found <- ncqLocate2 sto h <&> maybe (-1) ncqEntrySize assertBool (show $ "found-immediate" <+> pretty h) (found > 0) written <- N2.ncqListTrackedFiles sto debug $ "TRACKED" <+> vcat (fmap pretty written) @@ -737,7 +736,7 @@ testNCQ2Repair1 TestEnv{..} = do ncqWithStorage ncqDir $ \sto -> liftIO do hashes <- atomically (STM.flushTQueue q) for_ hashes $ \ha -> do - found <- ncqSearchBS sto ha <&> maybe (-1) BS.length + found <- ncqLocate2 sto ha <&> maybe (-1) ncqEntrySize none -- assertBool (show $ "found-immediate" <+> pretty ha) (found > 0) -- debug $ fill 44 (pretty ha) <+> fill 8 (pretty found)