diff options
Diffstat (limited to 'lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs')
| -rw-r--r-- | lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs | 106 |
1 files changed, 106 insertions, 0 deletions
diff --git a/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs b/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs new file mode 100644 index 0000000..fa87cef --- /dev/null +++ b/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs @@ -0,0 +1,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 |
