diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs index dc62434e..a5aca1a5 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs @@ -81,6 +81,7 @@ type NCQPerks m = MonadIO m data NCQStorageException = NCQStorageAlreadyExist String | NCQStorageSeedMissed + | NCQStorageTimeout deriving stock (Show,Typeable) instance Exception NCQStorageException @@ -547,12 +548,6 @@ ncqStoragePut_ :: MonadUnliftIO m 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 already <- lift (ncqStorageGet ncq h) 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 ncq@NCQStorage{..} h = do + location <- ncqLocate ncq h case location of Just (InWriteQueue WQItem{ wqData = Just lbs }) -> do diff --git a/hbs2-tests/test/TCQ.hs b/hbs2-tests/test/TCQ.hs index efd23c3f..3d6d1462 100644 --- a/hbs2-tests/test/TCQ.hs +++ b/hbs2-tests/test/TCQ.hs @@ -111,7 +111,7 @@ newtype TCQ = instance MonadUnliftIO m => Storage NCQStorage HbSync LBS.ByteString m where putBlock 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 delBlock ncq = ncqStorageDel ncq . coerce