From 2f409a3ab30ff846bf0d6bf81084295ed0221075 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
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