wip

hbs2-storage-ncq/lib/HBS2/Storage/NCQ/Types.hs

@@ -56,7 +56,7 @@ newtype DataFile a = DataFile a
 
 newtype IndexFile a = IndexFile a
 
-newtype StateFile = StateFile FileKey
+newtype StateFile a = StateFile a
                       deriving newtype (IsString,Eq,Ord,Pretty)
 
 class ToFileName a where
@@ -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)

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

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

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
 

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

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 }

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)
+

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))