Prepare application structure for re-evaluation

Application.hs

@@ -57,6 +57,7 @@ import Handler.Achievements
 import Handler.Score
 import Handler.ExtraPoints
 import Handler.Dashboard
+import Handler.Evaluate
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

Handler/Evaluate.hs

@@ -0,0 +1,50 @@
+module Handler.Evaluate where
+
+import Import
+
+import Handler.Common
+import Handler.Runner
+import Handler.Shared
+
+canBeReevaluated :: (YesodAuthPersist (HandlerSite m), MonadHandler m, PersistUniqueRead backend, AuthEntity (HandlerSite m) ~ User, AuthId (HandlerSite m) ~ Key User, BaseBackend backend ~ SqlBackend) => Key Submission -> ReaderT backend m Bool
+canBeReevaluated submissionId = do
+  maybeUser <- maybeAuth
+  case maybeUser of
+    Just (Entity userId _) -> do
+      isOwner <- checkWhetherGivenUserRepo userId submissionId
+      let isSuperuser = checkIfAdmin maybeUser
+
+      submission <- get404 submissionId
+      let submissionVersionHash = submissionVersion submission
+
+      challenge <- get404 $ submissionChallenge submission
+      let challengeVersionHash = challengeVersion challenge
+
+      if (submissionVersionHash == challengeVersionHash)
+       then return False
+       else
+        do
+         (Entity _ submissionVer) <- getBy404 $ UniqueVersionByCommit submissionVersionHash
+         (Entity _ chalengeVer) <- getBy404 $ UniqueVersionByCommit challengeVersionHash
+
+         return  ((isOwner || isSuperuser)
+                  &&
+                  ((versionMajor submissionVer) == (versionMajor chalengeVer)
+                  || (versionMinor submissionVer) == (versionMinor chalengeVer)
+                  || (versionPatch submissionVer) < (versionPatch chalengeVer)))
+
+
+    Nothing -> return False
+
+getReevaluateSubmissionR :: SubmissionId -> Handler TypedContent
+getReevaluateSubmissionR submissionId =
+  runViewProgress $ doReevaluateSubmission submissionId
+
+doReevaluateSubmission :: SubmissionId -> Channel -> Handler ()
+doReevaluateSubmission submissionId chan = do
+  status <- runDB $ canBeReevaluated submissionId
+  if status
+    then
+      msg chan "Will re-evaluate!"
+    else
+      msg chan "Won't re-evaluate!"

Handler/MakePublic.hs

@@ -17,7 +17,7 @@ getMakePublicR submissionId = do
 
 doMakePublic :: UserId -> SubmissionId -> Channel -> Handler ()
 doMakePublic userId submissionId chan = do
-  isOwner <- checkWhetherGivenUserRepo userId submissionId
+  isOwner <- runDB $ checkWhetherGivenUserRepo userId submissionId
   if not isOwner
    then
     err chan "Only the submitter can make a submission public!"
@@ -52,9 +52,4 @@ pushRepo repoDir commit targetRepoUrl targetBranchName chan = do
 checkWhetherUserRepo :: SubmissionId -> Handler Bool
 checkWhetherUserRepo submissionId = do
   userId <- requireAuthId
-  checkWhetherGivenUserRepo userId submissionId
+  runDB $ checkWhetherGivenUserRepo userId submissionId
-
-checkWhetherGivenUserRepo :: UserId -> SubmissionId -> Handler Bool
-checkWhetherGivenUserRepo userId submissionId = do
-  submission <- runDB $ get404 submissionId
-  return $ userId == submissionSubmitter submission

Handler/Shared.hs

@@ -8,6 +8,7 @@ import Import
 import qualified Data.IntMap            as IntMap
 
 import Handler.Runner
+import Handler.Common
 import System.Exit
 
 import qualified Data.Text as T
@@ -504,3 +505,8 @@ formatVersion :: (Int, Int, Int) -> Text
 formatVersion (major, minor, patch) = (T.pack $ show major)
                                       <> "." <> (T.pack $ show minor)
                                       <> "." <> (T.pack $ show patch)
+
+
+checkWhetherGivenUserRepo userId submissionId = do
+  submission <- get404 submissionId
+  return $ userId == submissionSubmitter submission

Handler/Tables.hs

@@ -4,6 +4,7 @@ module Handler.Tables where
 
 import Import
 import Handler.Shared
+import Handler.Evaluate
 import Handler.SubmissionView
 import Handler.TagUtils
 
@@ -162,7 +163,9 @@ resultCell :: Test -> (a -> Maybe Evaluation) -> Table App a
 resultCell test fun = hoverTextCell (formatTestForHtml test) (formatTruncatedScore (testPrecision test) . fun) (formatFullScore . fun)
 
 statusCellWidget :: Text -> RepoScheme -> Repo -> (SubmissionId, Submission, VariantId, Variant, UserId, Maybe UserId) -> WidgetFor App ()
-statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, userId, mauthId) = $(widgetFile "submission-status")
+statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, userId, mauthId) = do
+  isReevaluable <- handlerToWidget $ runDB $ canBeReevaluated submissionId
+  $(widgetFile "submission-status")
     where commitHash = fromSHA1ToText $ submissionCommit submission
           isPublic = submissionIsPublic submission
           isOwner = (mauthId == Just userId)

config/routes

@@ -39,6 +39,7 @@
 /make-public/#SubmissionId MakePublicR GET
 /hide-submission/#SubmissionId HideSubmissionR GET
 /restore-submission/#SubmissionId RestoreSubmissionR GET
+/reevaluate-submission/#SubmissionId ReevaluateSubmissionR GET
 
 /challenge-archive/#ChallengeId ArchiveR POST
 /challenge-unarchive/#ChallengeId UnarchiveR POST

gonito.cabal

@@ -54,6 +54,7 @@ library
                      Handler.ExtraPoints
                      Handler.Runner
                      Handler.Dashboard
+                     Handler.Evaluate
                      Data.SubmissionConditions
                      Gonito.ExtractMetadata
 

templates/submission-status.hamlet

@@ -1,18 +1,22 @@
 $if isOwner
   <a href="@{EditSubmissionAndVariantR submissionId variantId}">
-    <span class="glyphicon glyphicon-pencil" title="click to edit the submission" aria-hidden="true">
+    <span class="glyphicon glyphicon-pencil" title="edit the submission" aria-hidden="true">
 
   <a href="@{HideSubmissionR submissionId}">
-    <span class="glyphicon glyphicon-remove" title="click to remove the submission" aria-hidden="true">
+    <span class="glyphicon glyphicon-remove" title="remove the submission" aria-hidden="true">
 
 $if isVisible
   <a href="@{QueryResultsR commitHash}">
-    <span class="glyphicon glyphicon-info-sign" title="click to see the detailed information" aria-hidden="true">
+    <span class="glyphicon glyphicon-info-sign" title="see the detailed information" aria-hidden="true">
 
 $maybe browsableUrl <- maybeBrowsableUrl
   <a href="#{browsableUrl}">
-    <span class="glyphicon glyphicon-folder-open" title="click to see the files aria-hidden="true">
+    <span class="glyphicon glyphicon-folder-open" title="see the files aria-hidden="true">
 $nothing
   $if isOwner
     <a href="@{MakePublicR submissionId}">
-      <span class="glyphicon glyphicon-share" title="click to make it public!" aria-hidden="true">
+      <span class="glyphicon glyphicon-share" title="make it public!" aria-hidden="true">
+
+$if isReevaluable
+  <a href="@{ReevaluateSubmissionR submissionId}">
+    <span class="glyphicon glyphicon-repeat" title="re-evaluate" aria-hidden="true">