wip

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs

@@ -5,10 +5,12 @@ module HBS2.Storage.NCQ3
   , ncqStorageStop3
   , ncqStorageOpen3
   , ncqStorageRun3
+  , ncqPutBS
   )
   where
 
 import HBS2.Storage.NCQ3.Internal.Types as Exported
+import HBS2.Storage.NCQ3.Internal.Prelude as Exported
 import HBS2.Storage.NCQ3.Internal
 import HBS2.Storage.NCQ3.Internal.Run
 import HBS2.Storage.NCQ3.Internal.State

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs

@@ -14,20 +14,22 @@ ncqIndexFile :: MonadUnliftIO m => NCQStorage3 -> DataFile FileKey -> m FilePath
 ncqIndexFile n@NCQStorage3{}  fk = do
 
   let fp   = toFileName fk & ncqGetFileName n
-  let dest = toFileName (IndexFile (coerce @_ @FileKey fk)) & ncqGetFileName n
+  dest  <- ncqGetNewFileKey n
+              <&> ncqGetFileName n . toFileName . IndexFile
 
   debug $ "INDEX" <+> pretty fp <+> pretty dest
 
   items <- S.toList_ do
-    ncqStorageScanDataFile n fp $ \o w k s -> case ncqIsMeta s of
+    ncqStorageScanDataFile n fp $ \offset w key s -> case ncqIsMeta s of
       Just M -> none
       _ -> do
         -- we need size in order to return block size faster
         -- w/o search in fossil
+        let fks = N.bytestring32 (coerce fk)
         let rs = (w + ncqSLen) & fromIntegral @_ @Word32 & N.bytestring32
-        let os = fromIntegral @_ @Word64 o & N.bytestring64
+        let os = fromIntegral @_ @Word64 offset & N.bytestring64
-        let record = os <> rs
+        let record = fks <> os <> rs
-        S.yield (coerce k, record)
+        S.yield (coerce key, record)
 
   let (dir,name) = splitFileName fp
   let idxTemp = (dropExtension name <> "-") `addExtension` ".cq$"
@@ -67,3 +69,5 @@ ncqStorageScanDataFile ncq fp' action = do
      lift (action o (fromIntegral w) k v)
 
      next (ncqSLen + o + fromIntegral w, BS.drop (w+ncqSLen) bs)
+
+

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs

@@ -6,6 +6,7 @@ import HBS2.Storage.NCQ3.Internal.Prelude
 import HBS2.Storage.NCQ3.Internal.Types
 import HBS2.Storage.NCQ3.Internal.State
 import HBS2.Storage.NCQ3.Internal.Memtable
+import HBS2.Storage.NCQ3.Internal.Index
 
 
 import Control.Monad.Trans.Cont
@@ -53,8 +54,9 @@ ncqStorageRun3 ncq@NCQStorage3{..} = flip runContT pure do
           if not stop then STM.retry else pure Nothing
 
     maybe1 what none $ \(fk :: FileKey, fh) -> do
-      debug $ red "CLOSE FILE" <+> pretty fk
+      notice $ red "CLOSE FILE" <+> pretty fk
       closeFd fh
+      ncqIndexFile ncq (DataFile fk)
       loop
 
   let shLast = V.length ncqWriteOps - 1
@@ -150,17 +152,17 @@ ncqStorageRun3 ncq@NCQStorage3{..} = flip runContT pure do
 
     openNewDataFile :: forall mx . MonadIO mx => mx (FileKey, Fd)
     openNewDataFile = do
-      fname <- ncqGetFileName ncq . toFileName . DataFile <$> ncqGetNewFileKey ncq
+      fk <- ncqGetNewFileKey ncq
+      let fname = ncqGetFileName ncq (toFileName (DataFile fk))
       touch fname
       let flags = defaultFileFlags { exclusive = False, creat = Just 0o666 }
