wip

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
 

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)