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
|
{-# 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.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Servant (FromHttpApiData, Get, JSON, Post, QueryParam, Raw, ReqBody, StdMethod (POST), ToHttpApiData, Verb, parseUrlPiece, toUrlPiece, (:<|>), (:>))
import System.Random (StdGen, uniformList)
type LambdaAPI =
"api" :> "register" :> ReqBody '[JSON] User :> Verb 'POST 201 '[JSON] Token
:<|> "api" :> "leaderboard" :> Get '[JSON] [Score]
:<|> "api" :> "challenge" :> QueryParam "token" Token :> Get '[JSON] Challenge
:<|> "api" :> "challenge" :> QueryParam "token" Token :> ReqBody '[JSON] Text :> Post '[JSON] ()
:<|> Raw
data Score = Score
{ user :: User,
grade :: Int,
lastTest :: Maybe UTCTime
}
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)"
]
|
