From 4b138e3e3601b3877c8153af37db0f5f90609b14 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@ceti.pl>
Date: Tue, 29 Sep 2015 14:15:49 +0200
Subject: [PATCH] add "out" records

---
 Handler/CreateChallenge.hs |  5 +---
 Handler/Shared.hs          |  7 +++++
 Handler/ShowChallenge.hs   | 56 +++++++++++++++++++++++++++++++++++++-
 3 files changed, 63 insertions(+), 5 deletions(-)

diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs
index c06bf09..e67faa2 100644
--- a/Handler/CreateChallenge.hs
+++ b/Handler/CreateChallenge.hs
@@ -11,8 +11,6 @@ import System.Directory (doesFileExist)
 import System.FilePath.Find as SFF
 import qualified Data.Text as T
 
-import Crypto.Hash.SHA1
-
 import PersistSHA1
 
 getCreateChallengeR :: Handler Html
@@ -109,8 +107,7 @@ checkTestDir chan challengeId commit testDir = do
 gatherSHA1 :: FilePath -> IO ByteString
 gatherSHA1 testDir = do
   files <- SFF.find always isTestDirHashedFile testDir
-  contentss <- mapM readFile $ sort files
-  return $ finalize $ foldl' Crypto.Hash.SHA1.update init contentss
+  gatherSHA1ForCollectionOfFiles files
 
 isTestDirHashedFile :: FindClause Bool
 isTestDirHashedFile = fileType ==? RegularFile
diff --git a/Handler/Shared.hs b/Handler/Shared.hs
index a546f25..87b3a7f 100644
--- a/Handler/Shared.hs
+++ b/Handler/Shared.hs
@@ -15,6 +15,8 @@ import Database.Persist.Sql (ConnectionPool, runSqlPool, fromSqlKey)
 
 import Control.Concurrent.Lifted (fork, threadDelay)
 
+import qualified Crypto.Hash.SHA1 as CHS
+
 import System.Process
 import System.Exit
 import System.Random
@@ -239,3 +241,8 @@ gatherOutput ph hout herr chan = work mempty mempty
 
 randomInt :: Handler Int
 randomInt = liftIO $ randomIO
+
+gatherSHA1ForCollectionOfFiles :: [FilePath] -> IO ByteString
+gatherSHA1ForCollectionOfFiles files = do
+  contentss <- mapM readFile $ sort files
+  return $ CHS.finalize $ foldl' CHS.update CHS.init contentss
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index bc30f31..9bce406 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -7,9 +7,14 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
 import qualified Data.Text.Lazy          as TL
 import           Text.Markdown
 
+import System.Directory (doesFileExist)
+import qualified Data.Text as T
+
 import Handler.Extract
 import Handler.Shared
 
+import PersistSHA1
+
 getShowChallengeR :: Text -> Handler Html
 getShowChallengeR name = do
   (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
@@ -46,14 +51,63 @@ postChallengeSubmissionR name = do
     runViewProgress $ doCreateSubmission challengeId description submissionUrl submissionBranch
 
 doCreateSubmission :: Key Challenge -> Text -> Text -> Text -> Channel -> Handler ()
-doCreateSubmission challengeId _ url branch chan = do
+doCreateSubmission challengeId description url branch chan = do
   maybeRepoKey <- getSubmissionRepo challengeId url branch chan
   case maybeRepoKey of
     Just repoId -> do
       repo <- runDB $ get404 repoId
+      submissionId <- getSubmission repoId (repoCurrentCommit repo) challengeId description chan
       msg chan "HAHA"
     Nothing -> return ()
 
+getSubmission :: Key Repo -> SHA1 -> Key Challenge -> Text -> Channel -> Handler (Key Submission)
+getSubmission repoId commit challengeId description chan = do
+  maybeSubmission <- runDB $ getBy $ UniqueSubmissionRepoCommitChallenge repoId commit challengeId
+  case maybeSubmission of
+    Just (Entity submissionId submission) -> do
+      msg chan "Submission already there, re-checking"
+      return submissionId
+    Nothing -> do
+      msg chan "Creating new submission"
+      time <- liftIO getCurrentTime
+      runDB $ insert $ Submission {
+        submissionRepo=repoId,
+        submissionCommit=commit,
+        submissionChallenge=challengeId,
+        submissionDescription=description,
+        submissionStamp=time }
+
+getOuts :: Key Submission -> Handler ([Out])
+getOuts submissionId = do
+  submission <- runDB $ get404 submissionId
+  let challengeId = submissionChallenge submission
+  let repoDir = getRepoDir $ submissionRepo submission
+  activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
+  testsDone <- filterM (doesOutExist repoDir) activeTests
+  outs <- mapM (outForTest repoDir submissionId) testsDone
+  mapM_ checkOrInsertOut outs
+  return outs
+
+outFileName = "out.tsv"
+
+getOutFilePath repoDir test = repoDir </> (T.unpack $ testName test) </> outFileName
+
+doesOutExist repoDir (Entity _ test) = liftIO $ doesFileExist $ getOutFilePath repoDir test
+
+outForTest repoDir submissionId (Entity testId test) = do
+  checksum <- liftIO $ gatherSHA1ForCollectionOfFiles [getOutFilePath repoDir test]
+  return Out {
+    outSubmission=submissionId,
+    outTest=testId,
+    outChecksum=SHA1 checksum }
+
+checkOrInsertOut :: Out -> Handler ()
+checkOrInsertOut out = do
+  maybeOut <- runDB $ getBy $ UniqueOutSubmissionTestChecksum (outSubmission out) (outTest out) (outChecksum out)
+  case maybeOut of
+    Just _ -> return ()
+    Nothing -> (runDB $ insert out) >> return ()
+
 getSubmissionRepo :: Key Challenge -> Text -> Text -> Channel -> Handler (Maybe (Key Repo))
 getSubmissionRepo challengeId url branch chan = do
   maybeRepo <- runDB $ getBy $ UniqueUrlBranch url branch