blob: fa87cef73a9fbfd189fd7eeceed36cf336f9e351 (
plain)
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
|
{-# LANGUAGE LambdaCase #-}
module Minilang.IntegrationSpec where
import Control.Exception (bracket)
import Data.Aeson (eitherDecodeFileStrict)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Minilang.API
import Minilang.Server (Server (..), startServer, stopServer)
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Servant.API ((:<|>) (..))
import Servant.Client hiding (mkClientEnv)
import qualified Servant.Client as SC
import Test.Hspec
-- ---------------------------------------------------------------------------
-- Servant client functions derived from the API type
-- ---------------------------------------------------------------------------
registerClient :: User -> ClientM Token
unregisterClient :: Maybe Token -> ClientM Score
leaderboardClient :: ClientM [Score]
scoreClient :: Maybe Token -> ClientM Score
challengeClient :: Maybe Token -> ClientM Challenge
answerClient :: Maybe Token -> Text -> ClientM ()
registerClient
:<|> unregisterClient
:<|> leaderboardClient
:<|> scoreClient
:<|> challengeClient
:<|> answerClient
:<|> _ =
client (Proxy :: Proxy LambdaAPI)
-- ---------------------------------------------------------------------------
-- Helpers
-- ---------------------------------------------------------------------------
-- | Build a 'ClientEnv' pointing at localhost on the given port.
mkEnv :: Int -> IO ClientEnv
mkEnv port = do
mgr <- newManager defaultManagerSettings
pure $ SC.mkClientEnv mgr (BaseUrl Http "127.0.0.1" port "")
-- | Run a servant client action, failing the test on a Left.
runC :: ClientEnv -> ClientM a -> IO a
runC env action =
runClientM action env >>= \case
Left err -> fail $ "Servant client error: " <> show err
Right v -> pure v
-- ---------------------------------------------------------------------------
-- Spec
-- ---------------------------------------------------------------------------
spec :: Spec
spec =
around withServer $
describe "Full contest integration" $ do
it "Alice can solve all challenges and reach the maximum grade" $
\Server{serverPort} -> do
-- Load the same challenges.json the server loaded so we know the
-- expected final grade.
challenges <-
eitherDecodeFileStrict "challenges.json" >>= \case
Left err -> fail $ "Could not load challenges.json: " <> err
Right cs -> pure (cs :: [Challenge])
let maxGrade = length challenges
env <- mkEnv serverPort
-- Register Alice
token <- runC env $ registerClient (User "alice")
-- Solve every challenge in order
mapM_ (solveChallenge env token) challenges
-- Verify final grade equals number of challenges
Score{grade} <- runC env $ scoreClient (Just token)
grade `shouldBe` maxGrade
-- Clean up
_ <- runC env $ unregisterClient (Just token)
pure ()
-- | Fetch the current challenge for the token, post the known answer, and
-- assert the server accepted it (200 OK / no exception).
solveChallenge :: ClientEnv -> Token -> Challenge -> IO ()
solveChallenge env token Challenge{level, answer} = do
-- Confirm the server gives us the challenge we expect at this grade
Challenge{level = serverLevel} <- runC env $ challengeClient (Just token)
serverLevel `shouldBe` level
-- Post the correct answer
runC env $ answerClient (Just token) answer
-- ---------------------------------------------------------------------------
-- Server lifecycle
-- ---------------------------------------------------------------------------
-- | Spawn the real server (which itself reads challenges.json and picks a
-- free port) and tear it down after the test.
withServer :: (Server -> IO ()) -> IO ()
withServer = bracket (startServer 0) stopServer
|
