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
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Minilang.ServerSpec where
import Control.Concurrent.STM (newTVarIO)
import Data.Aeson (FromJSON, eitherDecode, encode)
import Data.ByteString (isInfixOf, toStrict)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.Lazy as Base64
import Data.ByteString.Lazy (ByteString)
import Data.Data (Proxy (..))
import Minilang.API (Score, User (..), newToken)
import Minilang.App (Env (..))
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, post, request, shouldRespondWith, with)
import Test.Hspec.Wai.Matcher (MatchBody (..))
spec :: Spec
spec = with (app testSeed) $ do
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" $ do
get "/api/leaderboard"
`shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 2}
it "POST /api/register returns registration token given user is not registered" $ do
let token = "{\"token\":\"" <> Base64.encode (fst $ newToken testSeed) <> "\"}"
let user = encode $ User "alice"
postJSON "/api/register" user
`shouldRespondWith` 201
{ matchBody = MatchBody $ \_ t ->
if t == token
then
Nothing
else Just ("Expected token " ++ show token ++ ", but got " ++ show t)
}
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 <- Env <$> newTVarIO g
pure $ serveAPI env
testSeed :: StdGen
testSeed = mkStdGen64 42
|
