Skip to content

FileServer: add simple content type detection #59

New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

#

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Merged
merged 2 commits into from
Jun 1, 2018
Merged

FileServer: add simple content type detection #59

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
dbeb9c0
FileServer: add simple content type detection
paluh May 11, 2018
cbdb7ca
FileServer: extend htaccess mime list
paluh May 31, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
103 changes: 100 additions & 3 deletions src/Hyper/Node/FileServer.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,11 +1,14 @@
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.Array (last)
import Data.Map (Map, fromFoldable, lookup)
import Data.Maybe (maybe)
import Data.String (Pattern(..), split)
import Data.Tuple (Tuple(Tuple))
import Hyper.Conn (Conn)
import Hyper.Middleware (Middleware, lift')
Expand All @@ -14,10 +17,101 @@ 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.Buffer as Buffer
import Node.FS (FS)
import Node.FS.Aff (readFile, stat, exists)
import Node.FS.Stats (isDirectory, isFile)
import Node.Path (FilePath)
import Node.Path as Path


htaccess :: Map String String
htaccess = fromFoldable $
[ Tuple "aab" "application/x-authorware-bin"
, Tuple "aam" "application/x-authorware-map"
, Tuple "aas" "application/x-authorware-seg"
, Tuple "asc" "text/plain"
, Tuple "asf" "video/x-ms-asf"
, Tuple "asp" "text/html"
, Tuple "asx" "video/x-ms-asf"
, Tuple "avi" "application/octet-stream"
, Tuple "awk" "text/plain"
, Tuple "bash" "text/plain"
, Tuple "bsh" "text/plain"
, Tuple "bz2" "application/octet-stream"
, Tuple "c" "text/plain"
, Tuple "cgi" "text/plain"
, Tuple "chm" "application/octet-stream"
, Tuple "class" "application/x-java-applet"
, Tuple "csh" "text/plain"
, Tuple "css" "text/css"
, Tuple "csv" "application/vnd.ms-excel"
, Tuple "dcr" "application/x-director"
, Tuple "dir" "application/x-director"
, Tuple "dmg" "application/octet-stream"
, Tuple "dxr" "application/x-director"
, Tuple "exe" "application/octet-stream"
, Tuple "fgd" "application/x-director"
, Tuple "fh" "image/x-freehand"
, Tuple "fh4" "image/x-freehand"
, Tuple "fh5" "image/x-freehand"
, Tuple "fh7" "image/x-freehand"
, Tuple "fhc" "image/x-freehand"
, Tuple "flv" "video/x-flv"
, Tuple "gawk" "text/plain"
, Tuple "gtar" "application/x-gtar"
, Tuple "gz" "application/x-gzip"
, Tuple "h" "text/plain"
, Tuple "ico" "image/vnd.microsoft.icon"
, Tuple "in" "text/plain"
, Tuple "ini" "text/plain"
, Tuple "m3u" "audio/x-mpegurl"
, Tuple "md5" "text/plain"
, Tuple "mov" "application/octet-stream"
, Tuple "mov" "video/quicktime"
, Tuple "mp4" "application/octet-stream"
, Tuple "mpg" "application/octet-stream"
, Tuple "msi" "application/octet-stream"
, Tuple "nawk" "text/plain"
, Tuple "pdb" "application/x-pilot"
, Tuple "pdf" "application/pdf"
, Tuple "phps" "application/x-httpd-php-source"
, Tuple "pl" "text/plain"
, Tuple "prc" "application/x-pilot"
, Tuple "py" "text/plain"
, Tuple "qt" "video/quicktime"
, Tuple "ra" "audio/vnd.rn-realaudio"
, Tuple "ram" "audio/vnd.rn-realaudio"
, Tuple "rar" "application/x-rar-compressed"
, Tuple "rm" "application/vnd.rn-realmedia"
, Tuple "rpm" "audio/x-pn-realaudio-plugin"
, Tuple "rv" "video/vnd.rn-realvideo"
, Tuple "sh" "text/plain"
, Tuple "sha" "text/plain"
, Tuple "sha1" "text/plain"
, Tuple "shtml" "text/html"
, Tuple "svg" "image/svg+xml"
, Tuple "svgz" "image/svg+xml"
, Tuple "swf" "application/x-shockwave-flash"
, Tuple "tgz" "application/octet-stream"
, Tuple "torrent" "application/x-bittorrent"
, Tuple "var" "text/plain"
, Tuple "wav" "audio/x-wav"
, Tuple "wax" "audio/x-ms-wax"
, Tuple "wm" "video/x-ms-wm"
, Tuple "wma" "audio/x-ms-wma"
, Tuple "wmd" "application/x-ms-wmd"
, Tuple "wmv" "video/x-ms-wmv"
, Tuple "wmx" "video/x-ms-wmx"
, Tuple "wmz" "application/x-ms-wmz"
, Tuple "wvx" "video/x-ms-wvx"
, Tuple "xbm" "image/x-xbitmap"
, Tuple "xhtml" "application/xhtml+xml"
, Tuple "xls" "application/octet-stream"
, Tuple "xml" "text/xml"
, Tuple "xrdf" "application/xrds+xml"
, Tuple "zip" "application/zip"
]

serveFile
:: forall m e req res c b
Expand All @@ -32,10 +126,13 @@ serveFile
(Conn req (res ResponseEnded) c)
Unit
serveFile path = do
let
ext = last $ split (Pattern ".") path
contentType = maybe "*/*" id (ext >>= flip lookup htaccess)
buf <- lift' (liftAff (readFile path))
contentLength <- liftEff (Buffer.size buf)
_ <- writeStatus statusOK
_ <- headers [ Tuple "Content-Type" "*/*; charset=utf-8"
_ <- headers [ Tuple "Content-Type" (contentType <> "; charset=utf-8")
, Tuple "Content-Length" (show contentLength)
]
response <- toResponse buf
Expand Down