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
|
{-# LANGUAGE LambdaCase #-}
module Minilang.IntegrationSpec where
import Control.Exception (bracket)
import Data.Aeson (eitherDecodeFileStrict)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Minilang.API
import Minilang.Lambda.Parser (pretty)
import Minilang.REPL (withInput, withInputs)
import Minilang.REPL.Purer (PurerEnv (..))
import Minilang.REPL.Types (Command (Load), Content (..), Evaluator (..), In (Com), Out (..), initialREPL)
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 DeBruijn) $
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, expr} = 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
let PurerEnv{outputs} = withInputs initialREPL [Com (Load (Data expr))]
case outputs of
-- NOTE: Outputs are in reverse order, so the first output is the last one produced by the REPL.
(Bye : Evaluated ast _ _ : _) -> do
runC env $ answerClient (Just token) (pretty ast)
[Bye] ->
runC env $ answerClient (Just token) ""
answer -> fail $ "Unexpected answer format: " <> show 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 :: Evaluator -> (Server -> IO ()) -> IO ()
withServer evaluator = bracket (startServer 0 evaluator) stopServer
|
