Initial version of documentation conforming to Swagger 2

Application.hs

@@ -60,6 +60,7 @@ import Handler.Score
 import Handler.ExtraPoints
 import Handler.Dashboard
 import Handler.Evaluate
+import Handler.Swagger
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

Foundation.hs

@@ -219,6 +219,8 @@ instance Yesod App where
 
     isAuthorized (CompareFormR _ _) _ = regularAuthorization
 
+    isAuthorized SwaggerR _ = return Authorized
+
     -- Default to Authorized for now.
     isAuthorized _ _ = isTrustedAuthorized
 

Handler/ListChallenges.hs

@@ -1,6 +1,18 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+
 module Handler.ListChallenges where
 
-import Import
+import Import hiding (get, fromList, Proxy)
+
+import Data.HashMap.Strict.InsOrd (fromList)
+
+import Data.Proxy
+import Data.Aeson
+import Control.Lens hiding ((.=))
+import Data.Swagger
+import Data.Swagger.Lens
+import Data.Swagger.Declare
 
 mainCondition :: [Filter Challenge]
 mainCondition = [ChallengeArchived !=. Just True]
@@ -8,6 +20,24 @@ mainCondition = [ChallengeArchived !=. Just True]
 getListChallengesR :: Handler Html
 getListChallengesR = generalListChallenges mainCondition
 
+declareListChallengesSwagger :: Declare (Definitions Schema) Swagger
+declareListChallengesSwagger = do
+  -- param schemas
+  listChallengesResponse      <- declareResponse (Proxy :: Proxy [Entity Challenge])
+
+  return $ mempty
+    & paths .~
+        [ ("/api/list-challenges", mempty & get ?~ (mempty
+            & produces ?~ MimeList ["application/json"]
+            & description ?~ "Returns the list of all challenges"
+            & at 200 ?~ Inline listChallengesResponse))
+        ]
+
+listChallengesApi :: Swagger
+listChallengesApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare declareListChallengesSwagger mempty
+
 getListChallengesJsonR :: Handler Value
 getListChallengesJsonR = generalListChallengesJson mainCondition
 
@@ -23,6 +53,22 @@ instance ToJSON (Entity Challenge) where
         , "archived" .= challengeArchived ch
         ]
 
+instance ToSchema (Entity Challenge) where
+  declareNamedSchema _ = do
+    stringSchema <- declareSchemaRef (Proxy :: Proxy String)
+    booleanSchema <- declareSchemaRef (Proxy :: Proxy Bool)
+    return $ NamedSchema (Just "Challenge") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           fromList [  ("name", stringSchema)
+                    , ("title", stringSchema)
+                    , ("description", stringSchema)
+                    , ("starred", booleanSchema)
+                    , ("archived", booleanSchema)
+                    ]
+        & required .~ [ "name", "title", "description", "starred", "archived" ]
+
+
 generalListChallengesJson :: [Filter Challenge] -> Handler Value
 generalListChallengesJson filterExpr = do
   challenges <- getChallenges filterExpr

Handler/ShowChallenge.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE OverloadedLists #-}
+
 module Handler.ShowChallenge where
 
-import Import
+import Import hiding (Proxy, fromList)
 import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs)
 
 import qualified Data.Text.Lazy as TL
@@ -59,6 +61,14 @@ import Data.List (nub)
 import qualified Database.Esqueleto      as E
 import           Database.Esqueleto      ((^.))
 
+import Data.Swagger hiding (get)
+import qualified Data.Swagger as DS
+
+import Data.Swagger.Declare
+import Control.Lens hiding ((.=), (^.))
+import Data.Proxy
+import Data.HashMap.Strict.InsOrd (fromList)
+
 instance ToJSON LeaderboardEntry where
     toJSON entry = object
         [ "submitter" .= (formatSubmitter $ leaderboardUser entry)
@@ -70,6 +80,52 @@ instance ToJSON LeaderboardEntry where
         , "times" .= leaderboardNumberOfSubmissions entry
         ]
 
