Prepare application structure for re-evaluation

This commit is contained in:
Filip Gralinski 2019-12-14 10:56:07 +01:00
parent 80020ee404
commit 120c87e44a
8 changed files with 74 additions and 13 deletions

View File

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

50
Handler/Evaluate.hs Normal file
View File

@ -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!"

View File

@ -17,7 +17,7 @@ getMakePublicR submissionId = do
doMakePublic :: UserId -> SubmissionId -> Channel -> Handler () doMakePublic :: UserId -> SubmissionId -> Channel -> Handler ()
doMakePublic userId submissionId chan = do doMakePublic userId submissionId chan = do
isOwner <- checkWhetherGivenUserRepo userId submissionId isOwner <- runDB $ checkWhetherGivenUserRepo userId submissionId
if not isOwner if not isOwner
then then
err chan "Only the submitter can make a submission public!" 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 -> Handler Bool
checkWhetherUserRepo submissionId = do checkWhetherUserRepo submissionId = do
userId <- requireAuthId 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

View File

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

View File

@ -4,6 +4,7 @@ module Handler.Tables where
import Import import Import
import Handler.Shared import Handler.Shared
import Handler.Evaluate
import Handler.SubmissionView import Handler.SubmissionView
import Handler.TagUtils 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) 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 :: 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 where commitHash = fromSHA1ToText $ submissionCommit submission
isPublic = submissionIsPublic submission isPublic = submissionIsPublic submission
isOwner = (mauthId == Just userId) isOwner = (mauthId == Just userId)

View File

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

View File

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

View File

@ -1,18 +1,22 @@
$if isOwner $if isOwner
<a href="@{EditSubmissionAndVariantR submissionId variantId}"> <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}"> <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 $if isVisible
<a href="@{QueryResultsR commitHash}"> <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 $maybe browsableUrl <- maybeBrowsableUrl
<a href="#{browsableUrl}"> <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 $nothing
$if isOwner $if isOwner
<a href="@{MakePublicR submissionId}"> <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">