filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

Validation can be switched off

Browse Source
This commit is contained in:
Filip Gralinski 2020-03-26 21:01:04 +01:00
parent ba0d89ab7d
commit f036c50370
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Handler/CreateChallenge.hs
View File

@ -43,7 +43,8 @@ data ChallengeMetadata = ChallengeMetadata {
challengeMetadataPrivateBranch :: Text, challengeMetadataPrivateBranch :: Text,
challengeMetadataPrivateGitAnnexRemote :: Maybe Text, challengeMetadataPrivateGitAnnexRemote :: Maybe Text,
challengeMetadataDeadline :: Maybe UTCTime } challengeMetadataDeadline :: Maybe UTCTime,
challengeMetadataValidate :: Bool }
getCreateChallengeR :: Handler Html getCreateChallengeR :: Handler Html
getCreateChallengeR = do getCreateChallengeR = do
@ -89,6 +90,7 @@ doCreateChallenge creationData chan = do
let privateGitAnnexRemote = challengeMetadataPrivateGitAnnexRemote challengeMetadata let privateGitAnnexRemote = challengeMetadataPrivateGitAnnexRemote challengeMetadata
let mDeadline = challengeMetadataDeadline challengeMetadata let mDeadline = challengeMetadataDeadline challengeMetadata
let shouldBeValidated = challengeMetadataValidate challengeMetadata
maybePublicRepoId <- cloneRepo (RepoCloningSpec { maybePublicRepoId <- cloneRepo (RepoCloningSpec {
cloningSpecRepo = RepoSpec { cloningSpecRepo = RepoSpec {
@ -114,7 +116,7 @@ doCreateChallenge creationData chan = do
repoSpecGitAnnexRemote = (repoGitAnnexRemote publicRepo)}}) chan repoSpecGitAnnexRemote = (repoGitAnnexRemote publicRepo)}}) chan
case maybePrivateRepoId of case maybePrivateRepoId of
Just privateRepoId -> do Just privateRepoId -> do
isValidated <- validateChallenge privateRepoId chan isValidated <- validateChallenge shouldBeValidated privateRepoId chan
when isValidated $ addChallenge name publicRepoId privateRepoId mDeadline chan when isValidated $ addChallenge name publicRepoId privateRepoId mDeadline chan
Nothing -> return () Nothing -> return ()
Nothing -> return () Nothing -> return ()
@ -189,6 +191,7 @@ doChallengeUpdate challengeId challengeData chan = do
let privateGitAnnexRemote = challengeMetadataPrivateGitAnnexRemote metadata let privateGitAnnexRemote = challengeMetadataPrivateGitAnnexRemote metadata
let newDeadline = challengeMetadataDeadline metadata let newDeadline = challengeMetadataDeadline metadata
let shouldBeValidated = challengeMetadataValidate metadata
challenge <- runDB $ get404 challengeId challenge <- runDB $ get404 challengeId
(Entity _ version) <- runDB $ getBy404 $ UniqueVersionByCommit $ challengeVersion challenge (Entity _ version) <- runDB $ getBy404 $ UniqueVersionByCommit $ challengeVersion challenge
@ -217,7 +220,7 @@ doChallengeUpdate challengeId challengeData chan = do
repoSpecGitAnnexRemote = privateGitAnnexRemote} repoSpecGitAnnexRemote = privateGitAnnexRemote}
chan chan
isValidated <- validateChallenge privateRepoId chan isValidated <- validateChallenge shouldBeValidated privateRepoId chan
when isValidated $ when isValidated $
do do
@ -437,6 +440,7 @@ challengeMetadataInputs mPublicRepo mPrivateRepo mDeadline =
<*> (fmap T.strip <$> aopt textField (bfs MsgGitAnnexRemote) (repoGitAnnexRemote <$> mPrivateRepo)) <*> (fmap T.strip <$> aopt textField (bfs MsgGitAnnexRemote) (repoGitAnnexRemote <$> mPrivateRepo))
<*> (combineMaybeDayAndTime <$> aopt dayField (bfs MsgChallengeDeadlineDay) (Just $ utctDay <$> mDeadline) <*> (combineMaybeDayAndTime <$> aopt dayField (bfs MsgChallengeDeadlineDay) (Just $ utctDay <$> mDeadline)
<*> aopt timeFieldTypeTime (fieldWithTooltip MsgChallengeDeadlineTime MsgChallengeDeadlineTooltip) (Just $ timeToTimeOfDay <$> utctDayTime <$> mDeadline)) <*> aopt timeFieldTypeTime (fieldWithTooltip MsgChallengeDeadlineTime MsgChallengeDeadlineTooltip) (Just $ timeToTimeOfDay <$> utctDayTime <$> mDeadline))
<*> areq checkBoxField (bfs MsgShouldChallengeBeValidated) (Just True)
updateChallengeForm :: Repo -> Repo -> Maybe UTCTime -> Form ChallengeUpdateData updateChallengeForm :: Repo -> Repo -> Maybe UTCTime -> Form ChallengeUpdateData
updateChallengeForm publicRepo privateRepo mDeadline = renderBootstrap3 BootstrapBasicForm $ ChallengeUpdateData updateChallengeForm publicRepo privateRepo mDeadline = renderBootstrap3 BootstrapBasicForm $ ChallengeUpdateData
@ -446,10 +450,14 @@ updateChallengeForm publicRepo privateRepo mDeadline = renderBootstrap3 Bootstra
-- Validate whether a challenge is correct. -- Validate whether a challenge is correct.
-- Contrary to `GEval.Validate.validationChallenge` do not -- Contrary to `GEval.Validate.validationChallenge` do not
-- throw an exception (just return `False`) -- throw an exception (just return `False`)
validateChallenge :: RepoId -- ID of the private repository validateChallenge :: Bool -- switch whether really validate
-> RepoId -- ID of the private repository
-> Channel -> Channel
-> Handler Bool -- returns false if not validated -> Handler Bool -- returns false if not validated
validateChallenge repoId chan = do validateChallenge False _ chan = do
msg chan "SKIPPING CHALLENGE VALIDATION"
return True
validateChallenge True repoId chan = do
msg chan "Validating the challenge..." msg chan "Validating the challenge..."
repoDir <- getRepoDir repoId repoDir <- getRepoDir repoId

1
messages/en.msg
View File

@ -90,3 +90,4 @@ WritingPapers: writing papers with Gonito
UserIdentifier: user login/identifier UserIdentifier: user login/identifier
AltRepoScheme: alternative git repo scheme (URL without the challenge name pointing to some external server) AltRepoScheme: alternative git repo scheme (URL without the challenge name pointing to some external server)
AltRepoSchemeTooltip: set this if you want to use an alternative git server for all your submissions AltRepoSchemeTooltip: set this if you want to use an alternative git server for all your submissions
ShouldChallengeBeValidated: validate challenge (do not switch off unless you have a good reason)