Add challenge-repo end-point

This commit is contained in:
Filip Gralinski 2021-06-16 08:49:50 +02:00
parent f8ea75667f
commit 8f2cd3b77d
5 changed files with 59 additions and 1 deletions

View File

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

View File

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

View File

@ -30,6 +30,7 @@ apiDescription = generalApi
<> listTagsApi
<> myTeamsApi
<> challengeImgApi
<> challengeRepoApi
generalApi :: Swagger
generalApi = (mempty :: Swagger)

View File

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