summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-05-25 19:34:13 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-05-28 20:18:40 +0200
commit2f409a3ab30ff846bf0d6bf81084295ed0221075 (patch)
treec76e35e387c736ce143d02ff64efa726970a7f7d /src
parentdb575cad9b8a3c3c2ab9f1a71ac2ea442c761df2 (diff)
Storage: store and check on-disk version
Diffstat (limited to 'src')
-rw-r--r--src/Erebos/Storage.hs27
1 files changed, 24 insertions, 3 deletions
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