add handling VAR_DIR env variable

Foundation.hs

@@ -76,9 +76,9 @@ instance Yesod App where
 
     -- Store session data on the client in encrypted cookies,
     -- default session idle timeout is 120 minutes
-    makeSessionBackend _ = Just <$> defaultClientSessionBackend
+    makeSessionBackend app = Just <$> defaultClientSessionBackend
         120    -- timeout in minutes
-        "config/client_session_key.aes"
+        ((appVarDir $ appSettings app) </> "config/client_session_key.aes")
 
     defaultLayout widget = do
         master <- getYesod

Handler/CreateChallenge.hs

@@ -50,7 +50,8 @@ doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do
   case maybePublicRepoId of
     Just publicRepoId -> do
       publicRepo <- runDB $ get404 publicRepoId
-      maybePrivateRepoId <- cloneRepo privateUrl privateBranch (T.pack $ getRepoDir publicRepoId) (repoBranch publicRepo) chan
+      publicRepoDir <- getRepoDir publicRepoId
+      maybePrivateRepoId <- cloneRepo privateUrl privateBranch (T.pack $ publicRepoDir) (repoBranch publicRepo) chan
       case maybePrivateRepoId of
           Just privateRepoId -> addChallenge name publicRepoId privateRepoId chan
           Nothing -> return ()
@@ -59,7 +60,7 @@ doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do
 addChallenge :: Text -> (Key Repo) -> (Key Repo) -> Channel -> Handler ()
 addChallenge name publicRepoId privateRepoId chan = do
   msg chan "adding challenge..."
-  let publicRepoDir = getRepoDir publicRepoId
+  publicRepoDir <- getRepoDir publicRepoId
   let readmeFilePath = publicRepoDir </> readmeFile
   doesReadmeExist <- liftIO $ doesFileExist readmeFilePath
   (title, description) <- if doesReadmeExist
@@ -83,7 +84,7 @@ updateTests :: (Key Challenge) -> Channel -> Handler ()
 updateTests challengeId chan = do
   challenge <- runDB $ get404 challengeId
   let repoId = challengePrivateRepo challenge
-  let repoDir = getRepoDir repoId
+  repoDir <- getRepoDir repoId
   repo <- runDB $ get404 repoId
   let commit = repoCurrentCommit repo
   testDirs <- liftIO $ findTestDirs repoDir
@@ -103,8 +104,9 @@ checkTestDir chan challengeId challenge commit testDir = do
     then do
       msg chan $ concat ["Test dir ", (T.pack testDir), " found."]
       checksum <- liftIO $ gatherSHA1 testDir
+      challengeRepoDir <- getRepoDir $ challengePrivateRepo challenge
       optionsParsingResult <- liftIO $ getOptions [
-        "--expected-directory", (getRepoDir $ challengePrivateRepo challenge),
+        "--expected-directory", challengeRepoDir,
         "--test-name", takeFileName testDir]
       case optionsParsingResult of
        Left evalException -> do

Handler/Shared.hs

@@ -31,8 +31,10 @@ atom = Control.Concurrent.STM.atomically
 
 type Channel = TChan (Maybe Text)
 
-arena :: FilePath
-arena = "arena"
+arena :: Handler FilePath
+arena = do
+  app <- getYesod
+  return $ (appVarDir $ appSettings app) </> "arena"
 
 gitPath :: FilePath
 gitPath = "/usr/bin/git"
@@ -83,7 +85,7 @@ cloneRepo url branch referenceUrl referenceBranch chan = do
 updateRepo :: Key Repo -> Channel -> Handler Bool
 updateRepo repoId chan = do
   repo <- runDB $ get404 repoId
-  let repoDir = getRepoDir repoId
+  repoDir <- getRepoDir repoId
   (exitCode, _) <- runProgram (Just repoDir) gitPath ["fetch", "--progress"] chan
   case exitCode of
     ExitSuccess -> do
@@ -121,7 +123,8 @@ cloneRepo' url branch referenceUrl referenceBranch chan = do
        then do
         msg chan "Cloning..."
         r <- randomInt
-        let tmpRepoDir = arena </> ("t" ++ show r)
+        arenaDir <- arena
+        let tmpRepoDir = arenaDir </> ("t" ++ show r)
         exitCode <- rawClone tmpRepoDir url branch referenceUrl referenceBranch chan
         case exitCode of
           ExitSuccess -> do
@@ -137,7 +140,7 @@ cloneRepo' url branch referenceUrl referenceBranch chan = do
                   repoOwner=userId,
                   repoReady=True,
                   repoStamp=time }
