From a6fd74498b1d9539aa7c797559344e5b238dfe81 Mon Sep 17 00:00:00 2001
From: Fraser Mince <frasermince@gmail.com>
Date: Sun, 24 Sep 2017 16:39:52 -0500
Subject: [PATCH 1/2] Add headers into fileserver.
---
src/Hyper/Node/FileServer.purs | 14 +++++++++-----
test/Hyper/Node/FileServerSpec.purs | 2 +-
2 files changed, 10 insertions(+), 6 deletions(-)
diff --git a/src/Hyper/Node/FileServer.purs b/src/Hyper/Node/FileServer.purs
index bd5d238..9ce3a4f 100644
--- a/src/Hyper/Node/FileServer.purs
+++ b/src/Hyper/Node/FileServer.purs
@@ -18,6 +18,7 @@ import Node.FS (FS)
import Node.FS.Aff (readFile, stat, exists)
import Node.FS.Stats (isDirectory, isFile)
import Node.Path (FilePath)
+import Data.Array (null)
serveFile
:: forall m e req res c b
@@ -26,18 +27,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 $ if null userProvidedHeaders then h else userProvidedHeaders
response <- toResponse buf
_ <- send response
end
@@ -57,18 +60,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
diff --git a/test/Hyper/Node/FileServerSpec.purs b/test/Hyper/Node/FileServerSpec.purs
index c52b267..2d7e2f7 100644
--- a/test/Hyper/Node/FileServerSpec.purs
+++ b/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)
From c7240b50a641860221b729f2ccc0ccfac6291321 Mon Sep 17 00:00:00 2001
From: Fraser Mince <frasermince@gmail.com>
Date: Sun, 24 Sep 2017 16:54:49 -0500
Subject: [PATCH 2/2] Mappend default headers with user headers.
---
src/Hyper/Node/FileServer.purs | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/src/Hyper/Node/FileServer.purs b/src/Hyper/Node/FileServer.purs
index 9ce3a4f..3218638 100644
--- a/src/Hyper/Node/FileServer.purs
+++ b/src/Hyper/Node/FileServer.purs
@@ -18,7 +18,6 @@ import Node.FS (FS)
import Node.FS.Aff (readFile, stat, exists)
import Node.FS.Stats (isDirectory, isFile)
import Node.Path (FilePath)
-import Data.Array (null)
serveFile
:: forall m e req res c b
@@ -40,7 +39,7 @@ serveFile path userProvidedHeaders = do
, Tuple "Content-Length" (show contentLength)
]
_ <- writeStatus statusOK
- _ <- headers $ if null userProvidedHeaders then h else userProvidedHeaders
+ _ <- headers $ h <> userProvidedHeaders
response <- toResponse buf
_ <- send response
end