-      (fromString fname,) <$> liftIO (PosixBase.openFd fname  Posix.ReadWrite flags)
+      (fk,) <$> liftIO (PosixBase.openFd fname  Posix.ReadWrite flags)
 
     spawnActivity m = do
       a <- ContT $ withAsync m
       link a
       pure a
 
-
     measureWPS = void $ flip fix Nothing \loop -> \case
       Nothing      -> do
         w <- readTVarIO ncqWrites

hbs2-tests/test/NCQ3.hs

@@ -18,8 +18,6 @@ import HBS2.Storage.NCQ3
 import HBS2.System.Logger.Simple.ANSI
 
 import HBS2.Data.Log.Structured.SD
-import HBS2.Storage.NCQ
-import HBS2.Storage.NCQ2 as N2
 import HBS2.Data.Log.Structured.NCQ
 
 import HBS2.CLI.Run.Internal.Merkle
@@ -30,13 +28,21 @@ import Data.Config.Suckless.System
 
 import NCQTestCommon
 
+import System.Random.MWC as MWC
 import UnliftIO
 
 
 ncq3Tests :: forall m . MonadUnliftIO m => MakeDictM C m ()
 ncq3Tests = do
   entry $ bindMatch "test:ncq3:start-stop" $ nil_ $ \e ->do
+      let (opts,args) = splitOpts [] e
+      let num = headDef 1000 [ fromIntegral n | LitIntVal n <- args ]
+      g <- liftIO MWC.createSystemRandom
       runTest $ \TestEnv{..} -> do
         ncqWithStorage3 testEnvDir $ \sto -> do
-           notice "start/stop ncq3 storage"
+           notice "start/stop ncq3 storage / write 1000 blocks"
+           replicateM_ num do
+             n <- liftIO $ uniformRM (1024, 256*1024) g
+             bs <- liftIO $ genRandomBS g n
+             ncqPutBS sto (Just B) Nothing bs
 

hbs2-tests/test/NCQTestCommon.hs

@@ -7,8 +7,11 @@ import Data.Config.Suckless.Syntax
 import Data.Config.Suckless.Script as SC
 import Data.Config.Suckless.System
 
-import System.IO.Temp as Temp
+import Data.ByteString (ByteString)
 import Control.Monad.Trans.Cont
+import Data.Fixed
+import System.IO.Temp as Temp
+import System.Random.Stateful
 import UnliftIO
 
 data TestEnv =
@@ -39,6 +42,20 @@ runTest action = do
     lift $ lift $ action (TestEnv tmp)
 
 
+genRandomBS :: forall g m . (Monad m, StatefulGen g m) => g -> Int -> m ByteString
+genRandomBS g n = do
+  uniformByteStringM n g
+
+sec6 :: RealFrac a => a -> Fixed E6
+sec6 = realToFrac
+
+sec2 :: RealFrac a => a -> Fixed E2
+sec2 = realToFrac
+
+sec3 :: RealFrac a => a -> Fixed E3
+sec3 = realToFrac
+
+
 setupLogger :: MonadIO m => m ()
 setupLogger = do
   setLogging @DEBUG  $ toStderr . logPrefix "[debug] "

hbs2-tests/test/TestNCQ.hs

@@ -965,18 +965,6 @@ testNCQ2Lookup1 syn TestEnv{..} = do
     notice $ "median" <+> pretty m
 
 
-genRandomBS :: forall g m . (Monad m, StatefulGen g m) => g -> Int -> m ByteString
-genRandomBS g n = do
-  uniformByteStringM n g
-
-sec6 :: RealFrac a => a -> Fixed E6
-sec6 = realToFrac
-
-sec2 :: RealFrac a => a -> Fixed E2
-sec2 = realToFrac
-
-sec3 :: RealFrac a => a -> Fixed E3
-sec3 = realToFrac
 
 testNCQ2Merge1 :: MonadUnliftIO m
          => Int