diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs index 6f007aba..0114eea0 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs @@ -56,8 +56,8 @@ newtype DataFile a = DataFile a newtype IndexFile a = IndexFile a -newtype StateFile = StateFile FileKey - deriving newtype (IsString,Eq,Ord,Pretty) +newtype StateFile a = StateFile a + deriving newtype (IsString,Eq,Ord,Pretty) class ToFileName a where toFileName :: a -> FilePath @@ -77,7 +77,7 @@ instance ToFileName (DataFile FilePath) where instance ToFileName (IndexFile FilePath) where toFileName (IndexFile fp) = dropExtension fp `addExtension` ".cq" -instance ToFileName StateFile where +instance ToFileName (StateFile FileKey) where toFileName (StateFile fk) = toFileName fk newtype FilePrio = FilePrio (Down TimeSpec) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs index f43f5a33..2c0d73ee 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2.hs @@ -777,7 +777,7 @@ ncqListDirFossils ncq = do <&> List.filter (\f -> List.isPrefixOf "fossil-" f && List.isSuffixOf ".data" f) <&> HS.toList . HS.fromList -ncqListStateFiles :: forall m . MonadIO m => NCQStorage2 -> m [(TimeSpec, StateFile)] +ncqListStateFiles :: forall m . MonadIO m => NCQStorage2 -> m [(TimeSpec, StateFile FileKey)] ncqListStateFiles ncq = do let wd = ncqGetWorkDir ncq dirFiles wd @@ -818,7 +818,7 @@ ncqRepair me@NCQStorage2{..} = do readState path = ncqReadStateKeys me path <&> fmap DataFile - tryLoadState (fk :: StateFile) = liftIO do + tryLoadState (fk :: StateFile FileKey) = liftIO do debug $ "tryLoadState" <+> pretty fk @@ -978,7 +978,7 @@ ncqStateUpdate me@NCQStorage2{..} ops' = withSem ncqStateSem $ flip runContT pur d -> pure d -ncqDumpCurrentState :: MonadUnliftIO m => NCQStorage2 -> m StateFile +ncqDumpCurrentState :: MonadUnliftIO m => NCQStorage2 -> m (StateFile FileKey) ncqDumpCurrentState me@NCQStorage2{..} = do files <- ncqListTrackedFiles me name <- ncqGetNewStateName me @@ -1263,7 +1263,7 @@ ncqCompactStep me@NCQStorage2{..} = withSem ncqMergeSem $ flip runContT pure $ c readTVarIO r -ncqReadStateKeys :: forall m . MonadUnliftIO m => NCQStorage2 -> StateFile -> m [FileKey] +ncqReadStateKeys :: forall m . MonadUnliftIO m => NCQStorage2 -> StateFile FileKey -> m [FileKey] ncqReadStateKeys me path = liftIO do keys <- BS8.readFile (ncqGetFileName me (toFileName path)) <&> filter (not . BS8.null) . BS8.lines diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2/Internal/Types.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2/Internal/Types.hs index 4f45cff1..68ecfa63 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2/Internal/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ2/Internal/Types.hs @@ -132,7 +132,7 @@ data NCQStorage2 = , ncqTrackedFiles :: TVar TrackedFiles , ncqStateVersion :: TVar StateVersion , ncqStateUsage :: TVar (IntMap (Int, HashSet FileKey)) - , ncqStateName :: TVar (Maybe StateFile) + , ncqStateName :: TVar (Maybe (StateFile FileKey)) , ncqStateSem :: TSem , ncqCachedEntries :: TVar Int , ncqWrites :: TVar Int 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 0c52c75e..33d1bffd 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs @@ -4,6 +4,7 @@ import HBS2.Storage.NCQ3.Internal.Prelude import HBS2.Storage.NCQ3.Internal.Types import HBS2.Storage.NCQ3.Internal.State +import System.Posix.Files qualified as PFS import Streaming.Prelude qualified as S import Network.ByteOrder qualified as N import Control.Monad.Trans.Cont @@ -14,8 +15,9 @@ ncqIndexFile :: MonadUnliftIO m => NCQStorage3 -> DataFile FileKey -> m FilePath ncqIndexFile n@NCQStorage3{} fk = do let fp = toFileName fk & ncqGetFileName n - dest <- ncqGetNewFileKey n - <&> ncqGetFileName n . toFileName . IndexFile + fki <- ncqGetNewFileKey n IndexFile + + let dest = ncqGetFileName n (toFileName (IndexFile fki)) debug $ "INDEX" <+> pretty fp <+> pretty dest @@ -38,7 +40,12 @@ ncqIndexFile n@NCQStorage3{} fk = do mv result dest - -- ncqStateUpdate n [F 0 (coerce fk)] + stat <- liftIO $ PFS.getFileStatus dest + let ts = PFS.modificationTimeHiRes stat + + ncqStateUpdate n do + ncqStateAddIndexFile ts fki + ncqStateAddDataFile (coerce fk) pure dest diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Prelude.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Prelude.hs index cdb05e70..44d40325 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Prelude.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Prelude.hs @@ -16,6 +16,8 @@ module HBS2.Storage.NCQ3.Internal.Prelude , ToFileName(..) , IndexFile(..) , DataFile(..) + , StateFile(..) + , FilePrio(..) , ByteString , Vector, (!) , Seq(..), (|>),(<|) @@ -23,6 +25,8 @@ module HBS2.Storage.NCQ3.Internal.Prelude , HashMap , HashPSQ , IntMap + , Set + , Down(..) ) where import HBS2.Prelude as Exported @@ -46,6 +50,8 @@ import Data.HashSet (HashSet) import Data.HashMap.Strict (HashMap) import Data.HashPSQ (HashPSQ) import Data.IntMap (IntMap) +import Data.Set (Set) +import Data.Ord (Down(..)) import UnliftIO as Exported 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 0fecd22a..4e2a5fb5 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs @@ -152,7 +152,7 @@ ncqStorageRun3 ncq@NCQStorage3{..} = flip runContT pure do openNewDataFile :: forall mx . MonadIO mx => mx (FileKey, Fd) openNewDataFile = do - fk <- ncqGetNewFileKey ncq + fk <- ncqGetNewFileKey ncq DataFile let fname = ncqGetFileName ncq (toFileName (DataFile fk)) touch fname let flags = defaultFileFlags { exclusive = False, creat = Just 0o666 } diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs index c9cae517..b5ef0325 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs @@ -3,8 +3,17 @@ module HBS2.Storage.NCQ3.Internal.State where import HBS2.Storage.NCQ3.Internal.Prelude import HBS2.Storage.NCQ3.Internal.Types -import Data.ByteString.Char8 qualified as BS8 -import Text.Printf +import Data.List qualified as List +import Control.Monad.Reader +import Data.HashSet qualified as HS + +import UnliftIO.IO.File +import UnliftIO.IO +import System.IO qualified as IO + +newtype StateOP a = + StateOP { fromStateOp :: ReaderT NCQStorage3 STM a } + deriving newtype (Functor,Applicative,Monad,MonadReader NCQStorage3) ncqGetFileName :: NCQStorage3 -> FilePath -> FilePath ncqGetFileName ncq fp = ncqGetWorkDir ncq takeFileName fp @@ -15,12 +24,52 @@ ncqGetWorkDir NCQStorage3{..} = ncqRoot show ncqGen ncqGetLockFileName :: NCQStorage3 -> FilePath ncqGetLockFileName ncq = ncqGetFileName ncq ".lock" -ncqGetNewFileKey :: forall m . MonadIO m +ncqGetNewFileKey :: forall f m . (ToFileName f, MonadIO m) => NCQStorage3 + -> ( FileKey -> f ) -> m FileKey -ncqGetNewFileKey me@NCQStorage3{..} = fix \next -> do +ncqGetNewFileKey me@NCQStorage3{..} fnameOf = fix \next -> do n <- atomically $ stateTVar ncqStateFileSeq (\x -> (x, succ x)) - let fname = ncqMakeFossilName n - here <- doesFileExist (ncqGetFileName me fname) + here <- doesFileExist (ncqGetFileName me (toFileName $ fnameOf n)) if here then next else pure n +{- HLINT ignore "Eta reduce"-} + +ncqStateUpdate :: MonadIO m + => NCQStorage3 + -> StateOP a + -> m () +ncqStateUpdate ncq@NCQStorage3{..} action = do + snkFile <- ncqGetNewFileKey ncq StateFile <&> ncqGetFileName ncq . toFileName . StateFile + (n,i,f) <- atomically do + runReaderT (fromStateOp action) ncq + n <- readTVar ncqStateFileSeq + i <- readTVar ncqStateIndex + f <- readTVar ncqStateFiles + pure (n,i,f) + + liftIO $ withBinaryFileDurableAtomic snkFile WriteMode $ \fh -> do + for_ i $ \(Down p, fk) -> do + IO.hPrint fh $ "i" <+> pretty fk <+> pretty (round @_ @Word64 p) + + for_ f $ \fk -> do + IO.hPrint fh $ "f" <+> pretty fk + + IO.hPrint fh $ "n" <+> pretty n + +ncqStateAddDataFile :: FileKey -> StateOP () +ncqStateAddDataFile fk = do + NCQStorage3{..} <- ask + StateOP $ lift do + modifyTVar ncqStateFiles (HS.insert fk) + +ncqStateAddIndexFile :: POSIXTime + -> FileKey + -> StateOP () + +ncqStateAddIndexFile ts fk = do + NCQStorage3{..} <- ask + StateOP $ lift do + modifyTVar' ncqStateIndex $ \xs -> + List.sortOn fst ((Down ts, fk) : xs) + 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 f4774461..723ed76b 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs @@ -27,6 +27,9 @@ instance ToFileName (DataFile FileKey) where instance ToFileName (IndexFile FileKey) where toFileName (IndexFile fk) = printf "i-%08x.cq" (coerce @_ @Word32 fk) +instance ToFileName (StateFile FileKey) where + toFileName (StateFile fk) = printf "s-%08x" (coerce @_ @Word32 fk) + data NCQEntry = NCQEntry { ncqEntryData :: !ByteString @@ -49,7 +52,7 @@ data NCQStorage3 = , ncqIdleThrsh :: Double , ncqMMapCache :: TVar (HashPSQ FileKey CachePrio CachedMMap) , ncqStateFiles :: TVar (HashSet FileKey) - , ncqStateIndex :: TVar (HashSet FileKey) + , ncqStateIndex :: TVar [(Down POSIXTime, FileKey)] -- backward timestamp order , ncqStateFileSeq :: TVar FileKey , ncqStateVersion :: TVar StateVersion , ncqStateUsage :: TVar (IntMap (Int, HashSet FileKey))