From f5c480205e58e17e2843c66be44c1150bb89ea62 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Fri, 13 Dec 2019 22:14:00 +0100
Subject: [PATCH] Validate challenge when add or update

---
 Handler/CreateChallenge.hs | 101 ++++++++++++++++++++++++-------------
 gonito.cabal               |   2 +-
 2 files changed, 68 insertions(+), 35 deletions(-)

diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs
index 6ed47ea..a4643f4 100644
--- a/Handler/CreateChallenge.hs
+++ b/Handler/CreateChallenge.hs
@@ -11,6 +11,7 @@ import Handler.Extract
 import GEval.Core
 import GEval.OptionsParser
 import GEval.EvaluationScheme
+import GEval.Validation
 
 import Gonito.ExtractMetadata (getLastCommitMessage)
 
@@ -95,7 +96,9 @@ doCreateChallenge name publicUrl publicBranch publicGitAnnexRemote privateUrl pr
                                              repoSpecBranch = (repoBranch publicRepo),
                                              repoSpecGitAnnexRemote = (repoGitAnnexRemote publicRepo)}}) chan
       case maybePrivateRepoId of
-        Just privateRepoId -> addChallenge name publicRepoId privateRepoId mDeadline chan
+        Just privateRepoId -> do
+          isValidated <- validateChallenge privateRepoId chan
+          when isValidated $ addChallenge name publicRepoId privateRepoId mDeadline chan
         Nothing -> return ()
     Nothing -> return ()
 
@@ -204,47 +207,51 @@ doChallengeUpdate challengeId
                                                    repoSpecGitAnnexRemote = privateGitAnnexRemote}
                                                  chan
 
-  privateRepo <- runDB $ get404 $ privateRepoId
-  repoDir <- getRepoDir privateRepoId
-  (Just versionDescription) <- liftIO $ getLastCommitMessage repoDir
-  theNow <- liftIO getCurrentTime
-  let commit = (repoCurrentCommit privateRepo)
+  isValidated <- validateChallenge privateRepoId chan
 
-  mAlreadyExistingVersion <- runDB $ getBy $ UniqueVersionByCommit commit
-  case mAlreadyExistingVersion of
-    Just (Entity versionId _) -> do
-                                 runDB $ update versionId [VersionDeadline =. newDeadline,
-                                                           VersionMajor =. newMajor,
-                                                           VersionMinor =. newMinor,
-                                                           VersionPatch =. newPatch,
-                                                           VersionDescription =. versionDescription,
-                                                           VersionStamp =. theNow]
+  when isValidated $
+     do
+        privateRepo <- runDB $ get404 $ privateRepoId
+        repoDir <- getRepoDir privateRepoId
+        (Just versionDescription) <- liftIO $ getLastCommitMessage repoDir
+        theNow <- liftIO getCurrentTime
+        let commit = (repoCurrentCommit privateRepo)
 
-    Nothing -> do
-               _ <- runDB $ insert $ Version (Just challengeId)
-                                            commit
-                                            newDeadline
-                                            newMajor
-                                            newMinor
-                                            newPatch
-                                            versionDescription
-                                            theNow
-               return ()
+        mAlreadyExistingVersion <- runDB $ getBy $ UniqueVersionByCommit commit
+        case mAlreadyExistingVersion of
+          Just (Entity versionId _) -> do
+                                       runDB $ update versionId [VersionDeadline =. newDeadline,
+                                                                 VersionMajor =. newMajor,
+                                                                 VersionMinor =. newMinor,
+                                                                 VersionPatch =. newPatch,
+                                                                 VersionDescription =. versionDescription,
+                                                                 VersionStamp =. theNow]
 
-  (title, description, mImage) <- extractChallengeMetadata publicRepoId chan
+          Nothing -> do
+                     _ <- runDB $ insert $ Version (Just challengeId)
+                                                  commit
+                                                  newDeadline
+                                                  newMajor
+                                                  newMinor
+                                                  newPatch
+                                                  versionDescription
+                                                  theNow
+                     return ()
 
-  runDB $ update challengeId [ChallengePublicRepo =. publicRepoId,
-                              ChallengePrivateRepo =. privateRepoId,
-                              ChallengeVersion =. commit,
-                              ChallengeTitle =. title,
-                              ChallengeDescription =. description,
-                              ChallengeImage =. mImage]
+        (title, description, mImage) <- extractChallengeMetadata publicRepoId chan
 
-  updateTests challengeId chan
+        runDB $ update challengeId [ChallengePublicRepo =. publicRepoId,
+                                    ChallengePrivateRepo =. privateRepoId,
+                                    ChallengeVersion =. commit,
+                                    ChallengeTitle =. title,
+                                    ChallengeDescription =. description,
+                                    ChallengeImage =. mImage]
 
+        updateTests challengeId chan
+
+        return ()
   return ()
 
-
 incrementVersion :: ChallengeUpdateType -> (Int, Int, Int) -> (Int, Int, Int)
 incrementVersion MajorChange (major, _, _) = (major + 1, 0, 0)
 incrementVersion MinorChange (major, minor, _) = (major, minor + 1, 0)
@@ -431,3 +438,29 @@ updateChallengeForm publicRepo privateRepo mDeadline = renderBootstrap3 Bootstra
     <*> aopt dayField (bfs MsgChallengeDeadlineDay) (Just $ utctDay <$> mDeadline)
     <*> aopt timeFieldTypeTime (fieldWithTooltip MsgChallengeDeadlineTime MsgChallengeDeadlineTooltip)
                                (Just $ timeToTimeOfDay <$> utctDayTime <$> mDeadline)
+
+-- Validate whether a challenge is correct.
+-- Contrary to `GEval.Validate.validationChallenge` do not
+-- throw an exception (just return `False`)
+validateChallenge :: RepoId  -- ID of the private repository
+                    -> Channel
+                    -> Handler Bool -- returns false if not validated
+validateChallenge repoId chan = do
+  msg chan "Validating the challenge..."
+
+  repoDir <- getRepoDir repoId
+
+  optionsParsingResult <- liftIO $ getOptions [
+    "--expected-directory", repoDir]
+
+  case optionsParsingResult of
+    Left _ -> do
+      err chan "Cannot read metric"
+      return False
+    Right opts -> do
+      result <- liftIO (try $ validationChallenge repoDir (geoSpec opts) :: IO (Either SomeException ()))
+      case result of
+        Left ex -> do
+          err chan (T.pack $ "Invalid challenge!!! " ++ (show ex))
+          return False
+        Right _ -> return True
diff --git a/gonito.cabal b/gonito.cabal
index 3b497d0..d2c1e2d 100644
--- a/gonito.cabal
+++ b/gonito.cabal
@@ -127,7 +127,7 @@ library
                  , filemanip
                  , cryptohash
                  , markdown
-                 , geval >= 1.21.1.0 && < 1.23
+                 , geval >= 1.21.1.0 && < 1.24
                  , filepath
                  , yesod-table
                  , regex-tdfa