From 2f409a3ab30ff846bf0d6bf81084295ed0221075 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 25 May 2024 19:34:13 +0200 Subject: Storage: store and check on-disk version --- src/Erebos/Storage.hs | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs index 0511814..034ed04 100644 --- a/src/Erebos/Storage.hs +++ b/src/Erebos/Storage.hs @@ -112,10 +112,29 @@ import Erebos.Storage.Internal type Storage = Storage' Complete type PartialStorage = Storage' Partial +storageVersion :: String +storageVersion = "0.1" + openStorage :: FilePath -> IO Storage -openStorage path = do - createDirectoryIfMissing True $ path ++ "/objects" - createDirectoryIfMissing True $ path ++ "/heads" +openStorage path = modifyIOError annotate $ do + let versionPath = path "erebos-storage" + doesFileExist versionPath >>= \case + True -> readFile versionPath >>= \case + content | (ver:_) <- lines content, ver == storageVersion -> return () + | otherwise -> fail "unsupported storage version" + False -> do + doesDirectoryExist path >>= \case + True -> do + listDirectory path >>= \case + contents@(_:_) | "objects" `notElem` contents || "heads" `notElem` contents + -> fail "directory is neither empty, nor an existing erebos storage" + _ -> return () + False -> do + createDirectoryIfMissing True $ path + writeFile versionPath $ storageVersion <> "\n" + + createDirectoryIfMissing True $ path "objects" + createDirectoryIfMissing True $ path "heads" watchers <- newMVar ([], WatchList 1 []) refgen <- newMVar =<< HT.new refroots <- newMVar =<< HT.new @@ -125,6 +144,8 @@ openStorage path = do , stRefGeneration = refgen , stRefRoots = refroots } + where + annotate e = annotateIOError e "failed to open storage" Nothing (Just path) memoryStorage' :: IO (Storage' c') memoryStorage' = do -- cgit v1.2.3