From a1992fbda23bb785efc7c12dc230ee10a23a15e1 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Mon, 28 Jul 2025 11:42:24 +0300 Subject: [PATCH] wip --- hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs | 2 ++ .../lib/HBS2/Storage/NCQ3/Internal/Index.hs | 14 +++++++++----- .../lib/HBS2/Storage/NCQ3/Internal/Run.hs | 10 ++++++---- hbs2-tests/test/NCQ3.hs | 12 +++++++++--- hbs2-tests/test/NCQTestCommon.hs | 19 ++++++++++++++++++- hbs2-tests/test/TestNCQ.hs | 12 ------------ 6 files changed, 44 insertions(+), 25 deletions(-) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs index 428b409c..089b8b15 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs +++ b/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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs index 91ef6226..0c52c75e 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs +++ b/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 record = os <> rs - S.yield (coerce k, record) + let os = fromIntegral @_ @Word64 offset & N.bytestring64 + let record = fks <> os <> rs + 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) + + diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs index 84086ce3..0fecd22a 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/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 diff --git a/hbs2-tests/test/NCQ3.hs b/hbs2-tests/test/NCQ3.hs index 9916a060..4561a279 100644 --- a/hbs2-tests/test/NCQ3.hs +++ b/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 diff --git a/hbs2-tests/test/NCQTestCommon.hs b/hbs2-tests/test/NCQTestCommon.hs index 732f33c6..a05cfb8e 100644 --- a/hbs2-tests/test/NCQTestCommon.hs +++ b/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] " diff --git a/hbs2-tests/test/TestNCQ.hs b/hbs2-tests/test/TestNCQ.hs index d0a8f266..071ee419 100644 --- a/hbs2-tests/test/TestNCQ.hs +++ b/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