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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Minilang.ServerSpec where
import Control.Monad (void)
import Data.Aeson (FromJSON, eitherDecode, encode)
import Data.Bifunctor (first)
import Data.ByteString (isInfixOf, toStrict)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16.Lazy as Hex
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Data (Proxy (..))
import Data.String (fromString)
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding (decodeUtf8)
import Minilang.API (Challenge (..), Score (..), User (..), defaultChallenges, newToken)
import Minilang.App (makeEnv)
import Minilang.Server (serveAPI)
import Network.Wai (Application)
import Network.Wai.Test (SResponse)
import System.Random (StdGen, mkStdGen64)
import Test.Hspec (Spec, it)
import Test.Hspec.Wai (WaiSession, get, matchBody, request, shouldRespondWith, with)
import Test.Hspec.Wai.Matcher (MatchBody (..))
spec :: Spec
spec = with (app testSeed) $ do
let (token, gen) = first Hex.encode (newToken testSeed)
alice = encode $ User "alice"
it "GET / returns 'index.html'" $ do
get "/"
`shouldRespondWith` 200
{ matchBody = MatchBody $ \_ actual ->
if "<html>" `isInfixOf` toStrict actual
then Nothing
else Just "Expected HTML content"
}
it "GET /api/leaderboard returns empty list of scores at start" $ do
get "/api/leaderboard"
`shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 0}
it "POST /api/register returns registration token given user is not registered" $ do
postJSON "/api/register" alice
`shouldRespondWith` 201
{ matchBody = MatchBody $ \_ t ->
if t == encode (decodeUtf8 token)
then
Nothing
else Just ("Expected token " ++ show token ++ ", but got " ++ show t)
}
it "GET /api/leaderboard returns list of one element after user registers" $ do
void $ postJSON "/api/register" alice
get "/api/leaderboard"
`shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 1}
it "POST /api/register returns 400 given user is already registered" $ do
void $ postJSON "/api/register" alice
postJSON "/api/register" alice
`shouldRespondWith` 400
it "GET /api/challenge returns next challenge given user is registered" $ do
let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge {level = 0, expr = "x"}
postJSON "/api/register" alice
`shouldRespondWith` 201
get ("/api/challenge?token=" <> LBS.toStrict token)
`shouldRespondWith` fromString expected
it "GET /api/challenge returns 400 given user is not registered" $
get ("/api/challenge?token=" <> LBS.toStrict token)
`shouldRespondWith` 400
it "POST /api/challenge returns 200 given challenge response is correct" $ do
let response = "\"x\""
void $ postJSON "/api/register" alice
postJSON ("/api/challenge?token=" <> LBS.toStrict token) response
`shouldRespondWith` 200
it "POST /api/challenge returns 400 given challenge response is incorrect" $ do
let response = "\"y\""
void $ postJSON "/api/register" alice
postJSON ("/api/challenge?token=" <> LBS.toStrict token) response
`shouldRespondWith` 400
it "POST /api/challenge returns 400 given user is not registered" $ do
let response = "\"x\""
postJSON ("/api/challenge?token=" <> LBS.toStrict token) response
`shouldRespondWith` 400
it "POST /api/challenge returns 400 given wrong token" $ do
let response = "\"x\""
otherToken = Hex.encode $ fst $ newToken gen
postJSON ("/api/challenge?token=" <> LBS.toStrict otherToken) response
`shouldRespondWith` 400
it "GET /api/challenge returns next level challenge after successful POST" $ do
let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge {level = 1, expr = "y"}
void $ postJSON "/api/register" alice
void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"x\""
get ("/api/challenge?token=" <> LBS.toStrict token)
`shouldRespondWith` fromString expected
it "GET /api/challenge returns same challenge after failed POST" $ do
let expected = LT.unpack $ decodeUtf8 $ encode $ head defaultChallenges
void $ postJSON "/api/register" alice
void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"y\""
get ("/api/challenge?token=" <> LBS.toStrict token)
`shouldRespondWith` fromString expected
it "GET /api/score returns user current score" $ do
void $ postJSON "/api/register" alice
get ("/api/score?token=" <> LBS.toStrict token)
`shouldRespondWith` 200
{ matchBody = MatchBody $ \_ actual ->
case eitherDecode actual of
Right (score :: Score) ->
if score == Score {user = User "alice", grade = 0, lastTest = Nothing, lastResult = Nothing}
then Nothing
else Just $ "Expected score with grade 0, but got " ++ show score
Left err -> Just $ "Failed to decode JSON: " ++ err
}
it "GET /api/score returns 400 given token is not registered" $ do
get ("/api/score?token=" <> LBS.toStrict token)
`shouldRespondWith` 400
it "GET /api/score returns score with success given last challenge succeeded" $ do
void $ postJSON "/api/register" alice
void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"x\""
get ("/api/score?token=" <> LBS.toStrict token)
`shouldRespondWith` 200
{ matchBody = MatchBody $ \_ actual ->
case eitherDecode actual of
Right (score :: Score) ->
if lastResult score == Just True
then Nothing
else Just $ "Expected score with success, but got " ++ show score
Left err -> Just $ "Failed to decode JSON: " ++ err
}
it "GET /api/score returns score with failure given last challenge failed" $ do
void $ postJSON "/api/register" alice
void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"y\""
get ("/api/score?token=" <> LBS.toStrict token)
`shouldRespondWith` 200
{ matchBody = MatchBody $ \_ actual ->
case eitherDecode actual of
Right (score :: Score) ->
if lastResult score == Just False
then Nothing
else Just $ "Expected score with failure, but got " ++ show score
Left err -> Just $ "Failed to decode JSON: " ++ err
}
postJSON :: BS.ByteString -> ByteString -> WaiSession () SResponse
postJSON url = request "POST" url [("Content-Type", "application/json")]
arrayOfLengthOf :: forall elem proxy. (FromJSON elem) => proxy elem -> Int -> MatchBody
arrayOfLengthOf _ len = MatchBody $ \_ actual ->
case eitherDecode actual of
Right (scores :: [elem]) ->
if length scores == len
then Nothing
else Just $ "Expected array of length " ++ show len ++ ", but got " ++ show (length scores)
Left err -> Just $ "Failed to decode JSON: " ++ err
app :: StdGen -> IO Application
app g = do
env <- makeEnv g defaultChallenges
pure $ serveAPI env
testSeed :: StdGen
testSeed = mkStdGen64 42
|