-                let repoDir = getRepoDir repoId
+                repoDir <- getRepoDir repoId
                 liftIO $ renameDirectory tmpRepoDir repoDir
                 msg chan $ concat ["Repo is in ", (T.pack repoDir)]
                 return $ Just repoId
@@ -182,8 +185,10 @@ rawClone tmpRepoDir url branch referenceUrl referenceBranch chan = do
     else
       return exitCode
 
-getRepoDir :: Key Repo -> FilePath
-getRepoDir repoId = arena </> ("r" ++ repoIdAsString)
+getRepoDir :: Key Repo -> Handler FilePath
+getRepoDir repoId = do
+  arenaDir <- arena
+  return $ arenaDir </> ("r" ++ repoIdAsString)
     where repoIdAsString = show $ fromSqlKey repoId
 
 checkRepoUrl :: Text -> Bool

Handler/ShowChallenge.hs

@@ -40,7 +40,7 @@ getChallengeReadmeR :: Text -> Handler Html
 getChallengeReadmeR name = do
   (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
   let repoId = challengePublicRepo challenge
-  let repoDir = getRepoDir repoId
+  repoDir <- getRepoDir repoId
   let readmeFilePath = repoDir </> readmeFile
   contents <- readFile readmeFilePath
   challengeLayout False challenge $ toWidget $ markdown def $ TL.fromStrict contents
@@ -118,7 +118,7 @@ getOuts :: Channel -> Key Submission -> Handler ([Out])
 getOuts chan submissionId = do
   submission <- runDB $ get404 submissionId
   let challengeId = submissionChallenge submission
-  let repoDir = getRepoDir $ submissionRepo submission
+  repoDir <- getRepoDir $ submissionRepo submission
   activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
   testsDone <- filterM (doesOutExist repoDir) activeTests
   outs <- mapM (outForTest repoDir submissionId) testsDone
@@ -156,7 +156,8 @@ checkOrInsertEvaluation repoDir chan out = do
       msg chan $ concat ["Already evaluated with score ", (T.pack $ fromMaybe "???" $ show <$> evaluationScore evaluation)]
     Nothing -> do
       msg chan $ "Start evaluation..."
-      resultOrException <- liftIO $ rawEval challenge repoDir (testName test)
+      challengeDir <- getRepoDir $ challengePrivateRepo challenge
+      resultOrException <- liftIO $ rawEval challengeDir repoDir (testName test)
       case resultOrException of
         Right (Left parseResult) -> do
           err chan "Cannot parse options, check the challenge repo"
@@ -175,9 +176,9 @@ checkOrInsertEvaluation repoDir chan out = do
         Left exception -> do
           err chan $ "Evaluation failed: " ++ (T.pack $ show exception)
 
-rawEval :: Challenge -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue)))
-rawEval challenge repoDir name = try (runGEvalGetOptions [
-                                    "--expected-directory", (getRepoDir $ challengePrivateRepo challenge),
+rawEval :: FilePath -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue)))
+rawEval challengeDir repoDir name = try (runGEvalGetOptions [
+                                    "--expected-directory", challengeDir,
                                     "--out-directory", repoDir,
                                     "--test-name", (T.unpack name)])
 
@@ -203,7 +204,8 @@ getSubmissionRepo challengeId url branch chan = do
       challenge <- runDB $ get404 challengeId
       let repoId = challengePublicRepo challenge
       repo <- runDB $ get404 repoId
-      cloneRepo' url branch (T.pack $ getRepoDir repoId) (repoBranch repo) chan
+      repoDir <- getRepoDir repoId
+      cloneRepo' url branch (T.pack repoDir) (repoBranch repo) chan
 
 checkRepoAvailibility :: Key Challenge -> Key Repo -> Channel -> Handler Bool
 checkRepoAvailibility challengeId repoId chan = do

Settings.hs

@@ -53,6 +53,7 @@ data AppSettings = AppSettings
     -- ^ Copyright text to appear in the footer of the page
     , appAnalytics              :: Maybe Text
     -- ^ Google Analytics code
+    , appVarDir                 :: String
     }
 
 instance FromJSON AppSettings where
@@ -78,6 +79,7 @@ instance FromJSON AppSettings where
 
         appCopyright              <- o .: "copyright"
         appAnalytics              <- o .:? "analytics"
+        appVarDir                 <- o .: "var-dir"
 
         return AppSettings {..}
 

config/settings.yml

@@ -6,6 +6,7 @@ host:           "_env:HOST:*4" # any IPv4 host
 port:           "_env:PORT:3000"
 approot:        "_env:APPROOT:http://localhost:3000"
 ip-from-header: "_env:IP_FROM_HEADER:false"
+var-dir:        "_env:VAR_DIR:."
 
 # Optional values with the following production defaults.
 # In development, they default to the inverse.