+instance ToSchema LeaderboardEntry where
+  declareNamedSchema _ = do
+    stringSchema <- declareSchemaRef (Proxy :: Proxy String)
+    intSchema <- declareSchemaRef (Proxy :: Proxy Int)
+    return $ NamedSchema (Just "LeaderboardEntry") $ mempty
+        & type_ .~ SwaggerObject
+        & properties .~
+           fromList [  ("submitter", stringSchema)
+                     , ("when", stringSchema)
+                     , ("version", stringSchema)
+                     , ("description", stringSchema)
+                     , ("times", intSchema)
+                    ]
+        & required .~ [ "submitter", "when", "version", "description", "times" ]
+
+
+declareLeaderboardSwagger :: Declare (Definitions Schema) Swagger
+declareLeaderboardSwagger = do
+  -- param schemas
+  let challengeNameSchema = toParamSchema (Proxy :: Proxy String)
+
+  leaderboardResponse      <- declareResponse (Proxy :: Proxy [LeaderboardEntry])
+
+  return $ mempty
+    & paths .~
+        [ ("/api/leaderboard/{challengeName}",
+            mempty & DS.get ?~ (mempty
+                                 & parameters .~ [ Inline $ mempty
+                                                   & name .~ "challengeName"
+                                                   & required ?~ True
+                                                   & schema .~ ParamOther (mempty
+                                                                           & in_ .~ ParamPath
+                                                                           & paramSchema .~ challengeNameSchema) ]
+                                 & produces ?~ MimeList ["application/json"]
+                                 & description ?~ "Returns a leaderboard for a given challenge"
+                                 & at 200 ?~ Inline leaderboardResponse))
+        ]
+
+
+leaderboardApi :: Swagger
+leaderboardApi = spec & definitions .~ defs
+  where
+    (defs, spec) = runDeclare declareLeaderboardSwagger mempty
+
+
+
 getLeaderboardJsonR :: Text -> Handler Value
 getLeaderboardJsonR name = do
   app <- getYesod

Handler/Swagger.hs

@@ -0,0 +1,20 @@
+module Handler.Swagger where
+
+import Import
+
+import Data.Swagger
+import Handler.ListChallenges
+import Handler.ShowChallenge
+
+import Control.Lens hiding ((.=))
+
+getSwaggerR :: Handler Value
+getSwaggerR = return $ toJSON apiDescription
+
+apiDescription :: Swagger
+apiDescription = generalApi <> listChallengesApi <> leaderboardApi
+
+generalApi :: Swagger
+generalApi = (mempty :: Swagger)
+  & info .~ (mempty &
+              title .~ "Gonito API")

config/routes

@@ -98,3 +98,5 @@
 /presentation/psnc-2019 PresentationPSNC2019R GET
 /gonito-in-class GonitoInClassR GET
 /writing-papers WritingPapersWithGonitoR GET
+
+/swagger.json SwaggerR GET

gonito.cabal

@@ -59,6 +59,7 @@ library
                      Data.SubmissionConditions
                      Gonito.ExtractMetadata
                      Data.Diff
+                     Handler.Swagger
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT
@@ -155,6 +156,9 @@ library
                  , word8
                  , jose-jwt
                  , scientific
+                 , swagger2
+                 , lens
+                 , insert-ordered-containers
 
 executable         gonito
     if flag(library-only)

stack.yaml

@@ -18,4 +18,6 @@ extra-deps:
   - yesod-table-2.0.3
   - esqueleto-3.0.0
   - 'ordered-containers-0.2.2@sha256:ebf2be3f592d9cf148ea6b8375f8af97148d44f82d8d04476899285e965afdbf,810'
+  - 'optics-core-0.3.0.1@sha256:50845a47810eb5a5f03dfa9bb1edd8a577fc7ca1702ba4bde68b235f7cb44528,4536'
+  - 'indexed-profunctors-0.1@sha256:ddf618d0d4c58319c1e735e746bc69a1021f13b6f475dc9614b80af03432e6d4,1016'
 resolver: lts-12.26

static/swagger-ui/index.html

