API for returning Challenge README

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

Handler/ShowChallenge.hs

@@ -187,19 +187,51 @@ hasMetricsOfSecondPriority challengeId = do
 
 
 getChallengeReadmeR :: Text -> Handler Html
-getChallengeReadmeR name = do
+getChallengeReadmeR challengeName = do
-  (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
+  (Entity _ challenge) <- runDB $ getBy404 $ UniqueName challengeName
-  readme <- challengeReadme name
+  readme <- challengeReadme challengeName
   challengeLayout False challenge $ toWidget readme
 
-challengeReadme :: Text -> HandlerFor App Html
+challengeReadmeInMarkdownApi :: Swagger
-challengeReadme name = do
+challengeReadmeInMarkdownApi = spec & definitions .~ defs
-  (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
+  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))
                  ]
 

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)

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