packages feed

hack-contrib 2009.4.51 → 2009.4.52

raw patch · 22 files changed

+227/−83 lines, 22 filesdep ~hack

Dependency ranges changed: hack

Files

changelog.md view
@@ -1,4 +1,25 @@+2009.4.52+---------++### Feature++* request / response helper, able to get params / inputs data++### Fix++* uniform utf8 interface for string+* compatible with hack 4.52++2009.4.51.1+-----------++### Fix++* enforce unicode asap policy+* rename ContnetSize to ContentLenght, since it was a typo+ 2009.4.51+---------  ### Feature @@ -9,6 +30,7 @@ * require MPS 4.50, hack 4.50  2009.4.50+---------  ### Feature
hack-contrib.cabal view
@@ -1,5 +1,5 @@ Name:                 hack-contrib-Version:              2009.4.51+Version:              2009.4.52 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, mps >= 2009.4.50, data-default >= 0.2, ansi-wl-pprint, unix, time, pureMD5, hack >= 2009.4.50+  build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, ansi-wl-pprint, mps >= 2009.4.50, data-default >= 0.2, ansi-wl-pprint, unix, time, pureMD5, hack >= 2009.4.52   hs-source-dirs: src/   exposed-modules:                       Hack.Contrib.Utils@@ -23,7 +23,7 @@                     Hack.Contrib.Response                     Hack.Contrib.Constants                     -                    Hack.Contrib.Middleware.ContentSize+                    Hack.Contrib.Middleware.ContentLength                     Hack.Contrib.Middleware.ContentType                     Hack.Contrib.Middleware.File                     Hack.Contrib.Middleware.Head
src/Hack/Contrib/Middleware/BounceFavicon.hs view
@@ -1,3 +1,4 @@+-- | Stolen from rack-contrib: Bounce those annoying favicon.ico requests module Hack.Contrib.Middleware.BounceFavicon (bounce_favicon) where  import Hack
src/Hack/Contrib/Middleware/Config.hs view
@@ -1,3 +1,4 @@+-- | Stolen from rack-contrib: modifies the environment using the block given during initialization. module Hack.Contrib.Middleware.Config (config) where  import Hack
+ src/Hack/Contrib/Middleware/ContentLength.hs view
@@ -0,0 +1,27 @@+-- | Stolen from rack: Sets the Content-Length header on responses with fixed-length bodies.++module Hack.Contrib.Middleware.ContentLength (content_length) where++import Hack+import Hack.Contrib.Utils+import Hack.Contrib.Response+import Hack.Contrib.Constants++import MPSUTF8+import Prelude hiding ((.), (^), (>))++content_length :: Middleware+content_length app = \env -> do+  response <- app env+  +  if should_size response+    then response+      .set_header _ContentLength (response.body.bytesize.show) .return+    else response .return+  +  where +    should_size response =+      [  not $ response.has_header _ContentLength+      ,  not $ response.has_header _TransferEncoding+      ,  not $ status_with_no_entity_body.has(response.status)+      ] .and
− src/Hack/Contrib/Middleware/ContentSize.hs 
@@ -1,25 +0,0 @@-module Hack.Contrib.Middleware.ContentSize (content_size) where--import Hack-import Hack.Contrib.Utils-import Hack.Contrib.Response-import Hack.Contrib.Constants--import MPSUTF8-import Prelude hiding ((.), (^), (>))--content_size :: Middleware-content_size app = \env -> do-  response <- app env-  -  if should_size response-    then response-      .set_header _ContentLength (response.body.bytesize.show) .return-    else response .return-  -  where -    should_size response =-      [  not $ response.has_header _ContentLength-      ,  not $ response.has_header _TransferEncoding-      ,  not $ status_with_no_entity_body.has(response.status)-      ] .and
src/Hack/Contrib/Middleware/ContentType.hs view
@@ -1,3 +1,5 @@+-- | Stolen from rack: Sets the Content-Type header on responses which don't have one.+ module Hack.Contrib.Middleware.ContentType (content_type) where  import Hack
src/Hack/Contrib/Middleware/ETag.hs view
@@ -1,3 +1,4 @@+-- | Stolen from rack-contrib: Automatically sets the ETag header on all String bodies module Hack.Contrib.Middleware.ETag (etag) where  import Hack
src/Hack/Contrib/Middleware/File.hs view
@@ -1,3 +1,4 @@+-- | Stolen from rack:serves files below the +root+ given, according to the path info of the Rack request. module Hack.Contrib.Middleware.File (file) where  import Hack@@ -16,37 +17,41 @@ import System.FilePath  +-- path name should be a unicode_string+-- so you can put unicode chars directly in your config+-- without encoding it+ file :: Maybe String -> Middleware file root _ = \env -> do-  let path = env.path_info .url2unicode+  let path = env.path_info .unescape_uri   -  if ".." `isInfixOf` path +  if ".." `isInfixOf` path     then forbidden     else path.serve root  -serve :: Maybe String -> FilePath -> IO Response+serve :: Maybe String -> String -> IO Response serve root fname = do-  cwd <- get_current_directory+  cwd <- getCurrentDirectory   let my_root = root.fromMaybe cwd   let path = my_root / makeRelative "/" fname   -  exist <- file_exist path+  exist <- doesFileExist path    if not exist       then path.not_found       else         do -          can_read <- path.get_permissions ^ readable+          can_read <- path.getPermissions ^ readable           if not can_read             then path.no_permission             else path.serving          where        serving path = do-        content <- path.read_binary_file-        size <- path.file_size ^ from_i-        mtime_str <- path.file_mtime ^ httpdate+        content <- path.b2u.read_binary_file+        size <- path.b2u.file_size ^ from_i+        mtime_str <- path.b2u.file_mtime ^ httpdate                  let default_content_type = "application/octet-stream"         let safe_lookup = lookup_mime_type > fromMaybe default_content_type
src/Hack/Contrib/Middleware/Hub.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE QuasiQuotes #-}  -- the entire logging framework is stolen from [innate](http://github.com/manveru/innate/tree/master)-- module Hack.Contrib.Middleware.Hub where -import Hack import Hack.Contrib.Utils  import MPSUTF8@@ -33,14 +30,14 @@  type Logger = String -> Severity -> IO () -hub :: Stream -> Formatter -> String -> Logger+hub :: (String -> IO ()) -> Formatter -> String -> Logger hub stream formatter program = \message severity ->    do     time <- now     pid <- getProcessID ^ from_i     stream $ formatter severity time pid program message -simple_logger :: Stream -> String -> Logger+simple_logger :: (String -> IO ()) -> String -> Logger simple_logger = flip hub simple_formatter  simple_formatter :: Formatter
src/Hack/Contrib/Middleware/Inspect.hs view
@@ -1,25 +1,9 @@+-- | print the env and response in the console module Hack.Contrib.Middleware.Inspect (inspect) where  import Hack-import Hack.Contrib.Constants-import Hack.Contrib.Response- import MPSUTF8-import Prelude hiding ((.), (^), (>), head)+import Prelude hiding ((.), (^))  inspect :: Middleware-inspect app = \env -> do-  r <- app env-  return $ -    r-      .set_body (output env r)-      .set_content_type _TextPlainUTF8-  -  where-    output env r = -        [  env.show-        ,  70.times '-'-        ,  r.status.show-        ,  r.headers.show-        ,  r.body-        ] .join "\n\n"+inspect app = \env -> env.trace'.app ^ trace'
src/Hack/Contrib/Middleware/Lambda.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} +-- | Paste has a Pony, Rack has a Lobster, Hack has a Lambda >< module Hack.Contrib.Middleware.Lambda (lambda) where  import Hack
src/Hack/Contrib/Middleware/Lucky.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} +-- | Paste has a Pony, Rack has a Lobster, Hack has a Lucky - - module Hack.Contrib.Middleware.Lucky (lucky) where  import Hack
src/Hack/Contrib/Middleware/Mime.hs view
@@ -4,6 +4,9 @@ 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"@@ -173,6 +176,3 @@    ,  x     ".zip"          "application/zip"    ] .to_h    where x a b = (a, b)--lookup_mime_type :: String -> Maybe String-lookup_mime_type = flip M.lookup mime_types
src/Hack/Contrib/Middleware/ShowExceptions.hs view
@@ -1,3 +1,4 @@+-- | Stolen from rack: catches all exceptions raised from the app it wraps. module Hack.Contrib.Middleware.ShowExceptions (show_exceptions) where  import Hack@@ -16,7 +17,7 @@ program :: String program = "ShowExceptions" -show_exceptions :: Maybe Stream -> Middleware+show_exceptions :: Maybe (String -> IO ()) -> Middleware show_exceptions stream app = \env -> do   let my_stream = stream.fromMaybe (env.hack_errors)   let log = simple_logger my_stream program
src/Hack/Contrib/Middleware/ShowStatus.hs view
@@ -1,5 +1,10 @@ {-# LANGUAGE QuasiQuotes #-} +-- | Stolen from rack:+--   catches all empty responses the app it wraps and replaces them with a site explaining the error. +--   Additional details can be put into hack.showstatus.detail.+--   and will be shown as HTML.  If such details exist, the error page+--   is always rendered, even if the reply was not empty. module Hack.Contrib.Middleware.ShowStatus (show_status) where  import Hack@@ -31,7 +36,7 @@       in       return $          response-          .set_body result+          .set_body (result.unescape_unicode_xml.u2b)           .set_content_type _TextHtml           .set_content_length size     @@ -40,7 +45,7 @@  template :: String -> String -> Env -> Response -> String template message detail env response = -  let h = escape_html in [$here|+  let h = escape_html > escape_unicode_xml in [$here|   <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
src/Hack/Contrib/Middleware/SimpleAccessLogger.hs view
@@ -12,7 +12,7 @@ program :: String program = "SimpleAccessLogger" -simple_access_logger :: Maybe Stream -> Middleware+simple_access_logger :: Maybe (String -> IO ()) -> Middleware simple_access_logger stream app = \env -> do   let my_stream = stream.fromMaybe (env.hack_errors)   let log = simple_logger my_stream program
src/Hack/Contrib/Middleware/SimpleRouter.hs view
@@ -1,5 +1,16 @@ {-# 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
src/Hack/Contrib/Middleware/Static.hs view
@@ -1,3 +1,8 @@+-- | Stolen from rack:+--   The Rack::Static middleware intercepts requests for static files+--   (javascript files, images, stylesheets, etc) based on the url prefixes+--   passed in the options, and serves them using a Rack::File object. This+--   allows a Rack stack to serve both static and dynamic content. module Hack.Contrib.Middleware.Static (static) where  import Hack@@ -13,7 +18,7 @@ static root urls app = \env -> do   let my_urls = if urls.null then ["/favicon.ico"] else urls -  let path = env.path_info .url2unicode+  let path = env.path_info .unescape_uri    let can_serve = my_urls.find ( `isPrefixOf` path ) .isJust
src/Hack/Contrib/Request.hs view
@@ -3,11 +3,14 @@ module Hack.Contrib.Request where  import Hack-import Prelude hiding ((.), (^), (>), lookup, (+))+import Hack.Contrib.Constants++import Prelude hiding ((.), (^), (>), (+)) import MPSUTF8 import Hack.Contrib.Utils-import List (lookup) import Data.Maybe+import Network.CGI.Protocol+import Network.CGI.Cookie  body :: Env -> String body = hack_input@@ -21,6 +24,54 @@ path :: Env -> String path env = env.script_name ++ env.path_info +content_type :: Env -> String+content_type env = env.http_ _ContentType .fromMaybe ""++media_type :: Env -> String+media_type env = env.content_type.split "\\s*[;,]\\s*" .first.lower++media_type_params :: Env -> [(String, String)]+media_type_params env+  | env.content_type.empty = []+  | otherwise = +      env+        .content_type+        .split "\\s*[;,]\\s"+        .drop 1+        .map (split "=" > take 2)+        .map tuple2+        .map_fst lower++content_charset :: Env -> String+content_charset env = env.media_type_params.lookup "charset" .fromMaybe ""++host :: Env -> String+host env = env.http_"HOST" .fromMaybe (env.server_name) .gsub ":\\d+\\z" ""++params :: Env -> [(String, String)]+params env+  | env.query_string.empty = []+  | otherwise =+      env+        .query_string+        .formDecode++inputs :: Env -> [(String, String)]+inputs env+  | env.media_type.is "application/x-www-form-urlencoded" =+      env+        .hack_input+        .formDecode+  | otherwise = [] -- multipart wait - -++referer :: Env -> String+referer = http_ _Referer > fromMaybe "/"++cookies :: Env -> [(String, String)]+cookies env = case env.http_ _Cookie of+  Nothing -> []+  Just s -> s.readCookies+ fullpath :: Env -> String fullpath env =    if env.query_string.empty @@ -28,13 +79,10 @@     else env.path ++ "?" ++ env.query_string  http_ :: String -> Env -> Maybe String-http_ s env = env.http.reverse.lookup s+http_ s env = env.http.get s  custom_ :: String -> Env -> Maybe String-custom_ s env = env.custom.reverse.lookup s--host :: Env -> String-host env = env.http_"HOST" .fromMaybe (env.server_name) .gsub ":\\d+\\z" ""+custom_ s env = env.custom.get s  url :: Env -> String url env =@@ -51,3 +99,23 @@           env.scheme.is "http" && env.port.is_not 80 )         then ":" ++ env.server_port.show         else ""+++--form_data_media_types :: [String]+--form_data_media_types = +--  [  ""+--  ,  "application/x-www-form-urlencoded"+--  ,  "multipart/form-data"+--  ]+--+--parseable_data_media_types :: [String]+--parseable_data_media_types = +--  [  "multipart/related"+--  ,  "multipart/mixed"+--  ]+--+--is_form_data :: Env -> Bool+--is_form_data = media_type > belongs_to form_data_media_types+--+--is_parseable_data :: Env -> Bool+--is_parseable_data = media_type > belongs_to parseable_data_media_types
src/Hack/Contrib/Response.hs view
@@ -3,25 +3,43 @@ module Hack.Contrib.Response where  import Hack+import Hack.Contrib.Utils import Hack.Contrib.Constants  import MPSUTF8 import Prelude hiding ((.), (^), (>), (+)) -import Data.Map (toList) import Data.Maybe  +redirect :: String -> Maybe Int -> Response -> Response+redirect target status_code = +    set_status (status_code.fromMaybe 302)+  > set_header _Location target++finish :: Response -> Response+finish r +  | r.status.belongs_to [204, 304]+      = r+          .delete_header _ContentType+          .set_body ""+  | otherwise = r+        + header :: String -> Response -> Maybe String-header s r = r.headers.reverse.lookup s+header s r = r.headers.get s  has_header :: String -> Response -> Bool has_header s r = r.header s .isJust  set_header :: String -> String -> Response -> Response set_header k v r = r -  { headers = (r.headers ++ [(k,v)] ) .to_h .toList }+  { headers = r.headers.put k v } +delete_header :: String -> Response -> Response+delete_header k r = r+  { headers = r.headers.reject (fst > is k) }+   set_content_type :: String -> Response -> Response set_content_type s r = r.set_header _ContentType s
src/Hack/Contrib/Utils.hs view
@@ -22,9 +22,14 @@ import System.Locale import System.FilePath ((</>)) import Control.Category (Category)+import Data.List (lookup) --- import Date.Time +-- hack input / output are all utf8 bytes+-- but sometimes we want to put unicode string directly+-- like when writing config and such+type UnicodeString = String+ (>) :: (Control.Category.Category cat) => cat a b -> cat b c -> cat a c (>) = (>>>) infixl 8 >@@ -40,12 +45,21 @@ empty_app :: Application empty_app = return def --- usage: app.use [content_type, cache]+-- | usage: app.use [content_type, cache] use :: [Middleware] -> Middleware use = reduce (<<<) +-- use the get / put helper to deal with headers+put :: String -> String -> [(String, String)] -> [(String, String)]+put k v xs = (k,v) : xs.reject (fst > is k)++get :: String -> [(String, String)] -> Maybe String+get = lookup++-- | note when calling bytesize, you are sure that the string+--   is in [char8] format anyway. so just call length bytesize :: String -> Int-bytesize = B.pack > B.length > from_i+bytesize = length -- B.pack > B.length > from_i  dummy_middleware :: Middleware dummy_middleware = id@@ -63,7 +77,12 @@       fixChar '"' = "&quot;"       fixChar x = [x] +escape_uri :: String -> String+escape_uri = escapeURIString isAllowedInURI +unescape_uri :: String -> String+unescape_uri = unEscapeString+ show_status_message :: Int -> Maybe String show_status_message x = status_code.M.lookup x @@ -71,7 +90,7 @@ httpdate x = x.format_time rfc822DateFormat where  url2unicode :: String -> String-url2unicode s = s.unEscapeString.b2u+url2unicode s = s.unescape_uri.b2u  just_lookup :: (Ord k) => k -> M.Map k a -> a just_lookup s xs = xs.M.lookup s .fromJust