diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,19 @@ +2009.6.9 +-------- + +### Fix + +* Rename simple router to urlmap +* removed RawRouter, add RegexpRouter that respect scriptName + + +2009.6.7 +--------- + +### Feature + +* add censor middleware + 2009.5.19 --------- diff --git a/hack-contrib.cabal b/hack-contrib.cabal --- a/hack-contrib.cabal +++ b/hack-contrib.cabal @@ -1,5 +1,5 @@ Name: hack-contrib -Version: 2009.5.19 +Version: 2009.6.9 Build-type: Simple Synopsis: Hack contrib Description: Hack contrib @@ -15,7 +15,7 @@ library ghc-options: -Wall - build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, ansi-wl-pprint, data-default >= 0.2, ansi-wl-pprint, unix, time, pureMD5, mps >= 2009.5.13, hack >= 2009.5.19 + build-depends: base >=4 && < 5, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, ansi-wl-pprint, data-default >= 0.2, ansi-wl-pprint, unix, time, pureMD5, mps >= 2009.5.13, hack >= 2009.5.19 hs-source-dirs: src/ exposed-modules: Hack.Contrib.Utils @@ -28,11 +28,11 @@ Hack.Contrib.Middleware.File Hack.Contrib.Middleware.Head Hack.Contrib.Middleware.Hub - Hack.Contrib.Middleware.Mime - Hack.Contrib.Middleware.RawRouter + Hack.Contrib.Mime + Hack.Contrib.Middleware.RegexpRouter Hack.Contrib.Middleware.ShowExceptions Hack.Contrib.Middleware.SimpleAccessLogger - Hack.Contrib.Middleware.SimpleRouter + Hack.Contrib.Middleware.URLMap Hack.Contrib.Middleware.Static Hack.Contrib.Middleware.ETag Hack.Contrib.Middleware.BounceFavicon @@ -43,6 +43,7 @@ Hack.Contrib.Middleware.Lambda Hack.Contrib.Middleware.Lucky Hack.Contrib.Middleware.ShowStatus + Hack.Contrib.Middleware.Censor diff --git a/src/Hack/Contrib/Middleware/Censor.hs b/src/Hack/Contrib/Middleware/Censor.hs new file mode 100644 --- /dev/null +++ b/src/Hack/Contrib/Middleware/Censor.hs @@ -0,0 +1,8 @@ +-- Censor it ! + +module Hack.Contrib.Middleware.Censor (censor) where + +import Hack + +censor :: (Response -> IO Response) -> Middleware +censor alter app = \env -> app env >>= alter diff --git a/src/Hack/Contrib/Middleware/File.hs b/src/Hack/Contrib/Middleware/File.hs --- a/src/Hack/Contrib/Middleware/File.hs +++ b/src/Hack/Contrib/Middleware/File.hs @@ -7,7 +7,7 @@ import Hack.Contrib.Utils import Hack.Contrib.Response import Hack.Contrib.Constants -import Hack.Contrib.Middleware.Mime +import Hack.Contrib.Mime import MPSUTF8 import Prelude hiding ((.), (^), (>), (+), (/), readFile) diff --git a/src/Hack/Contrib/Middleware/Mime.hs b/src/Hack/Contrib/Middleware/Mime.hs deleted file mode 100644 --- a/src/Hack/Contrib/Middleware/Mime.hs +++ /dev/null @@ -1,178 +0,0 @@ -module Hack.Contrib.Middleware.Mime where - -import qualified Data.Map as M -import MPSUTF8 -import Prelude hiding ((.)) - -lookup_mime_type :: String -> Maybe String -lookup_mime_type = flip M.lookup mime_types - -mime_types :: M.Map String String -mime_types = - [ x ".3gp" "video/3gpp" - , x ".a" "application/octet-stream" - , x ".ai" "application/postscript" - , x ".aif" "audio/x-aiff" - , x ".aiff" "audio/x-aiff" - , x ".asc" "application/pgp-signature" - , x ".asf" "video/x-ms-asf" - , x ".asm" "text/x-asm" - , x ".asx" "video/x-ms-asf" - , x ".atom" "application/atom+xml" - , x ".au" "audio/basic" - , x ".avi" "video/x-msvideo" - , x ".bat" "application/x-msdownload" - , x ".bin" "application/octet-stream" - , x ".bmp" "image/bmp" - , x ".bz2" "application/x-bzip2" - , x ".c" "text/x-c" - , x ".cab" "application/vnd.ms-cab-compressed" - , x ".cc" "text/x-c" - , x ".chm" "application/vnd.ms-htmlhelp" - , x ".class" "application/octet-stream" - , x ".com" "application/x-msdownload" - , x ".conf" "text/plain" - , x ".cpp" "text/x-c" - , x ".crt" "application/x-x509-ca-cert" - , x ".css" "text/css" - , x ".csv" "text/csv" - , x ".cxx" "text/x-c" - , x ".deb" "application/x-debian-B.package" - , x ".der" "application/x-x509-ca-cert" - , x ".diff" "text/x-diff" - , x ".djv" "image/vnd.djvu" - , x ".djvu" "image/vnd.djvu" - , x ".dll" "application/x-msdownload" - , x ".dmg" "application/octet-stream" - , x ".doc" "application/msword" - , x ".dot" "application/msword" - , x ".dtd" "application/xml-dtd" - , x ".dvi" "application/x-dvi" - , x ".ear" "application/java-archive" - , x ".eml" "message/rfc822" - , x ".eps" "application/postscript" - , x ".exe" "application/x-msdownload" - , x ".f" "text/x-fortran" - , x ".f77" "text/x-fortran" - , x ".f90" "text/x-fortran" - , x ".flv" "video/x-flv" - , x ".for" "text/x-fortran" - , x ".gem" "application/octet-stream" - , x ".gemspec" "text/x-script.ruby" - , x ".gif" "image/gif" - , x ".gz" "application/x-gzip" - , x ".h" "text/x-c" - , x ".hh" "text/x-c" - , x ".htm" "text/html" - , x ".html" "text/html" - , x ".ico" "image/vnd.microsoft.icon" - , x ".ics" "text/calendar" - , x ".ifb" "text/calendar" - , x ".iso" "application/octet-stream" - , x ".jar" "application/java-archive" - , x ".java" "text/x-java-source" - , x ".jnlp" "application/x-java-jnlp-file" - , x ".jpeg" "image/jpeg" - , x ".jpg" "image/jpeg" - , x ".js" "application/javascript" - , x ".json" "application/json" - , x ".log" "text/plain" - , x ".m3u" "audio/x-mpegurl" - , x ".m4v" "video/mp4" - , x ".man" "text/troff" - , x ".mathml" "application/mathml+xml" - , x ".mbox" "application/mbox" - , x ".mdoc" "text/troff" - , x ".me" "text/troff" - , x ".mid" "audio/midi" - , x ".midi" "audio/midi" - , x ".mime" "message/rfc822" - , x ".mml" "application/mathml+xml" - , x ".mng" "video/x-mng" - , x ".mov" "video/quicktime" - , x ".mp3" "audio/mpeg" - , x ".mp4" "video/mp4" - , x ".mp4v" "video/mp4" - , x ".mpeg" "video/mpeg" - , x ".mpg" "video/mpeg" - , x ".ms" "text/troff" - , x ".msi" "application/x-msdownload" - , x ".odp" "application/vnd.oasis.opendocument.presentation" - , x ".ods" "application/vnd.oasis.opendocument.spreadsheet" - , x ".odt" "application/vnd.oasis.opendocument.text" - , x ".ogg" "application/ogg" - , x ".p" "text/x-pascal" - , x ".pas" "text/x-pascal" - , x ".pbm" "image/x-portable-bitmap" - , x ".pdf" "application/pdf" - , x ".pem" "application/x-x509-ca-cert" - , x ".pgm" "image/x-portable-graymap" - , x ".pgp" "application/pgp-encrypted" - , x ".pkg" "application/octet-stream" - , x ".pl" "text/x-script.perl" - , x ".pm" "text/x-script.perl-module" - , x ".png" "image/png" - , x ".pnm" "image/x-portable-anymap" - , x ".ppm" "image/x-portable-pixmap" - , x ".pps" "application/vnd.ms-powerpoint" - , x ".ppt" "application/vnd.ms-powerpoint" - , x ".ps" "application/postscript" - , x ".psd" "image/vnd.adobe.photoshop" - , x ".py" "text/x-script.python" - , x ".qt" "video/quicktime" - , x ".ra" "audio/x-pn-realaudio" - , x ".rake" "text/x-script.ruby" - , x ".ram" "audio/x-pn-realaudio" - , x ".rar" "application/x-rar-compressed" - , x ".rb" "text/x-script.ruby" - , x ".rdf" "application/rdf+xml" - , x ".roff" "text/troff" - , x ".rpm" "application/x-redhat-B.package-manager" - , x ".rss" "application/rss+xml" - , x ".rtf" "application/rtf" - , x ".ru" "text/x-script.ruby" - , x ".s" "text/x-asm" - , x ".sgm" "text/sgml" - , x ".sgml" "text/sgml" - , x ".sh" "application/x-sh" - , x ".sig" "application/pgp-signature" - , x ".snd" "audio/basic" - , x ".so" "application/octet-stream" - , x ".svg" "image/svg+xml" - , x ".svgz" "image/svg+xml" - , x ".swf" "application/x-shockwave-flash" - , x ".t" "text/troff" - , x ".tar" "application/x-tar" - , x ".tbz" "application/x-bzip-compressed-tar" - , x ".tcl" "application/x-tcl" - , x ".tex" "application/x-tex" - , x ".texi" "application/x-texinfo" - , x ".texinfo" "application/x-texinfo" - , x ".text" "text/plain" - , x ".tif" "image/tiff" - , x ".tiff" "image/tiff" - , x ".torrent" "application/x-bittorrent" - , x ".tr" "text/troff" - , x ".txt" "text/plain" - , x ".vcf" "text/x-vcard" - , x ".vcs" "text/x-vcalendar" - , x ".vrml" "model/vrml" - , x ".war" "application/java-archive" - , x ".wav" "audio/x-wav" - , x ".wma" "audio/x-ms-wma" - , x ".wmv" "video/x-ms-wmv" - , x ".wmx" "video/x-ms-wmx" - , x ".wrl" "model/vrml" - , x ".wsdl" "application/wsdl+xml" - , x ".xbm" "image/x-xbitmap" - , x ".xhtml" "application/xhtml+xml" - , x ".xls" "application/vnd.ms-excel" - , x ".xml" "application/xml" - , x ".xpm" "image/x-xpixmap" - , x ".xsl" "application/xml" - , x ".xslt" "application/xslt+xml" - , x ".yaml" "text/yaml" - , x ".yml" "text/yaml" - , x ".zip" "application/zip" - ] .to_h - where x a b = (a, b) diff --git a/src/Hack/Contrib/Middleware/RawRouter.hs b/src/Hack/Contrib/Middleware/RawRouter.hs deleted file mode 100644 --- a/src/Hack/Contrib/Middleware/RawRouter.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Hack.Contrib.Middleware.RawRouter (route) where - -import Hack -import Hack.Contrib.Request hiding (path) - -import MPSUTF8 -import Prelude hiding ((.), (^), (>)) -import List (find) -import Data.Maybe - -type RoutePath = (String, Application) - -route :: [RoutePath] -> Middleware -route h app = \env -> - let path = env.fullpath - in - case h.find (fst > flip match path > isJust) of - Nothing -> app env - Just (_, found_app) -> found_app env diff --git a/src/Hack/Contrib/Middleware/RegexpRouter.hs b/src/Hack/Contrib/Middleware/RegexpRouter.hs new file mode 100644 --- /dev/null +++ b/src/Hack/Contrib/Middleware/RegexpRouter.hs @@ -0,0 +1,22 @@ +-- | matching a list of regexp agains a path_info, if matched, consponding app +-- is used, otherwise, pass the env down to lower middleware + +module Hack.Contrib.Middleware.RegexpRouter (regexp_router) where + +import Hack +import Hack.Contrib.Utils + +import MPSUTF8 +import Prelude hiding ((.), (^), (>)) +import List (find) +import Data.Maybe + +type RoutePath = (String, Application) + +regexp_router :: [RoutePath] -> Middleware +regexp_router h app = \env -> + let path = env.path_info + in + case h.find (fst > flip match path > isJust) of + Nothing -> app env + Just (_, found_app) -> found_app env diff --git a/src/Hack/Contrib/Middleware/SimpleRouter.hs b/src/Hack/Contrib/Middleware/SimpleRouter.hs deleted file mode 100644 --- a/src/Hack/Contrib/Middleware/SimpleRouter.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} - --- | Stolen from rack: --- Rack::URLMap takes a hash mapping urls or paths to apps, and --- dispatches accordingly. --- --- URLMap modifies the SCRIPT_NAME and PATH_INFO such that the part --- relevant for dispatch is in the SCRIPT_NAME, and the rest in the --- PATH_INFO. This should be taken care of when you need to --- reconstruct the URL in order to create links. --- --- URLMap dispatches in such a way that the longest paths are tried --- first, since they are most specific. - -module Hack.Contrib.Middleware.SimpleRouter (route) where - -import Hack -import Hack.Contrib.Utils - -import MPSUTF8 -import Prelude hiding ((.), (^), (>)) -import List (find, isPrefixOf) - -type RoutePath = (String, Application) - -route :: [RoutePath] -> Middleware -route h app = \env -> - let path = env.path_info - script = env.script_name - mod_env location = env - { scriptName = script ++ location - , pathInfo = path.drop (location.length) - } - in - case h.find (fst > (`isPrefixOf` path) ) of - Nothing -> app env - Just (location, app') -> app' (mod_env location) diff --git a/src/Hack/Contrib/Middleware/URLMap.hs b/src/Hack/Contrib/Middleware/URLMap.hs new file mode 100644 --- /dev/null +++ b/src/Hack/Contrib/Middleware/URLMap.hs @@ -0,0 +1,35 @@ +-- | Stolen from rack: +-- Rack::URLMap takes a hash mapping urls or paths to apps, and +-- dispatches accordingly. +-- +-- URLMap modifies the SCRIPT_NAME and PATH_INFO such that the part +-- relevant for dispatch is in the SCRIPT_NAME, and the rest in the +-- PATH_INFO. This should be taken care of when you need to +-- reconstruct the URL in order to create links. +-- +-- URLMap dispatches in such a way that the longest paths are tried +-- first, since they are most specific. + +module Hack.Contrib.Middleware.URLMap (url_map) where + +import Hack +import Hack.Contrib.Utils + +import MPSUTF8 +import Prelude hiding ((.), (^), (>)) +import List (find, isPrefixOf) + +type RoutePath = (String, Application) + +url_map :: [RoutePath] -> Middleware +url_map h app = \env -> + let path = env.path_info + script = env.script_name + mod_env location = env + { scriptName = script ++ location + , pathInfo = path.drop (location.length) + } + in + case h.find (fst > (`isPrefixOf` path) ) of + Nothing -> app env + Just (location, app') -> app' (mod_env location) diff --git a/src/Hack/Contrib/Mime.hs b/src/Hack/Contrib/Mime.hs new file mode 100644 --- /dev/null +++ b/src/Hack/Contrib/Mime.hs @@ -0,0 +1,178 @@ +module Hack.Contrib.Mime where + +import qualified Data.Map as M +import MPSUTF8 +import Prelude hiding ((.)) + +lookup_mime_type :: String -> Maybe String +lookup_mime_type = flip M.lookup mime_types + +mime_types :: M.Map String String +mime_types = + [ x ".3gp" "video/3gpp" + , x ".a" "application/octet-stream" + , x ".ai" "application/postscript" + , x ".aif" "audio/x-aiff" + , x ".aiff" "audio/x-aiff" + , x ".asc" "application/pgp-signature" + , x ".asf" "video/x-ms-asf" + , x ".asm" "text/x-asm" + , x ".asx" "video/x-ms-asf" + , x ".atom" "application/atom+xml" + , x ".au" "audio/basic" + , x ".avi" "video/x-msvideo" + , x ".bat" "application/x-msdownload" + , x ".bin" "application/octet-stream" + , x ".bmp" "image/bmp" + , x ".bz2" "application/x-bzip2" + , x ".c" "text/x-c" + , x ".cab" "application/vnd.ms-cab-compressed" + , x ".cc" "text/x-c" + , x ".chm" "application/vnd.ms-htmlhelp" + , x ".class" "application/octet-stream" + , x ".com" "application/x-msdownload" + , x ".conf" "text/plain" + , x ".cpp" "text/x-c" + , x ".crt" "application/x-x509-ca-cert" + , x ".css" "text/css" + , x ".csv" "text/csv" + , x ".cxx" "text/x-c" + , x ".deb" "application/x-debian-B.package" + , x ".der" "application/x-x509-ca-cert" + , x ".diff" "text/x-diff" + , x ".djv" "image/vnd.djvu" + , x ".djvu" "image/vnd.djvu" + , x ".dll" "application/x-msdownload" + , x ".dmg" "application/octet-stream" + , x ".doc" "application/msword" + , x ".dot" "application/msword" + , x ".dtd" "application/xml-dtd" + , x ".dvi" "application/x-dvi" + , x ".ear" "application/java-archive" + , x ".eml" "message/rfc822" + , x ".eps" "application/postscript" + , x ".exe" "application/x-msdownload" + , x ".f" "text/x-fortran" + , x ".f77" "text/x-fortran" + , x ".f90" "text/x-fortran" + , x ".flv" "video/x-flv" + , x ".for" "text/x-fortran" + , x ".gem" "application/octet-stream" + , x ".gemspec" "text/x-script.ruby" + , x ".gif" "image/gif" + , x ".gz" "application/x-gzip" + , x ".h" "text/x-c" + , x ".hh" "text/x-c" + , x ".htm" "text/html" + , x ".html" "text/html" + , x ".ico" "image/vnd.microsoft.icon" + , x ".ics" "text/calendar" + , x ".ifb" "text/calendar" + , x ".iso" "application/octet-stream" + , x ".jar" "application/java-archive" + , x ".java" "text/x-java-source" + , x ".jnlp" "application/x-java-jnlp-file" + , x ".jpeg" "image/jpeg" + , x ".jpg" "image/jpeg" + , x ".js" "application/javascript" + , x ".json" "application/json" + , x ".log" "text/plain" + , x ".m3u" "audio/x-mpegurl" + , x ".m4v" "video/mp4" + , x ".man" "text/troff" + , x ".mathml" "application/mathml+xml" + , x ".mbox" "application/mbox" + , x ".mdoc" "text/troff" + , x ".me" "text/troff" + , x ".mid" "audio/midi" + , x ".midi" "audio/midi" + , x ".mime" "message/rfc822" + , x ".mml" "application/mathml+xml" + , x ".mng" "video/x-mng" + , x ".mov" "video/quicktime" + , x ".mp3" "audio/mpeg" + , x ".mp4" "video/mp4" + , x ".mp4v" "video/mp4" + , x ".mpeg" "video/mpeg" + , x ".mpg" "video/mpeg" + , x ".ms" "text/troff" + , x ".msi" "application/x-msdownload" + , x ".odp" "application/vnd.oasis.opendocument.presentation" + , x ".ods" "application/vnd.oasis.opendocument.spreadsheet" + , x ".odt" "application/vnd.oasis.opendocument.text" + , x ".ogg" "application/ogg" + , x ".p" "text/x-pascal" + , x ".pas" "text/x-pascal" + , x ".pbm" "image/x-portable-bitmap" + , x ".pdf" "application/pdf" + , x ".pem" "application/x-x509-ca-cert" + , x ".pgm" "image/x-portable-graymap" + , x ".pgp" "application/pgp-encrypted" + , x ".pkg" "application/octet-stream" + , x ".pl" "text/x-script.perl" + , x ".pm" "text/x-script.perl-module" + , x ".png" "image/png" + , x ".pnm" "image/x-portable-anymap" + , x ".ppm" "image/x-portable-pixmap" + , x ".pps" "application/vnd.ms-powerpoint" + , x ".ppt" "application/vnd.ms-powerpoint" + , x ".ps" "application/postscript" + , x ".psd" "image/vnd.adobe.photoshop" + , x ".py" "text/x-script.python" + , x ".qt" "video/quicktime" + , x ".ra" "audio/x-pn-realaudio" + , x ".rake" "text/x-script.ruby" + , x ".ram" "audio/x-pn-realaudio" + , x ".rar" "application/x-rar-compressed" + , x ".rb" "text/x-script.ruby" + , x ".rdf" "application/rdf+xml" + , x ".roff" "text/troff" + , x ".rpm" "application/x-redhat-B.package-manager" + , x ".rss" "application/rss+xml" + , x ".rtf" "application/rtf" + , x ".ru" "text/x-script.ruby" + , x ".s" "text/x-asm" + , x ".sgm" "text/sgml" + , x ".sgml" "text/sgml" + , x ".sh" "application/x-sh" + , x ".sig" "application/pgp-signature" + , x ".snd" "audio/basic" + , x ".so" "application/octet-stream" + , x ".svg" "image/svg+xml" + , x ".svgz" "image/svg+xml" + , x ".swf" "application/x-shockwave-flash" + , x ".t" "text/troff" + , x ".tar" "application/x-tar" + , x ".tbz" "application/x-bzip-compressed-tar" + , x ".tcl" "application/x-tcl" + , x ".tex" "application/x-tex" + , x ".texi" "application/x-texinfo" + , x ".texinfo" "application/x-texinfo" + , x ".text" "text/plain" + , x ".tif" "image/tiff" + , x ".tiff" "image/tiff" + , x ".torrent" "application/x-bittorrent" + , x ".tr" "text/troff" + , x ".txt" "text/plain" + , x ".vcf" "text/x-vcard" + , x ".vcs" "text/x-vcalendar" + , x ".vrml" "model/vrml" + , x ".war" "application/java-archive" + , x ".wav" "audio/x-wav" + , x ".wma" "audio/x-ms-wma" + , x ".wmv" "video/x-ms-wmv" + , x ".wmx" "video/x-ms-wmx" + , x ".wrl" "model/vrml" + , x ".wsdl" "application/wsdl+xml" + , x ".xbm" "image/x-xbitmap" + , x ".xhtml" "application/xhtml+xml" + , x ".xls" "application/vnd.ms-excel" + , x ".xml" "application/xml" + , x ".xpm" "image/x-xpixmap" + , x ".xsl" "application/xml" + , x ".xslt" "application/xslt+xml" + , x ".yaml" "text/yaml" + , x ".yml" "text/yaml" + , x ".zip" "application/zip" + ] .to_h + where x a b = (a, b) diff --git a/src/Hack/Contrib/Utils.hs b/src/Hack/Contrib/Utils.hs --- a/src/Hack/Contrib/Utils.hs +++ b/src/Hack/Contrib/Utils.hs @@ -83,7 +83,7 @@ query_string = queryString server_name = serverName server_port = serverPort -hack_version = hack_version +hack_version = hackVersion hack_url_scheme = hackUrlScheme hack_input = hackInput hack_errors = hackErrors