create content repository if it does not exist

1 files changed, 15 insertions, 13 deletions

diff --git a/acms/src/ACMS/ACMS.hs b/acms/src/ACMS/ACMS.hs
index 58efd5b..86ef171 100644
--- a/acms/src/ACMS/ACMS.hs
+++ b/acms/src/ACMS/ACMS.hs
@@ -37,7 +37,7 @@ import Network.Wai qualified as W
 import Network.Wai.Handler.Warp qualified as W
 import Safe
 import Store qualified as Q
-import System.Directory (doesDirectoryExist, makeAbsolute, setCurrentDirectory)
+import System.Directory (makeAbsolute)
 import System.Environment
 import System.Exit
 import System.FilePath
@@ -283,19 +283,21 @@ run (Config {serverPort, contentRepositoryPath}) = do
   uuidSeed <- lookupEnv "UUID_SEED"
   maybe (pure ()) (setStdGen . mkStdGen) $ readMay =<< uuidSeed
 
-  contentRepositoryPath' <- makeAbsolute contentRepositoryPath
-  contentRepositoryPathExists <- doesDirectoryExist (contentRepositoryPath' </> ".git")
-
-  unless contentRepositoryPathExists $ do
-    logStderr $ "Content repository '" ++ contentRepositoryPath ++ "' is not a git repository."
-    exitFailure
-
-  setCurrentDirectory contentRepositoryPath'
-
-  let root = "."
-      ref = "refs/heads/master"
+  root <- makeAbsolute contentRepositoryPath
+  let ref = "refs/heads/master"
   repoT <- newEmptyTMVarIO
 
+  -- create repository if it does not exist
+  catch
+    (Q.withStore root ref (pure ()))
+    ( \(e :: G.GitException) -> do
+        case e of
+          G.RepositoryCannotAccess _ -> do
+            logStderr "error: cannot open content repository: the content repository is not a Git repository"
+            exitWith (ExitFailure 1)
+          _ -> throwIO e
+    )
+
   stopM <- newEmptyMVar
   flip forkFinally (putMVar stopM) do watch repoT root ref
   mapM
@@ -310,7 +312,7 @@ run (Config {serverPort, contentRepositoryPath}) = do
           $ (\_ resp -> resp (W.responseLBS W.status404 [] "Not found"))
     )
     ["!4", "::1"] -- XXX note !6 does not work..
-  logStderr ("Serving " ++ contentRepositoryPath' ++ " on port " ++ show serverPort ++ ".")
+  logStderr ("Serving " ++ contentRepositoryPath ++ " on port " ++ show serverPort ++ ".")
   either throwIO pure =<< takeMVar stopM
 
 data InvalidSchemaVersion = InvalidSchemaVersion String