fake fileserver for unit tests

swarm-game · May 21, 2024 · 61e3412 · 61e3412
1 parent 162b0e4
commit 61e3412
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 8 deletions.
diff --git a/src/swarm-tournament/Swarm/Web/Tournament.hs b/src/swarm-tournament/Swarm/Web/Tournament.hs
@@ -324,8 +324,10 @@ doLoginResponse authStorage refererUrl userAlias = do
 
 -- * Web app declaration
 
-app :: AppData -> Application
-app appData = Servant.serveWithContext (Proxy :: Proxy ToplevelAPI) context server
+app :: Bool -> AppData -> Application
+app unitTestFileserver appData =
+  Servant.serveWithContext (Proxy :: Proxy ToplevelAPI) context $
+    server unitTestFileserver
  where
   size100kB = 100_000 :: Int64
 
@@ -346,13 +348,23 @@ app appData = Servant.serveWithContext (Proxy :: Proxy ToplevelAPI) context serv
       (developmentMode appData)
   context = thisAuthHandler :. multipartOpts :. EmptyContext
 
-  server :: Server ToplevelAPI
-  server =
+  server :: Bool -> Server ToplevelAPI
+  server fakeFileserverForUnitTest =
     mkApp appData
       :<|> Tagged serveDocs
-      :<|> serveDirectoryWith
-        (defaultFileServerSettings "tournament/web")
+      :<|> fileserver
    where
+    fileserver =
+      if fakeFileserverForUnitTest
+        then
+          serveDirectoryEmbedded
+            [ ("/list-games.html", "Hello World!")
+            , ("/list-solutions.html", "Hello World!")
+            ]
+        else
+          serveDirectoryWith
+            (defaultFileServerSettings "tournament/web")
+
     serveDocs _ resp =
       resp $ responseLBS ok200 [htmlType] tournamentsApiHtml
     htmlType = ("Content-Type", "text/html")
@@ -361,6 +373,6 @@ webMain ::
   AppData ->
   Warp.Port ->
   IO ()
-webMain appData port = Warp.runSettings settings $ app appData
+webMain appData port = Warp.runSettings settings $ app False appData
  where
   settings = Warp.setPort port Warp.defaultSettings
diff --git a/test/tournament-host/Main.hs b/test/tournament-host/Main.hs
@@ -135,4 +135,4 @@ uploadForm appData urlPath form =
             ]
     assertEqual assertionMsg ok200 $ responseStatus resp
  where
-  tournamentApp = Tournament.app appData
+  tournamentApp = Tournament.app True appData