wip

Makefile

@@ -17,6 +17,7 @@ BINS := \
   git-remote-hbs2    \
   git-hbs2           \
   fixme-new          \
+	hbs2-storage-simple-benchmarks \
 
 ifeq ($(origin .RECIPEPREFIX), undefined)
   $(error This Make does not support .RECIPEPREFIX. Please use GNU Make 4.0 or later)

hbs2-storage-simple/benchmarks/Main.hs

@@ -6,6 +6,7 @@ import HBS2.Hash
 import HBS2.Data.Types.Refs
 import HBS2.Storage
 import HBS2.Storage.Simple
+import HBS2.Storage.Compact
 
 import System.TimeIt
 
@@ -13,12 +14,14 @@ import DBPipe.SQLite
 
 import System.Environment
 import System.FilePath
+import System.IO.Temp
 
 import System.Random (randomRIO)
 import Control.Monad (replicateM)
 import Data.ByteString.Lazy  qualified as LBS
 import Data.Word (Word8)
 
+import Data.Coerce
 import Data.Function
 import Text.InterpolatedString.Perl6 (qc)
 import Control.Monad
@@ -63,9 +66,10 @@ main = do
   let s = readDef @Int 256 ss
   let p = pref
 
-  -- let bss = randomByteStrings n s
+  let bss = randomByteStrings n s
   let bss2 = randomByteStrings n s
   let bss3 = randomByteStrings n s
+  let bss4 = randomByteStrings n s
   -- let bss41 = randomByteStrings (n `div` 2) s
   -- let bss42 = randomByteStrings (n`div` 2) s
   -- let bss43 = randomByteStrings (n`div`4) s
@@ -91,8 +95,8 @@ main = do
 
   print $ "preparing to write" <+> pretty n <+> "chunks"
 
-  -- timeItNamed "write chunks test" do
+  timeItNamed "write chunks to simple storage" do
-  --   S.mapM_ (enqueueBlock storage) bss
+    S.mapM_ (enqueueBlock storage) bss
 
   timeItNamed "write chunks to sqlite test" do
     withDB env $ transactional do
@@ -123,6 +127,17 @@ main = do
     LBS.hPut fh (mconcat w)
     hClose fh
 
+  timeItNamed "write chunks to compact-storage" do
+
+    temp <- liftIO $ emptyTempFile "." "compact-storage"
+
+    sto <- compactStorageOpen mempty temp
+
+    flip S.mapM_  bss4 $ \bs -> do
+      let h = hashObject @HbSync bs
+      compactStoragePut sto (coerce h) (LBS.toStrict bs)
+
+    compactStorageClose sto
 
   timeItNamed "write chunks to LSM-mock" do
 

hbs2-storage-simple/hbs2-storage-simple.cabal

@@ -99,6 +99,7 @@ test-suite test
 
     other-modules:
       TestSimpleStorage
+      TestCompactStorage
 
     -- other-extensions:
 

hbs2-storage-simple/test/Main.hs

@@ -4,10 +4,11 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 import TestSimpleStorage
+import TestCompactStorage
 
 main :: IO ()
 main =
-  defaultMain $
+  defaultMain do
     testGroup "root"
       [
         testCase "testSimpleStorageRandomReadWrite" testSimpleStorageRandomReadWrite
@@ -15,6 +16,10 @@ main =
       , testCase "testSimpleStorageRefs" testSimpleStorageRefs
       , testCase "testSimpleStorageBundles" testSimpleStorageBundles
       , testCase  "testSimpleStorageSymmEncryption" testSimpleStorageSymmEncryption
+      , testCase  "testCompactStorage" testCompactStorageBasic
       ]
+    -- testGroup "compact"
+    --   [ testCase  "testCompactStorage" testCompactStorageBasic
+    --   ]
 
 

hbs2-storage-simple/test/TestCompactStorage.hs

@@ -0,0 +1,40 @@
+module TestCompactStorage where
+
+import HBS2.Prelude.Plated
+import HBS2.OrDie
+import HBS2.Hash
+import HBS2.Clock
+import HBS2.Data.Types.Refs
+import HBS2.Storage
+import HBS2.Storage.Compact
+import HBS2.Data.Bundle
+
+import Control.Monad.Except
+import Control.Monad
+import Data.Traversable
+import Data.Foldable
+import Control.Concurrent.Async
+import Control.Concurrent
+import Data.ByteString.Lazy qualified as LBS
+import Data.Maybe
+import Data.Word
+import Lens.Micro.Platform
+import Prettyprinter
+import System.Directory
+import System.FilePath.Posix
+import System.IO.Temp
+import Test.QuickCheck
+import System.TimeIt
+import System.IO
+
+import Test.Tasty.HUnit
+
+
+testCompactStorageBasic :: IO ()
+testCompactStorageBasic = do
+
+  withSystemTempFile "simpleStorageTest1" $ \fn ha -> do
+    pure ()
+
+  pure ()
+