diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs index 47bff7ab..00cfd3f9 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs @@ -282,7 +282,7 @@ instance IsTomb IndexEntry where instance IsTomb Location where ncqIsTomb = \case - InFossil _ _ s -> ncqIsTombEntrySize s + InFossil (FileLocation _ _ s) -> ncqIsTombEntrySize s InMemory bs -> case ncqEntryUnwrap bs of (_, Right (T, _)) -> True _ -> False @@ -290,7 +290,7 @@ instance IsTomb Location where ncqGetEntryBS :: MonadUnliftIO m => NCQStorage -> Location -> m (Maybe ByteString) ncqGetEntryBS me = \case InMemory bs -> pure $ Just bs - InFossil fk off size -> ncqWithState me $ const do + InFossil (FileLocation fk off size) -> ncqWithState me $ const do try @_ @SomeException (ncqGetCachedData me fk) >>= \case Left e -> err (viaShow e) >> pure Nothing Right (CachedData mmap) -> do @@ -298,7 +298,7 @@ ncqGetEntryBS me = \case ncqEntrySize :: forall a . Integral a => Location -> a ncqEntrySize = \case - InFossil _ _ size -> fromIntegral size + InFossil (FileLocation _ _ size) -> fromIntegral size InMemory bs -> fromIntegral (BS.length bs) ncqDelEntry :: MonadUnliftIO m diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Class.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Class.hs index a805925f..0edd7878 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Class.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Class.hs @@ -53,8 +53,8 @@ ncqStorageHasBlock :: MonadUnliftIO m ncqStorageHasBlock sto h = ncqLocate sto h >>= \case Nothing -> pure Nothing Just (InMemory bs) -> blockSize bs - Just (InFossil _ _ size) | ncqIsTombEntrySize size -> pure Nothing - Just (InFossil _ _ size) -> do + Just (InFossil (FileLocation _ _ size)) | ncqIsTombEntrySize size -> pure Nothing + Just (InFossil (FileLocation _ _ size)) -> do pure $ Just (ncqEntryPayloadSize (fromIntegral size)) where diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs index 87943fc8..1fda301b 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs @@ -104,7 +104,7 @@ ncqFossilMergeStep me@NCQStorage{..} = withSem ncqServiceSem $ flip runContT pu ncqLocate_ False me k >>= \case Nothing -> pure False Just (InMemory{}) -> pure False - Just (InFossil fk oi si) -> do + Just (InFossil (FileLocation fk oi si)) -> do let beWritten = fk == fik && o == fromIntegral oi -- let c = if skip then green else id diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs index 9013e338..47890343 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs @@ -132,7 +132,7 @@ ncqIndexFile n ts' fk = runMaybeT do unless (k == emptyKey) $ atomically $ void $ runMaybeT do NCQEntry _ tfk <- MaybeT $ ncqLookupEntrySTM n (coerce k) fk' <- MaybeT $ readTVar tfk - guard (coerce fk == fk') -- remove only own stuff + guard (coerce fk == flKey fk') -- remove only own stuff lift $ ncqAlterEntrySTM n (coerce k) (const Nothing) pure dest diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs index 13d1b1a3..7e948c62 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs @@ -76,7 +76,7 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do for_ ncqStateIndex $ \(_, fk) -> do CachedIndex bs nw <- lift $ ncqGetCachedIndex ncq fk lift (ncqLookupIndex h (bs, nw)) >>= \case - Just (IndexEntry fk o s) -> answer (Just (InFossil fk o s)) >> exit () + Just (IndexEntry fk o s) -> answer (Just (InFossil (FileLocation fk o s))) >> exit () Nothing -> none -- debug $ "NOT FOUND SHIT" <+> pretty h @@ -196,8 +196,10 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do ws <- for chu $ \h -> do atomically (ncqLookupEntrySTM ncq h) >>= \case Just (NCQEntry bs w) -> do - atomically (writeTVar w (Just fk)) - lift (appendSection fh bs) + let off = fromIntegral total' + n <- lift (appendSection fh bs) + atomically (writeTVar w (Just (FileLocation fk off (fromIntegral n)))) + pure n _ -> pure 0 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs index bbdba54a..4368d47c 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs @@ -34,21 +34,30 @@ deriving stock instance Data (IndexFile FileKey) deriving stock instance Data (DataFile FileKey) deriving stock instance Data (StateFile FileKey) + +data FileLocation = + FileLocation + { flKey :: !FileKey + , flOffset :: !NCQOffset + , flSize :: !NCQSize + } + deriving stock (Eq,Ord) + + +data Location = + InFossil {-# UNPACK #-} !FileLocation + | InMemory {-# UNPACK #-} !ByteString + data NCQEntry = NCQEntry { ncqEntryData :: !ByteString - , ncqDumped :: !(TVar (Maybe FileKey)) + , ncqDumped :: !(TVar (Maybe FileLocation)) } type NCQOffset = Word64 type NCQFileSize = NCQOffset type NCQSize = Word32 -data Location = - InFossil {-# UNPACK #-} !FileKey !NCQOffset !NCQSize - | InMemory {-# UNPACK #-} !ByteString - - data Fact = P PData -- pending, not indexed deriving stock (Eq,Ord,Data) @@ -144,7 +153,7 @@ instance Semigroup NCQState where instance Pretty Location where pretty = \case - InFossil k o s -> parens $ "in-fossil" <+> pretty k <+> pretty o <+> pretty s + InFossil (FileLocation k o s) -> parens $ "in-fossil" <+> pretty k <+> pretty o <+> pretty s InMemory _ -> "in-memory" ncqMakeFossilName :: FileKey -> FilePath