summaryrefslogtreecommitdiff
path: root/src/Erebos/Storage.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Erebos/Storage.hs')
-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