wip

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

@@ -1,8 +1,16 @@
 module HBS2.Storage.NCQ3
-  ( module Exported )
+  ( module Exported
+  , ncqWithStorage3
+  , ncqStorageSync3
+  , ncqStorageStop3
+  , ncqStorageOpen3
+  , ncqStorageRun3
+  )
   where
 
 import HBS2.Storage.NCQ3.Internal.Types 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/Run.hs

@@ -150,7 +150,7 @@ ncqStorageRun3 ncq@NCQStorage3{..} = flip runContT pure do
 
     openNewDataFile :: forall mx . MonadIO mx => mx (FileKey, Fd)
     openNewDataFile = do
-      fname <- toFileName . DataFile <$> ncqGetNewFileKey ncq
+      fname <- ncqGetFileName ncq . toFileName . DataFile <$> ncqGetNewFileKey ncq
       touch fname
       let flags = defaultFileFlags { exclusive = False, creat = Just 0o666 }
       (fromString fname,) <$> liftIO (PosixBase.openFd fname  Posix.ReadWrite flags)

hbs2-tests/hbs2-tests.cabal

@@ -1208,6 +1208,7 @@ executable test-ncq
     ghc-options:
     hs-source-dirs:   test
     main-is:          TestNCQ.hs
+    other-modules:    NCQTestCommon NCQ3
     build-depends:
           base, hbs2-core, hbs2-log-structured, hbs2-storage-ncq
         , network

hbs2-tests/test/NCQ3.hs

@@ -0,0 +1,42 @@
+{-# Language RecordWildCards #-}
+module NCQ3 where
+
+import HBS2.Prelude.Plated
+import HBS2.OrDie
+import HBS2.Hash
+import HBS2.Data.Types.Refs
+import HBS2.Misc.PrettyStuff
+import HBS2.Clock
+import HBS2.Merkle
+import HBS2.Polling
+
+import HBS2.Storage
+import HBS2.Storage.Simple
+import HBS2.Storage.Operations.ByteString
+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
+
+import Data.Config.Suckless.Syntax
+import Data.Config.Suckless.Script as SC
+import Data.Config.Suckless.System
+
+import NCQTestCommon
+
+import UnliftIO
+
+
+ncq3Tests :: forall m . MonadUnliftIO m => MakeDictM C m ()
+ncq3Tests = do
+  entry $ bindMatch "test:ncq3:start-stop" $ nil_ $ \e ->do
+      runTest $ \TestEnv{..} -> do
+        ncqWithStorage3 testEnvDir $ \sto -> do
+           notice "start/stop ncq3 storage"
+

hbs2-tests/test/NCQTestCommon.hs

@@ -0,0 +1,60 @@
+module NCQTestCommon where
+
+import HBS2.Prelude
+import HBS2.System.Logger.Simple.ANSI
+
+import Data.Config.Suckless.Syntax
+import Data.Config.Suckless.Script as SC
+import Data.Config.Suckless.System
+
+import System.IO.Temp as Temp
+import Control.Monad.Trans.Cont
+import UnliftIO
+
+data TestEnv =
+  TestEnv
+  { testEnvDir :: FilePath
+  }
+
+runTest :: forall m a . MonadUnliftIO m => (TestEnv -> m a) -> RunM C m a
+runTest action = do
+  pref <- lookupValueDef nil "test:root" >>= \case
+            StringLike dir -> pure dir
+            _              -> pure "/tmp/ncq-tests"
+
+  keep <- lookupValueDef nil "test:dir:keep" >>= \case
+            LitBoolVal True -> pure True
+            _               -> pure False
+
+  mkdir pref
+
+  tmp <- liftIO (Temp.createTempDirectory pref "ncq-test")
+  SC.bind "test:dir"  (mkStr tmp)
+
+  flip runContT pure do
+    ContT $ bracket none $ const do
+      unless keep (rm tmp)
+      flushLoggers
+
+    lift $ lift $ action (TestEnv tmp)
+
+
+setupLogger :: MonadIO m => m ()
+setupLogger = do
+  setLogging @DEBUG  $ toStderr . logPrefix "[debug] "
+  setLogging @ERROR  $ toStderr . logPrefix "[error] "
+  setLogging @WARN   $ toStderr . logPrefix "[warn] "
+  setLogging @NOTICE $ toStdout . logPrefix ""
+
+flushLoggers :: MonadIO m => m ()
+flushLoggers = do
+  silence
+
+silence :: MonadIO m => m ()
+silence = do
+  setLoggingOff @DEBUG
+  setLoggingOff @ERROR
+  setLoggingOff @WARN
+  setLoggingOff @NOTICE
+  setLoggingOff @TRACE
+

hbs2-tests/test/TestNCQ.hs

@@ -32,6 +32,9 @@ import Data.Config.Suckless.Syntax
 import Data.Config.Suckless.Script as SC
 import Data.Config.Suckless.System
 
+import NCQTestCommon
+import NCQ3
+
 import DBPipe.SQLite hiding (field)
 
 import Codec.Compression.Zstd qualified as Zstd
@@ -102,52 +105,7 @@ import Data.BloomFilter.Easy as Bloom
 
 {- HLINT ignore "Functor law" -}
 
-setupLogger :: MonadIO m => m ()
-setupLogger = do
-  setLogging @DEBUG  $ toStderr . logPrefix "[debug] "
-  setLogging @ERROR  $ toStderr . logPrefix "[error] "
-  setLogging @WARN   $ toStderr . logPrefix "[warn] "
-  setLogging @NOTICE $ toStdout . logPrefix ""
 
-flushLoggers :: MonadIO m => m ()
-flushLoggers = do
-  silence
-
-silence :: MonadIO m => m ()
-silence = do
-  setLoggingOff @DEBUG
-  setLoggingOff @ERROR
-  setLoggingOff @WARN
-  setLoggingOff @NOTICE
-  setLoggingOff @TRACE
-
-
-data TestEnv =
-  TestEnv
-  { testEnvDir :: FilePath
-  }
-
-runTest :: forall m a . MonadUnliftIO m => (TestEnv -> m a) -> RunM C m a
-runTest action = do
-  pref <- lookupValueDef nil "test:root" >>= \case
-            StringLike dir -> pure dir
-            _              -> pure "/tmp/ncq-tests"
-
-  keep <- lookupValueDef nil "test:dir:keep" >>= \case
-            LitBoolVal True -> pure True
-            _               -> pure False
-
-  mkdir pref
-
-  tmp <- liftIO (Temp.createTempDirectory pref "ncq-test")
-  SC.bind "test:dir"  (mkStr tmp)
-
-  flip runContT pure do
-    ContT $ bracket none $ const do
-      unless keep (rm tmp)
-      flushLoggers
-
-    lift $ lift $ action (TestEnv tmp)
 
 
 testNCQFuckupRecovery1 :: MonadUnliftIO m
@@ -1782,7 +1740,6 @@ main = do
 
 
         entry $ bindMatch "test:ncq2:facts-db1" $ nil_ $ \e -> do
-
           notice "test:ncq2:probes-db1"
           runTest $ \TestEnv{..} -> do
             g <- liftIO MWC.createSystemRandom
@@ -1819,6 +1776,9 @@ main = do
 
               pause @'Seconds 300
 
+-- NCQ3 tests
+
+        ncq3Tests
 
         hidden do
           internalEntries