@@ -0,0 +1,60 @@
+<!-- HTML for static distribution bundle build -->
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="UTF-8">
+    <title>Swagger UI</title>
+    <link rel="stylesheet" type="text/css" href="./swagger-ui.css" >
+    <link rel="icon" type="image/png" href="./favicon-32x32.png" sizes="32x32" />
+    <link rel="icon" type="image/png" href="./favicon-16x16.png" sizes="16x16" />
+    <style>
+      html
+      {
+        box-sizing: border-box;
+        overflow: -moz-scrollbars-vertical;
+        overflow-y: scroll;
+      }
+
+      *,
+      *:before,
+      *:after
+      {
+        box-sizing: inherit;
+      }
+
+      body
+      {
+        margin:0;
+        background: #fafafa;
+      }
+    </style>
+  </head>
+
+  <body>
+    <div id="swagger-ui"></div>
+
+    <script src="./swagger-ui-bundle.js" charset="UTF-8"> </script>
+    <script src="./swagger-ui-standalone-preset.js" charset="UTF-8"> </script>
+    <script>
+    window.onload = function() {
+      // Begin Swagger UI call region
+      const ui = SwaggerUIBundle({
+        url: "http://127.0.0.1:3000/swagger.json",
+        dom_id: '#swagger-ui',
+        deepLinking: true,
+        presets: [
+          SwaggerUIBundle.presets.apis,
+          SwaggerUIStandalonePreset
+        ],
+        plugins: [
+          SwaggerUIBundle.plugins.DownloadUrl
+        ],
+        layout: "StandaloneLayout"
+      })
+      // End Swagger UI call region
+
+      window.ui = ui
+    }
+  </script>
+  </body>
+</html>

static/swagger-ui/oauth2-redirect.html

@@ -0,0 +1,75 @@
+<!doctype html>
+<html lang="en-US">
+<head>
+    <title>Swagger UI: OAuth2 Redirect</title>
+</head>
+<body>
+</body>
+</html>
+<script>
+    'use strict';
+    function run () {
+        var oauth2 = window.opener.swaggerUIRedirectOauth2;
+        var sentState = oauth2.state;
+        var redirectUrl = oauth2.redirectUrl;
+        var isValid, qp, arr;
+
+        if (/code|token|error/.test(window.location.hash)) {
+            qp = window.location.hash.substring(1);
+        } else {
+            qp = location.search.substring(1);
+        }
+
+        arr = qp.split("&")
+        arr.forEach(function (v,i,_arr) { _arr[i] = '"' + v.replace('=', '":"') + '"';})
+        qp = qp ? JSON.parse('{' + arr.join() + '}',
+                function (key, value) {
+                    return key === "" ? value : decodeURIComponent(value)
+                }
+        ) : {}
+
+        isValid = qp.state === sentState
+
+        if ((
+          oauth2.auth.schema.get("flow") === "accessCode" ||
+          oauth2.auth.schema.get("flow") === "authorizationCode" ||
+          oauth2.auth.schema.get("flow") === "authorization_code"
+        ) && !oauth2.auth.code) {
+            if (!isValid) {
+                oauth2.errCb({
+                    authId: oauth2.auth.name,
+                    source: "auth",
+                    level: "warning",
+                    message: "Authorization may be unsafe, passed state was changed in server Passed state wasn't returned from auth server"
+                });
+            }
+
+            if (qp.code) {
+                delete oauth2.state;
+                oauth2.auth.code = qp.code;
+                oauth2.callback({auth: oauth2.auth, redirectUrl: redirectUrl});
+            } else {
+                let oauthErrorMsg
+                if (qp.error) {
+                    oauthErrorMsg = "["+qp.error+"]: " +
+                        (qp.error_description ? qp.error_description+ ". " : "no accessCode received from the server. ") +
+                        (qp.error_uri ? "More info: "+qp.error_uri : "");
+                }
+
+                oauth2.errCb({
+                    authId: oauth2.auth.name,
+                    source: "auth",
+                    level: "error",
+                    message: oauthErrorMsg || "[Authorization failed]: no accessCode received from the server"
+                });
+            }
+        } else {
+            oauth2.callback({auth: oauth2.auth, token: qp, isValid: isValid, redirectUrl: redirectUrl});
+        }
+        window.close();
+    }
+
+    window.addEventListener('DOMContentLoaded', function () {
+      run();
+    });
+</script>