/
FileServer.purs
81 lines (76 loc) · 2.35 KB
/
FileServer.purs
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
module Hyper.Node.FileServer (fileServer) where
import Prelude
import Node.Buffer as Buffer
import Node.Path as Path
import Control.IxMonad (ibind, (:>>=))
import Control.Monad.Aff.Class (liftAff, class MonadAff)
import Control.Monad.Eff.Class (liftEff)
import Data.Tuple (Tuple(Tuple))
import Hyper.Conn (Conn)
import Hyper.Middleware (Middleware, lift')
import Hyper.Middleware.Class (getConn)
import Hyper.Request (class Request, getRequestData)
import Hyper.Response (class ResponseWritable, class Response, ResponseEnded, StatusLineOpen, end, headers, send, toResponse, writeStatus)
import Hyper.Status (statusOK)
import Node.Buffer (BUFFER, Buffer)
import Node.FS (FS)
import Node.FS.Aff (readFile, stat, exists)
import Node.FS.Stats (isDirectory, isFile)
import Node.Path (FilePath)
serveFile
:: forall m e req res c b
. Monad m
=> MonadAff (fs :: FS, buffer :: BUFFER | e) m
=> ResponseWritable b m Buffer
=> Response res m b
=> FilePath
-> Middleware
m
(Conn req (res StatusLineOpen) c)
(Conn req (res ResponseEnded) c)
Unit
serveFile path = do
buf <- lift' (liftAff (readFile path))
contentLength <- liftEff (Buffer.size buf)
_ <- writeStatus statusOK
_ <- headers [ Tuple "Content-Type" "*/*; charset=utf-8"
, Tuple "Content-Length" (show contentLength)
]
response <- toResponse buf
_ <- send response
end
where bind = ibind
-- | Extremly basic implementation of static file serving. Needs more love.
fileServer
:: forall m e req res c b
. Monad m
=> MonadAff (fs :: FS, buffer :: BUFFER | e) m
=> Request req m
=> ResponseWritable b m Buffer
=> Response res m b
=> FilePath
-> Middleware
m
(Conn req (res StatusLineOpen) c)
(Conn req (res ResponseEnded) c)
Unit
-> Middleware
m
(Conn req (res StatusLineOpen) c)
(Conn req (res ResponseEnded) c)
Unit
fileServer dir on404 = do
conn ← getConn
{ url } <- getRequestData
serve (Path.concat [dir, url])
where
serveStats absolutePath stats
| isFile stats = serveFile absolutePath
| isDirectory stats = serve (Path.concat [absolutePath, "index.html"])
| otherwise = on404
serve absolutePath = do
fExists ← lift' (liftAff (exists absolutePath))
if fExists
then lift' (liftAff (stat absolutePath)) :>>= serveStats absolutePath
else on404
bind = ibind