1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use newtype instead of data" #-}
module Minilang.API where
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,
Post,
QueryParam,
Raw,
ReqBody,
StdMethod (POST),
Summary,
ToHttpApiData,
Verb,
parseUrlPiece,
toUrlPiece,
(:<|>),
(:>),
)
import System.Random (StdGen, uniformList)
type LambdaAPI =
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,
lastTest :: Maybe UTCTime,
lastResult :: Maybe Bool
}
deriving (Eq, Show, Generic, ToJSON, FromJSON)
newtype User = User {username :: Text}
deriving newtype (Eq, Show, ToJSON, FromJSON)
newtype Token = Token {unToken :: Text}
deriving newtype (Eq, Ord, Show, ToJSON, FromJSON)
instance ToHttpApiData Token where
toUrlPiece (Token t) = t
instance FromHttpApiData Token where
parseUrlPiece t = Right (Token t)
newToken :: StdGen -> (ByteString, StdGen)
newToken = first LBS.pack . uniformList 16
data Challenge = Challenge
{ level :: Int,
expr :: Text
}
deriving (Eq, Show, Generic, ToJSON, FromJSON)
defaultChallenges :: [Challenge]
defaultChallenges =
[ Challenge 0 "x",
Challenge 1 "y",
Challenge 2 "(lam (x) x)"
]
|
