From 07be72d0cc07f134e352a9a0f65a4e641fb82a2b Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Mon, 8 Feb 2021 12:27:44 +0100
Subject: [PATCH] API for returning Challenge README

---
 Foundation.hs            |  1 +
 Handler/ShowChallenge.hs | 48 +++++++++++++++++++++++++++++++++-------
 Handler/Swagger.hs       |  7 +++++-
 config/routes            |  3 ++-
 4 files changed, 49 insertions(+), 10 deletions(-)

diff --git a/Foundation.hs b/Foundation.hs
index dcae53b..c991de8 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -174,6 +174,7 @@ instance Yesod App where
     isAuthorized AddUserR _ = return Authorized
     isAuthorized UserInfoR _ = return Authorized
     isAuthorized (ChallengeSubmissionJsonR _) _ = return Authorized
+    isAuthorized (ChallengeReadmeInMarkdownR _) _ = regularAuthorization
 
     isAuthorized (ChallengeGraphDataR _) _ = regularAuthorization
     isAuthorized (ChallengeDiscussionR _) _ = regularAuthorization
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index 67f79d9..00beb09 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -187,19 +187,51 @@ hasMetricsOfSecondPriority challengeId = do
 
 
 getChallengeReadmeR :: Text -> Handler Html
-getChallengeReadmeR name = do
-  (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
-  readme <- challengeReadme name
+getChallengeReadmeR challengeName = do
+  (Entity _ challenge) <- runDB $ getBy404 $ UniqueName challengeName
+  readme <- challengeReadme challengeName
   challengeLayout False challenge $ toWidget readme
 
-challengeReadme :: Text -> HandlerFor App Html
-challengeReadme name = do
-  (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
+challengeReadmeInMarkdownApi :: Swagger
+challengeReadmeInMarkdownApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare declareChallengeReadmeInMarkdownSwagger mempty
+
+declareChallengeReadmeInMarkdownSwagger :: Declare (Definitions Schema) Swagger
+declareChallengeReadmeInMarkdownSwagger = do
+  -- param schemas
+  let challengeNameSchema = toParamSchema (Proxy :: Proxy String)
+
+  return $ mempty
+    & paths .~
+        fromList [ ("/api/challenge-readme/{challengeName}/markdown",
+                    mempty & DS.get ?~ (mempty
+                                        & parameters .~ [ Inline $ mempty
+                                                          & name .~ "challengeName"
+                                                          & required ?~ True
+                                                          & schema .~ ParamOther (mempty
+                                                                                  & in_ .~ ParamPath
+                                                                                  & paramSchema .~ challengeNameSchema) ]
+                                        & produces ?~ MimeList ["application/text"]
+                                        & description ?~ "Returns the challenge README in Markdown"))
+                 ]
+
+getChallengeReadmeInMarkdownR :: Text -> Handler TL.Text
+getChallengeReadmeInMarkdownR challengeName = doChallengeReadmeContents challengeName
+
+challengeReadme :: Text -> Handler Html
+challengeReadme challengeName = do
+  theContents <- doChallengeReadmeContents challengeName
+  return $ markdown def theContents
+
+doChallengeReadmeContents :: Text -> Handler TL.Text
+doChallengeReadmeContents challengeName = do
+  (Entity _ challenge) <- runDB $ getBy404 $ UniqueName challengeName
   let repoId = challengePublicRepo challenge
   repoDir <- getRepoDir repoId
   let readmeFilePath = repoDir </> readmeFile
   theContents <- liftIO $ System.IO.readFile readmeFilePath
-  return $ markdown def $ TL.pack theContents
+  return $ TL.pack theContents
 
 showChallengeWidget :: Maybe (Entity User)
                       -> Entity Challenge
@@ -833,7 +865,7 @@ declareAllSubmissionsApi q d = do
                                                                                   & in_ .~ ParamPath
                                                                                   & paramSchema .~ challengeNameSchema) ]
                                         & produces ?~ MimeList ["application/json"]
-                                        & description ?~ "d"
+                                        & description ?~ T.pack d
                                         & at 200 ?~ Inline allSubmissionsResponse))
                  ]
 
diff --git a/Handler/Swagger.hs b/Handler/Swagger.hs
index fa75447..7db76d1 100644
--- a/Handler/Swagger.hs
+++ b/Handler/Swagger.hs
@@ -12,7 +12,12 @@ getSwaggerR :: Handler Value
 getSwaggerR = return $ toJSON apiDescription
 
 apiDescription :: Swagger
-apiDescription = generalApi <> listChallengesApi <> leaderboardApi <> allSubmissionsApi <> mySubmissionsApi
+apiDescription = generalApi
+                 <> listChallengesApi
+                 <> leaderboardApi
+                 <> allSubmissionsApi
+                 <> mySubmissionsApi
+                 <> challengeReadmeInMarkdownApi
 
 generalApi :: Swagger
 generalApi = (mempty :: Swagger)
diff --git a/config/routes b/config/routes
index a186c71..c55a0cf 100644
--- a/config/routes
+++ b/config/routes
@@ -18,8 +18,9 @@
 /api/user-info UserInfoR GET
 /api/add-user AddUserR GET
 /api/challenge-submission/#Text ChallengeSubmissionJsonR POST
-/list-archived-challenges ListArchivedChallengesR GET
+/api/challenge-readme/#Text/markdown ChallengeReadmeInMarkdownR GET
 /challenge-image/#ChallengeId ChallengeImageR GET
+/list-archived-challenges ListArchivedChallengesR GET
 
 /challenge/#Text ShowChallengeR GET
 /challenge-readme/#Text ChallengeReadmeR GET