Pre-Checking submission

This commit is contained in:
Filip Gralinski 2021-02-22 14:43:09 +01:00
parent c43d54a6be
commit be96977bc3

View File

@ -1,8 +1,13 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DoAndIfThenElse #-}
module Handler.ShowChallenge where module Handler.ShowChallenge where
import Import hiding (Proxy, fromList) import Import hiding (Proxy, fromList)
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs) import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs)
import GHC.Generics
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import Text.Markdown import Text.Markdown
@ -439,6 +444,7 @@ declareChallengeSubmissionSwagger = do
let stringSchema = toParamSchema (Proxy :: Proxy String) let stringSchema = toParamSchema (Proxy :: Proxy String)
challengeSubmissionResponse <- declareResponse (Proxy :: Proxy Int) challengeSubmissionResponse <- declareResponse (Proxy :: Proxy Int)
wrongSubmissionResponse <- declareResponse (Proxy :: Proxy GonitoStatus)
return $ mempty return $ mempty
& paths .~ & paths .~
@ -488,7 +494,8 @@ declareChallengeSubmissionSwagger = do
& paramSchema .~ stringSchema)] & paramSchema .~ stringSchema)]
& produces ?~ MimeList ["application/json"] & produces ?~ MimeList ["application/json"]
& description ?~ "Initiates a submission based on a given repo URL/branch. Returns an asynchrous job ID." & description ?~ "Initiates a submission based on a given repo URL/branch. Returns an asynchrous job ID."
& at 200 ?~ Inline challengeSubmissionResponse)) & at 200 ?~ Inline challengeSubmissionResponse
& at 422 ?~ Inline wrongSubmissionResponse))
] ]
challengeSubmissionApi :: Swagger challengeSubmissionApi :: Swagger
@ -497,18 +504,53 @@ challengeSubmissionApi = spec & definitions .~ defs
(defs, spec) = runDeclare declareChallengeSubmissionSwagger mempty (defs, spec) = runDeclare declareChallengeSubmissionSwagger mempty
data ChallangeSubmissionStatus = SubmissionOK | SubmissionWrong Text
deriving (Eq, Show)
data GonitoStatus = GonitoStatus {
detail :: Text
} deriving (Eq, Show, Generic)
instance ToJSON GonitoStatus
instance ToSchema GonitoStatus
postChallengeSubmissionJsonR :: Text -> Handler Value postChallengeSubmissionJsonR :: Text -> Handler Value
postChallengeSubmissionJsonR challengeName = do postChallengeSubmissionJsonR challengeName = do
Entity userId _ <- requireAuthPossiblyByToken Entity userId _ <- requireAuthPossiblyByToken
(Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName challengeEnt@(Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
((result, _), _) <- runFormPost $ submissionForm Nothing Nothing Nothing ((result, _), _) <- runFormPost $ submissionForm Nothing Nothing Nothing
let submissionData' = case result of let submissionData' = case result of
FormSuccess res -> Just res FormSuccess res -> Just res
_ -> Nothing _ -> Nothing
Just submissionData = submissionData' Just submissionData = submissionData'
runViewProgressAsynchronously $ doCreateSubmission userId challengeId submissionData status <- checkSubmission challengeEnt submissionData
case status of
SubmissionOK -> runViewProgressAsynchronously $ doCreateSubmission userId challengeId submissionData
SubmissionWrong errorMsg -> sendResponseStatus status422 $ toJSON (GonitoStatus errorMsg)
checkSubmission :: Entity Challenge -> ChallengeSubmissionData -> Handler ChallangeSubmissionStatus
checkSubmission (Entity _ challenge) submissionData = do
let repo = challengeSubmissionDataRepo submissionData
if (null $ repoSpecUrl repo)
then
return $ SubmissionWrong "empty URL"
else
do
if (null $ repoSpecBranch repo)
then
return $ SubmissionWrong "empty branch"
else
do
if (willClone challenge submissionData)
then
do
return SubmissionOK
else
do
return $ SubmissionWrong "Refusing to clone the submission from this URL."
postChallengeSubmissionR :: Text -> Handler TypedContent postChallengeSubmissionR :: Text -> Handler TypedContent
postChallengeSubmissionR challengeName = do postChallengeSubmissionR challengeName = do