Add Custom Headers To File Server

src/Hyper/Node/FileServer.purs

@@ -26,18 +26,20 @@ serveFile
   => ResponseWritable b m Buffer
   => Response res m b
   => FilePath
+  -> Array (Tuple String String)
   -> Middleware
      m
      (Conn req (res StatusLineOpen) c)
      (Conn req (res ResponseEnded) c)
      Unit
-serveFile path = do
+serveFile path userProvidedHeaders = do
   buf <- lift' (liftAff (readFile path))
   contentLength <- liftEff (Buffer.size buf)
-  _ <- writeStatus statusOK
-  _ <- headers [ Tuple "Content-Type" "*/*; charset=utf-8"
+  let h = [ Tuple "Content-Type" "*/*; charset=utf-8"
           , Tuple "Content-Length" (show contentLength)
           ]
+  _ <- writeStatus statusOK
+  _ <- headers $ h <> userProvidedHeaders
   response <- toResponse buf
   _ <- send response
   end
@@ -57,18 +59,19 @@ fileServer
      (Conn req (res StatusLineOpen) c)
      (Conn req (res ResponseEnded) c)
      Unit
+  -> Array (Tuple String String)
   -> Middleware
      m
      (Conn req (res StatusLineOpen) c)
      (Conn req (res ResponseEnded) c)
      Unit
-fileServer dir on404 = do
+fileServer dir on404 headers = do
   conn ← getConn
   { url } <- getRequestData
   serve (Path.concat [dir, url])
   where
     serveStats absolutePath stats
-      | isFile stats = serveFile absolutePath
+      | isFile stats = serveFile absolutePath headers
       | isDirectory stats = serve (Path.concat [absolutePath, "index.html"])
       | otherwise = on404
 

test/Hyper/Node/FileServerSpec.purs

@@ -33,7 +33,7 @@ serveFilesAndGet path =
   # evalMiddleware app
   # testServer
   where
-    app = fileServer "test/Hyper/Node/FileServerSpec" on404
+    app = fileServer "test/Hyper/Node/FileServerSpec" on404 []
 
     on404 = do
       body <- liftEff (Buffer.fromString "Not Found" UTF8)