Repository is cloned if not found on a local disk

Handler/CreateChallenge.hs

@@ -105,7 +105,7 @@ doCreateChallenge creationData chan = do
   case maybePublicRepoId of
     Just publicRepoId -> do
       publicRepo <- runDB $ get404 publicRepoId
-      publicRepoDir <- getRepoDir publicRepoId
+      publicRepoDir <- getRepoDirOrClone publicRepoId chan
       maybePrivateRepoId <- cloneRepo (RepoCloningSpec {
                                          cloningSpecRepo = RepoSpec {
                                              repoSpecUrl = privateUrl,
@@ -226,7 +226,7 @@ doChallengeUpdate challengeId challengeData chan = do
   when isValidated $
      do
         privateRepo <- runDB $ get404 $ privateRepoId
-        repoDir <- getRepoDir privateRepoId
+        repoDir <- getRepoDirOrClone privateRepoId chan
         (Just versionDescription) <- liftIO $ getLastCommitMessage repoDir
         theNow <- liftIO getCurrentTime
         let commit = (repoCurrentCommit privateRepo)
@@ -286,7 +286,7 @@ defaultInitialDescription = "initial version"
 
 extractChallengeMetadata :: Key Repo -> Channel -> Handler (Text, Text, Maybe ByteString)
 extractChallengeMetadata publicRepoId chan = do
-  publicRepoDir <- getRepoDir publicRepoId
+  publicRepoDir <- getRepoDirOrClone publicRepoId chan
   let readmeFilePath = publicRepoDir </> readmeFile
   doesReadmeExist <- liftIO $ doesFileExist readmeFilePath
   (title, description) <- if doesReadmeExist
@@ -349,7 +349,7 @@ updateTests :: (Key Challenge) -> Channel -> Handler ()
 updateTests challengeId chan = do
   challenge <- runDB $ get404 challengeId
   let repoId = challengePrivateRepo challenge
-  repoDir <- getRepoDir repoId
+  repoDir <- getRepoDirOrClone repoId chan
   repo <- runDB $ get404 repoId
   let commit = repoCurrentCommit repo
   testDirs <- liftIO $ findTestDirs repoDir
@@ -372,7 +372,7 @@ 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
+      challengeRepoDir <- getRepoDirOrClone (challengePrivateRepo challenge) chan
       optionsParsingResult <- liftIO $ getOptions [
         "--expected-directory", challengeRepoDir,
         "--test-name", takeFileName testDir]
@@ -461,7 +461,7 @@ validateChallenge False _ chan = do
 validateChallenge True repoId chan = do
   msg chan "Validating the challenge..."
 
-  repoDir <- getRepoDir repoId
+  repoDir <- getRepoDirOrClone repoId chan
 
   optionsParsingResult <- liftIO $ getOptions [
     "--expected-directory", repoDir]

Handler/Evaluate.hs

@@ -116,7 +116,7 @@ getOuts chan submissionId generalParams = do
   submission <- runDB $ get404 submissionId
   let challengeId = submissionChallenge submission
   let version = submissionVersion submission
-  repoDir <- getRepoDir $ submissionRepo submission
+  repoDir <- getRepoDirOrClone (submissionRepo submission) chan
   activeTests <- runDB $ selectList [TestChallenge ==. challengeId,
                                     TestActive ==. True,
                                     TestCommit ==. submissionVersion submission] []
@@ -218,7 +218,7 @@ checkOrInsertEvaluation repoDir chan version out = do
       msg chan $ concat ["Already evaluated with score ", (fromMaybe "???" $ formatNonScientifically <$> evaluationScore evaluation)]
     Nothing -> do
       msg chan $ "Start evaluation..."
-      challengeDir <- getRepoDir $ challengePrivateRepo challenge
+      challengeDir <- getRepoDirOrClone (challengePrivateRepo challenge) chan
       variant <- runDB $ get404 $ outVariant out
       resultOrException <- liftIO $ rawEval challengeDir (testMetric test) repoDir (testName test) ((T.unpack $ variantName variant) <.> "tsv")
       case resultOrException of

Handler/MakePublic.hs

@@ -28,7 +28,7 @@ doMakePublic userId submissionId chan = do
     challenge <- runDB $ get404 $ submissionChallenge submission
     repo <- runDB $ get404 $ challengePublicRepo challenge
     let submissionRepoId = submissionRepo submission
-    submissionRepoDir <- getRepoDir submissionRepoId
+    submissionRepoDir <- getRepoDirOrClone submissionRepoId chan
 
     app <- getYesod
     let scheme = appRepoScheme $ appSettings app

Handler/Shared.hs

@@ -24,7 +24,7 @@ import qualified Data.List as DL
 
 import System.Random
 
-import System.Directory (doesFileExist, renameDirectory)
+import System.Directory (doesFileExist, renameDirectory, doesDirectoryExist)
 
 import PersistSHA1
 
@@ -145,7 +145,7 @@ cloneRepo repoCloningSpec chan = do
 updateRepo :: Key Repo -> Channel -> Handler Bool
 updateRepo repoId chan = do
   repo <- runDB $ get404 repoId
-  repoDir <- getRepoDir repoId
+  repoDir <- getRepoDirOrClone repoId chan
   let branch = repoBranch repo
   exitCode <- runWithChannel chan $ do
      runProg (Just repoDir) gitPath ["fetch",
@@ -172,7 +172,7 @@ updateRepo repoId chan = do
 getSubmissionRepoDir :: SubmissionId -> Channel -> Handler (Maybe FilePath)
 getSubmissionRepoDir submissionId chan = do
   submission <- runDB $ get404 submissionId
-  repoDir <- getRepoDir $ submissionRepo submission
+  repoDir <- getRepoDirOrClone (submissionRepo submission) chan
   let sha1Code = submissionCommit submission
   -- this is not right... it should be fixed in the future
   -- 1. All kinds of mayhem may ensue in case of concurrency
@@ -230,7 +230,7 @@ getPossiblyExistingRepo checkRepo userId challengeId repoSpec chan = do
       challenge <- runDB $ get404 challengeId
       let repoId = challengePublicRepo challenge
       repo <- runDB $ get404 repoId
-      repoDir <- getRepoDir repoId
+      repoDir <- getRepoDirOrClone repoId chan
       let repoCloningSpec = RepoCloningSpec {
         cloningSpecRepo = repoSpec,
         cloningSpecReferenceRepo = RepoSpec {
@@ -330,6 +330,45 @@ getStuffUsingGitAnnex tmpRepoDir (Just gitAnnexRemote) = do
 runGitAnnex :: FilePath -> [String] -> Runner ()
 runGitAnnex tmpRepoDir args = runProg (Just tmpRepoDir) gitPath ("annex":args)
 
+-- Gets a directory for an already cloned repo (e.g. arena/r1234). If,
+-- for some reason, the directory does not exist (e.g. the database
+-- was recovered on a new computer), it will re-clone the repository.
+getRepoDirOrClone :: RepoId -> Channel -> Handler FilePath
+getRepoDirOrClone repoId chan = do
+  repoDir <- getRepoDir repoId
+  repoDirExists <- liftIO $ doesDirectoryExist repoDir
+  if repoDirExists
+    then
+      return ()
+    else
+     do
+      repo <- runDB $ get404 repoId
+      let repoSpec = RepoSpec {
+        repoSpecUrl = repoUrl repo,
+        repoSpecBranch = repoBranch repo,
+        repoSpecGitAnnexRemote = repoGitAnnexRemote repo }
+      let repoCloningSpec = RepoCloningSpec {
+        cloningSpecRepo = repoSpec,
+        cloningSpecReferenceRepo = repoSpec }
+      (exitCode, tmpRepoDir) <- cloneRepoToTempDir repoCloningSpec chan
+      case exitCode of
+        ExitSuccess -> do
+          let commitHash = fromSHA1ToText $ repoCurrentCommit repo
+          (exitCode', _) <- runProgram (Just tmpRepoDir) gitPath ["reset",
+                                                                 "--hard",
+                                                                 T.unpack commitHash] chan
+          case exitCode' of
+            ExitSuccess -> do
+              liftIO $ renameDirectory tmpRepoDir repoDir
+              return ()
+            ExitFailure _ -> do
+              err chan $ "cannot reset to commit" ++ commitHash
+              return ()
+        ExitFailure _ -> do
+          err chan "git failed"
+          return ()
+  return repoDir
+
 getRepoDir :: Key Repo -> Handler FilePath
 getRepoDir repoId = do
   arenaDir <- arena

Handler/ShowChallenge.hs

@@ -424,7 +424,7 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
 
       repo <- runDB $ get404 repoId
 
-      repoDir <- getRepoDir repoId
+      repoDir <- getRepoDirOrClone repoId chan
 
       gonitoMetadata <- liftIO
                        $ extractMetadataFromRepoDir repoDir (ExtractionOptions {