From 8f2cd3b77dc5d53230d70518d2de2c82136aca98 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
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