From 8f2cd3b77dc5d53230d70518d2de2c82136aca98 Mon Sep 17 00:00:00 2001 From: Filip Gralinski Date: Wed, 16 Jun 2021 08:49:50 +0200 Subject: [PATCH] Add challenge-repo end-point --- Foundation.hs | 1 + Handler/ListChallenges.hs | 2 +- Handler/ShowChallenge.hs | 55 +++++++++++++++++++++++++++++++++++++++ Handler/Swagger.hs | 1 + config/routes | 1 + 5 files changed, 59 insertions(+), 1 deletion(-) diff --git a/Foundation.hs b/Foundation.hs index 10acaef..4304457 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -155,6 +155,7 @@ instance Yesod App where isAuthorized ListChallengesR _ = regularAuthorization isAuthorized ListChallengesJsonR _ = regularAuthorization isAuthorized (ChallengeInfoJsonR _) _ = regularAuthorization + isAuthorized (ChallengeRepoJsonR _) _ = regularAuthorization isAuthorized (VersionInfoJsonR _) _ = regularAuthorization isAuthorized (LeaderboardJsonR _) _ = regularAuthorization isAuthorized (ViewVariantR _ ) _ = regularAuthorization diff --git a/Handler/ListChallenges.hs b/Handler/ListChallenges.hs index 512fbd8..b93f6da 100644 --- a/Handler/ListChallenges.hs +++ b/Handler/ListChallenges.hs @@ -82,7 +82,7 @@ instance ToSchema (Entity Challenge) where return $ NamedSchema (Just "Challenge") $ mempty & type_ .~ SwaggerObject & properties .~ - fromList [ ("name", stringSchema) + fromList [ ("name", stringSchema) , ("title", stringSchema) , ("description", stringSchema) , ("starred", booleanSchema) diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index 680db8a..00ec7f6 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -421,6 +421,61 @@ getRepoLink repo = case getHttpLink repo of theUrl = repoUrl repo bareRepoName = drop sitePrefixLen theUrl +instance ToJSON (Repo) where + toJSON repo = object + [ "url" .= repoUrl repo + , "branch" .= repoBranch repo + , "browsableUrl" .= getRepoLink repo + ] + +instance ToSchema (Repo) where + declareNamedSchema _ = do + stringSchema <- declareSchemaRef (Proxy :: Proxy String) + return $ NamedSchema (Just "DataRepository") $ mempty + & type_ .~ SwaggerObject + & properties .~ + fromList [ ("url", Inline $ toSchema (DPR.Proxy :: DPR.Proxy String) + & description .~ Just "Git URL to be cloned (https://, git:// or ssh:// protocol)" + & example .~ Just (toJSON ("git://gonito.net/fiszki-ocr" :: String))) + , ("branch", stringSchema) + , ("browsableUrl", Inline $ toSchema (DPR.Proxy :: DPR.Proxy String) + & description .~ Just "An URL address that your browser can open; usually, but not always available" + & example .~ Just (toJSON ("https://github.com/applicaai/kleister-charity/tree/master" :: String))) + + ] + & required .~ [ "url", "branch" ] + +getChallengeRepoJsonR :: Text -> Handler Value +getChallengeRepoJsonR chName = do + (Entity _ challenge) <- runDB $ getBy404 $ UniqueName chName + repo <- runDB $ get404 $ challengePublicRepo challenge + return $ toJSON repo + +declareChallengeRepoSwagger :: Declare (Definitions Schema) Swagger +declareChallengeRepoSwagger = do + -- param schemas + let challengeNameSchema = toParamSchema (Proxy :: Proxy String) + + return $ mempty + & paths .~ + fromList [ ("/api/challenge-repo/{challengeName}", + mempty & DS.get ?~ (mempty + & parameters .~ [ Inline $ mempty + & name .~ "challengeName" + & required ?~ True + & schema .~ ParamOther (mempty + & in_ .~ ParamPath + & paramSchema .~ challengeNameSchema) ] + & produces ?~ MimeList ["application/json"] + & description ?~ "Return metadata for the challenge repository")) + ] + +challengeRepoApi :: Swagger +challengeRepoApi = spec & definitions .~ defs + where + (defs, spec) = runDeclare declareChallengeRepoSwagger mempty + + getChallengeHowToR :: Text -> Handler Html getChallengeHowToR challengeName = do (Entity _ challenge) <- runDB $ getBy404 $ UniqueName challengeName diff --git a/Handler/Swagger.hs b/Handler/Swagger.hs index bf58855..f72cd29 100644 --- a/Handler/Swagger.hs +++ b/Handler/Swagger.hs @@ -30,6 +30,7 @@ apiDescription = generalApi <> listTagsApi <> myTeamsApi <> challengeImgApi + <> challengeRepoApi generalApi :: Swagger generalApi = (mempty :: Swagger) diff --git a/config/routes b/config/routes index f22a2fa..9aef83f 100644 --- a/config/routes +++ b/config/routes @@ -24,6 +24,7 @@ /api/challenge-img/#Text ChallengeImgR GET /api/query/#Text QueryJsonR GET /api/challenge-info/#Text ChallengeInfoJsonR GET +/api/challenge-repo/#Text ChallengeRepoJsonR GET /api/version-info/#Text VersionInfoJsonR GET /api/list-tags ListTagsJsonR GET /api/my-teams MyTeamsJsonR GET