mirror of https://github.com/voidlizard/hbs2
wip, 3x speed degradation on read+write scenario against NCQ1
This commit is contained in:
parent
802f6d65f3
commit
59e9f8a718
|
@ -30,7 +30,7 @@ ncqStorageOpen fp upd = do
|
||||||
let ncqGen = 0
|
let ncqGen = 0
|
||||||
let ncqFsync = 16 * megabytes
|
let ncqFsync = 16 * megabytes
|
||||||
let ncqWriteQLen = 1024 * 4
|
let ncqWriteQLen = 1024 * 4
|
||||||
let ncqMinLog = 1 * gigabytes
|
let ncqMinLog = 2 * gigabytes
|
||||||
let ncqMaxLog = 32 * gigabytes
|
let ncqMaxLog = 32 * gigabytes
|
||||||
let ncqWriteBlock = max 128 $ ncqWriteQLen `div` 2
|
let ncqWriteBlock = max 128 $ ncqWriteQLen `div` 2
|
||||||
let ncqMaxCachedIndex = 64
|
let ncqMaxCachedIndex = 64
|
||||||
|
@ -109,7 +109,7 @@ ncqPutBlock0 :: MonadUnliftIO m
|
||||||
-> LBS.ByteString
|
-> LBS.ByteString
|
||||||
-> Bool
|
-> Bool
|
||||||
-> m (Maybe HashRef)
|
-> m (Maybe HashRef)
|
||||||
ncqPutBlock0 sto lbs wait =
|
ncqPutBlock0 sto lbs wait = do
|
||||||
ncqLocate sto ohash >>= \case
|
ncqLocate sto ohash >>= \case
|
||||||
Nothing -> Just <$> work sto (Just B) (Just ohash) bs
|
Nothing -> Just <$> work sto (Just B) (Just ohash) bs
|
||||||
_ -> pure (Just ohash)
|
_ -> pure (Just ohash)
|
||||||
|
|
|
@ -78,6 +78,7 @@ ncqLocate_ f me@NCQStorage{..} href = ncqOperation me (pure Nothing) do
|
||||||
writeTQueue ncqReadReq (href, answ)
|
writeTQueue ncqReadReq (href, answ)
|
||||||
|
|
||||||
atomically $ takeTMVar answ
|
atomically $ takeTMVar answ
|
||||||
|
{-# INLINE ncqLocate_ #-}
|
||||||
|
|
||||||
ncqLocate :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe Location)
|
ncqLocate :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe Location)
|
||||||
ncqLocate me href = ncqOperation me (pure Nothing) do
|
ncqLocate me href = ncqOperation me (pure Nothing) do
|
||||||
|
|
|
@ -590,6 +590,32 @@ ncq3Tests = do
|
||||||
notice $ "second must fail" <+> pretty wx <+> "=>" <+> viaShow r
|
notice $ "second must fail" <+> pretty wx <+> "=>" <+> viaShow r
|
||||||
|
|
||||||
|
|
||||||
|
entry $ bindMatch "test:ncq3:merkle:file" $ nil_ $ \e -> runTest $ \TestEnv{..} -> do
|
||||||
|
|
||||||
|
let (opts,args) = splitOpts [] e
|
||||||
|
let n = headDef (1 * gigabytes) [ fromIntegral x | LitIntVal x <- args ]
|
||||||
|
|
||||||
|
fn <- orThrowUser "no file given" (headMay [ x | StringLike x <- args ])
|
||||||
|
|
||||||
|
ncqWithStorage testEnvDir $ \ncq -> do
|
||||||
|
|
||||||
|
let sto = AnyStorage ncq
|
||||||
|
-- lbs <- liftIO $ LBS.readFile fn
|
||||||
|
|
||||||
|
lbs <- liftIO $ LBS.readFile fn
|
||||||
|
|
||||||
|
chu <- S.toList_ (readChunkedBS lbs (256*1024))
|
||||||
|
hashes <- forConcurrently chu $ \chunk -> do
|
||||||
|
ncqTossBlock ncq chunk >>= orThrowUser "can't save"
|
||||||
|
|
||||||
|
-- FIXME: handle-hardcode
|
||||||
|
let pt = toPTree (MaxSize 1024) (MaxNum 256) hashes -- FIXME: settings
|
||||||
|
|
||||||
|
m <- makeMerkle 0 pt $ \(_,_,bss) -> liftIO do
|
||||||
|
void $ ncqPutBlock ncq bss >>= orThrowUser "can't save"
|
||||||
|
|
||||||
|
notice $ pretty m
|
||||||
|
|
||||||
entry $ bindMatch "test:ncq3:merkle" $ nil_ $ \e -> runTest $ \TestEnv{..} -> do
|
entry $ bindMatch "test:ncq3:merkle" $ nil_ $ \e -> runTest $ \TestEnv{..} -> do
|
||||||
|
|
||||||
let (opts,args) = splitOpts [] e
|
let (opts,args) = splitOpts [] e
|
||||||
|
@ -630,13 +656,26 @@ ncq3Tests = do
|
||||||
|
|
||||||
h0 <- liftIO (LBS.readFile fn) <&> HashRef . hashObject @HbSync
|
h0 <- liftIO (LBS.readFile fn) <&> HashRef . hashObject @HbSync
|
||||||
|
|
||||||
lbs1 <- runExceptT (getTreeContents sto tree)
|
debug $ pretty h0
|
||||||
>>= orThrowPassIO
|
|
||||||
<&> HashRef . hashObject @HbSync
|
|
||||||
|
|
||||||
notice $ "found" <+> pretty tree <+> pretty lbs1 <+> pretty h0
|
notice "full compact index first"
|
||||||
|
|
||||||
liftIO $ assertBool (show $ "hash eq" <+> pretty h0 <+> pretty lbs1) (h0 == lbs1)
|
-- ncqIndexCompactFull ncq
|
||||||
|
|
||||||
|
replicateM_ 3 do
|
||||||
|
|
||||||
|
t1 <- getTimeCoarse
|
||||||
|
lbs1 <- runExceptT (getTreeContents sto tree)
|
||||||
|
>>= orThrowPassIO
|
||||||
|
<&> HashRef . hashObject @HbSync
|
||||||
|
|
||||||
|
debug $ pretty lbs1
|
||||||
|
|
||||||
|
t3 <- getTimeCoarse
|
||||||
|
|
||||||
|
notice $ "found" <+> pretty (sec2 (1e-9 * realToFrac (t3 - t1))) <+> pretty lbs1 <+> pretty h0
|
||||||
|
|
||||||
|
liftIO $ assertBool (show $ "hash eq" <+> pretty h0 <+> pretty lbs1) (h0 == lbs1)
|
||||||
|
|
||||||
|
|
||||||
entry $ bindMatch "test:ncq3:storage:basic" $ nil_ $ \e -> do
|
entry $ bindMatch "test:ncq3:storage:basic" $ nil_ $ \e -> do
|
||||||
|
|
Loading…
Reference in New Issue