provide help on the leaderboard and OpenAPI specification

3 files changed, 131 insertions, 9 deletions

diff --git a/lambda-calcul/haskell/src/Minilang/API.hs b/lambda-calcul/haskell/src/Minilang/API.hs
index 94976d2..43baddf 100644
--- a/lambda-calcul/haskell/src/Minilang/API.hs
+++ b/lambda-calcul/haskell/src/Minilang/API.hs
@@ -13,11 +13,13 @@ import Data.Aeson (FromJSON, ToJSON)
 import Data.Bifunctor (first)
 import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as LBS
+import Data.Data (Proxy (..))
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import Servant
   ( Delete,
+    Description,
     FromHttpApiData,
     Get,
     JSON,
@@ -26,6 +28,7 @@ import Servant
     Raw,
     ReqBody,
     StdMethod (POST),
+    Summary,
     ToHttpApiData,
     Verb,
     parseUrlPiece,
@@ -36,14 +39,73 @@ import Servant
 import System.Random (StdGen, uniformList)
 
 type LambdaAPI =
-  "api" :> "register" :> ReqBody '[JSON] User :> Verb 'POST 201 '[JSON] Token
-    :<|> "api" :> "register" :> QueryParam "token" Token :> Delete '[JSON] Score
-    :<|> "api" :> "leaderboard" :> Get '[JSON] [Score]
-    :<|> "api" :> "score" :> QueryParam "token" Token :> Get '[JSON] Score
-    :<|> "api" :> "challenge" :> QueryParam "token" Token :> Get '[JSON] Challenge
-    :<|> "api" :> "challenge" :> QueryParam "token" Token :> ReqBody '[JSON] Text :> Post '[JSON] ()
+  RegisterUser
+    :<|> UnregisterUser
+    :<|> GetLeaderboard
+    :<|> GetScoreFor
+    :<|> GetNextChallenge
+    :<|> PostAnswer
     :<|> Raw
 
+type RegisterUser =
+  Summary
+    "Register given username to participate in the contest and return a token if successful."
+    :> Description "Registration fails if the username is already registered"
+    :> "api"
+    :> "register"
+    :> ReqBody '[JSON] User
+    :> Verb 'POST 201 '[JSON] Token
+
+type UnregisterUser =
+  Summary "Unregister user for given token."
+    :> "api"
+    :> "register"
+    :> QueryParam "token" Token
+    :> Delete '[JSON] Score
+
+type GetLeaderboard =
+  Summary "Retrieve the current leaderboard as a list of scores for registered players"
+    :> "api"
+    :> "leaderboard"
+    :> Get '[JSON] [Score]
+
+type GetScoreFor =
+  Summary "Retrieve current score for user registered with given token"
+    :> "api"
+    :> "score"
+    :> QueryParam "token" Token
+    :> Get '[JSON] Score
+
+type GetNextChallenge =
+  Summary
+    "Retrieve the next challenge for user registered with given token."
+    :> Description
+         "The challenge is given as a string representing a λ-calculus expression\
+         \as expected by this implementation. Check the grammar presented in the /repl.html \
+         \page for more details\
+         \"
+    :> "api"
+    :> "challenge"
+    :> QueryParam "token" Token
+    :> Get '[JSON] Challenge
+
+type PostAnswer =
+  Summary
+    "Post an answer to the current challenge for the given user." :>
+    Description "The answer should be given as JSON string representing the result \
+    \of evaluating the current challenge's expression in the untyped λ-calculus. This \
+    \textual representation should be consistent with the grammar given in the REPL's \
+    \\"Help\" panel. Expect to be surprised 🤔 !\
+    \"
+    :> "api"
+    :> "challenge"
+    :> QueryParam "token" Token
+    :> ReqBody '[JSON] Text
+    :> Post '[JSON] ()
+
+lambdaAPI :: Proxy LambdaAPI
+lambdaAPI = Proxy
+
 data Score = Score
   { user :: User,
     grade :: Int,
diff --git a/lambda-calcul/haskell/src/Minilang/OpenApi.hs b/lambda-calcul/haskell/src/Minilang/OpenApi.hs
new file mode 100644
index 0000000..8d24fec
--- /dev/null
+++ b/lambda-calcul/haskell/src/Minilang/OpenApi.hs
@@ -0,0 +1,49 @@
+module Minilang.OpenApi where
+
+import Control.Lens ((&), (.~), (?~))
+import Data.Swagger
+  ( HasDescription (description),
+    HasInfo (info),
+    HasLicense (license),
+    HasTitle (title),
+    HasType (type_),
+    HasVersion (version),
+    NamedSchema (NamedSchema),
+    Swagger,
+    SwaggerType (SwaggerString),
+    ToParamSchema (..),
+    ToSchema (..),
+  )
+import Minilang.API (Challenge, Score, Token, User, lambdaAPI)
+import Servant.Swagger (HasSwagger (toSwagger))
+
+instance ToSchema Token where
+  declareNamedSchema _ =
+    return $
+      NamedSchema (Just "Token") $
+        mempty
+          & description ?~ "A hex-encoded bytestring."
+          & type_ ?~ SwaggerString
+
+instance ToSchema User where
+  declareNamedSchema _ =
+    return $
+      NamedSchema (Just "User") $
+        mempty
+          & description ?~ "A user name."
+          & type_ ?~ SwaggerString
+
+instance ToSchema Score
+
+instance ToSchema Challenge
+
+instance ToParamSchema Token where
+  toParamSchema _ = mempty & type_ ?~ SwaggerString
+
+lambdaSwagger :: Swagger
+lambdaSwagger =
+  toSwagger lambdaAPI
+    & info . title .~ "λ-Calculus Challenge API"
+    & info . version .~ "0.1"
+    & info . description ?~ "An API for learning and experimenting with the λ-calculus one challenge at a time"
+    & info . license ?~ "© Arnaud Bailly - All Rights Reserved"
diff --git a/lambda-calcul/haskell/src/Minilang/Server.hs b/lambda-calcul/haskell/src/Minilang/Server.hs
index 67b321d..68d991a 100644
--- a/lambda-calcul/haskell/src/Minilang/Server.hs
+++ b/lambda-calcul/haskell/src/Minilang/Server.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- | An HTTP server providing a basic REPL and text editor to work
 -- collaboratively on Minilang code.
@@ -20,16 +22,18 @@ import Data.ByteString.Lazy (fromStrict)
 import qualified Data.ByteString.Lazy as LBS
 import Data.Data (Proxy (..))
 import Data.Default
+import Data.Swagger (Swagger)
 import Data.Text (Text)
 import Minilang.API (Challenge, LambdaAPI, defaultChallenges)
 import Minilang.App (Env (..), lambdaApp, makeEnv, runApp)
 import Minilang.Log
+import Minilang.OpenApi (lambdaSwagger)
 import Minilang.REPL.Net
 import Network.Wai
 import Network.Wai.Handler.Warp as Warp
 import Network.Wai.Middleware.RequestLogger
 import Network.Wai.Middleware.RequestLogger.JSON
-import Servant (hoistServer)
+import Servant (Get, JSON, hoistServer, (:<|>) (..), (:>))
 import Servant.Server (serve)
 import System.Log.FastLogger (fromLogStr)
 import System.Random (newStdGen)
@@ -82,12 +86,19 @@ readChallenges = do
 
 serveAPI :: Env -> Application
 serveAPI env =
-  serve apiProxy $
-    hoistServer apiProxy (runApp env) lambdaApp
+  serve fullApiProxy $
+    hoistServer fullApiProxy (runApp env) (pure lambdaSwagger :<|> lambdaApp)
+
+type FullAPI =
+  "api.json" :> Get '[JSON] Swagger
+    :<|> LambdaAPI
 
 apiProxy :: Proxy LambdaAPI
 apiProxy = Proxy
 
+fullApiProxy :: Proxy FullAPI
+fullApiProxy = Proxy
+
 stopServer :: Server -> IO ()
 stopServer (Server (Just th) _) = cancel th
 stopServer _ = pure ()