voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, Storage

This commit is contained in:
Dmitry Zuykov 2025-05-14 14:09:30 +03:00
parent 77589bfbbd
commit 11159be468
2 changed files with 3 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs
View File

@ -81,6 +81,7 @@ type NCQPerks m = MonadIO m
data NCQStorageException = data NCQStorageException =
NCQStorageAlreadyExist String NCQStorageAlreadyExist String
| NCQStorageSeedMissed | NCQStorageSeedMissed
| NCQStorageTimeout
deriving stock (Show,Typeable) deriving stock (Show,Typeable)
instance Exception NCQStorageException instance Exception NCQStorageException
@ -547,12 +548,6 @@ ncqStoragePut_ :: MonadUnliftIO m
ncqStoragePut_ check ncq@NCQStorage{..} h lbs = flip runContT pure $ callCC \exit -> do ncqStoragePut_ check ncq@NCQStorage{..} h lbs = flip runContT pure $ callCC \exit -> do
stoped <- readTVarIO ncqStopped
when stoped $ exit Nothing
when (LBS.null lbs) $ exit Nothing
when check do when check do
already <- lift (ncqStorageGet ncq h) already <- lift (ncqStorageGet ncq h)
let tomb = maybe False (not . ncqIsNotTomb) already let tomb = maybe False (not . ncqIsNotTomb) already
@ -732,6 +727,7 @@ ncqStorageScanDataFile ncq fp' action = do
ncqStorageGet :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe LBS.ByteString) ncqStorageGet :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe LBS.ByteString)
ncqStorageGet ncq@NCQStorage{..} h = do ncqStorageGet ncq@NCQStorage{..} h = do
location <- ncqLocate ncq h location <- ncqLocate ncq h
case location of case location of
Just (InWriteQueue WQItem{ wqData = Just lbs }) -> do Just (InWriteQueue WQItem{ wqData = Just lbs }) -> do

2
hbs2-tests/test/TCQ.hs
View File

@ -111,7 +111,7 @@ newtype TCQ =
instance MonadUnliftIO m => Storage NCQStorage HbSync LBS.ByteString m where instance MonadUnliftIO m => Storage NCQStorage HbSync LBS.ByteString m where
putBlock ncq lbs = fmap coerce <$> ncqStoragePutBlock ncq lbs putBlock ncq lbs = fmap coerce <$> ncqStoragePutBlock ncq lbs
enqueueBlock ncq lbs = fmap coerce <$> ncqStoragePutBlock ncq lbs enqueueBlock ncq lbs = fmap coerce <$> ncqStoragePutBlock ncq lbs
getBlock ncq h = ncqStorageGet ncq (coerce h) getBlock ncq h = ncqStorageGetBlock ncq (coerce h)
hasBlock ncq = hasBlock ncq . coerce hasBlock ncq = hasBlock ncq . coerce
delBlock ncq = ncqStorageDel ncq . coerce delBlock ncq = ncqStorageDel ncq . coerce