Add challenge-repo end-point
This commit is contained in:
parent
f8ea75667f
commit
8f2cd3b77d
@ -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
|
||||
|
@ -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
|
||||
|
@ -30,6 +30,7 @@ apiDescription = generalApi
|
||||
<> listTagsApi
|
||||
<> myTeamsApi
|
||||
<> challengeImgApi
|
||||
<> challengeRepoApi
|
||||
|
||||
generalApi :: Swagger
|
||||
generalApi = (mempty :: Swagger)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user