allow specifying UUID seed in $UUID_SEED

2 files changed, 10 insertions, 1 deletions

diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index e7753d7..ca1b748 100644
--- a/backend/app/Main.hs
+++ b/backend/app/Main.hs
@@ -38,13 +38,18 @@ import Route qualified as R
 import Safe
 import Store qualified as Q
 import System.Directory (doesDirectoryExist, makeAbsolute, setCurrentDirectory)
+import System.Environment
 import System.Exit
 import System.FilePath
 import System.INotify
 import System.IO qualified as IO
+import System.Random
 import Text.Printf (printf)
 import Version
 
+getUUID :: IO U.UUID
+getUUID = maybe U.nextRandom (const randomIO) =<< lookupEnv "UUID_SEED"
+
 data Args = Args
   { cmd :: Cmd
   }
@@ -215,6 +220,9 @@ logStderr = IO.hPutStrLn IO.stderr
 
 main :: IO ()
 main = do
+  uuidSeed <- lookupEnv "UUID_SEED"
+  maybe (pure ()) (setStdGen . mkStdGen) $ readMay =<< uuidSeed
+
   A.execParser (A.info (args <**> A.helper) A.idm) >>= \case
     Args {cmd = Serve {contentRepositoryPath, serverPort}} -> do
       contentRepositoryPath' <- makeAbsolute contentRepositoryPath
@@ -280,7 +288,7 @@ restApi root ref repoT app req respond =
             =<< Q.withStore root ref do
               Q.query (fromString (printf "UPDATE %s SET %s WHERE %s.$fileName == \"%s\"" c (LB.toString (J.encode o)) c i))
         ("POST", ["collection", B.toString -> c]) -> do
-          i <- ((<> ".json") . U.toText) <$> U.nextRandom
+          i <- ((<> ".json") . U.toText) <$> getUUID
           o <- J.throwDecode @J.Object =<< W.lazyRequestBody req
           respond . W.responseLBS W.status200 [] . J.encode
             =<< Q.withStore root ref do
diff --git a/backend/backend.cabal b/backend/backend.cabal
index b2ca82b..0ed54ff 100644
--- a/backend/backend.cabal
+++ b/backend/backend.cabal
@@ -62,6 +62,7 @@ executable backend
         http-types,
         mtl,
         optparse-applicative,
+        random,
         safe,
         split,
         stm,