hack-contrib 2009.4.30 → 2009.4.50

raw patch · 14 files changed

+106/−72 lines, 14 filesdep +pureMD5dep −base64-stringdep −templatedep −zlibdep ~mpsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: pureMD5

Dependencies removed: base64-string, template, zlib

Dependency ranges changed: mps

API changes (from Hackage documentation)

Files

• changelog.md +10/−0
• hack-contrib.cabal +6/−2
• src/Hack/Contrib/Constants.hs +6/−2
• src/Hack/Contrib/Middleware/BounceFavicon.hs +15/−0
• src/Hack/Contrib/Middleware/ContentType.hs +3/−3
• src/Hack/Contrib/Middleware/ETag.hs +28/−0
• src/Hack/Contrib/Middleware/File.hs +5/−5
• src/Hack/Contrib/Middleware/Head.hs +2/−2
• src/Hack/Contrib/Middleware/Hub.hs +1/−1
• src/Hack/Contrib/Middleware/Lambda.hs +0/−1
• src/Hack/Contrib/Middleware/Lucky.hs +0/−1
• src/Hack/Contrib/Middleware/NotFound.hs +17/−0
• src/Hack/Contrib/Middleware/ShowStatus.hs +1/−1
• src/Hack/Contrib/Utils.hs +12/−54

@@ -1,3 +1,13 @@+2009.4.50++### Feature++* more useful middlewares ported from rack-contrib++### Fix++* name change, show_status_message+ 2009.4.30 ---------- 

@@ -1,5 +1,5 @@ Name:                 hack-contrib-Version:              2009.4.30+Version:              2009.4.50 Build-type:           Simple Synopsis:             Hack contrib Description:@@ -15,7 +15,7 @@  library   ghc-options: -Wall-  build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, template, base64-string, zlib, ansi-wl-pprint, mps >= 2009.4.21, data-default >= 0.2, ansi-wl-pprint, unix, time, hack >= 2009.4.30+  build-depends: base, cgi, network, haskell98, old-locale, old-time, directory, filepath, containers, bytestring, ansi-wl-pprint, mps >= 2009.4.27, data-default >= 0.2, ansi-wl-pprint, unix, time, pureMD5, hack >= 2009.4.30   hs-source-dirs: src/   exposed-modules:                       Hack.Contrib.Utils@@ -37,6 +37,10 @@                     Hack.Contrib.Middleware.SimpleAccessLogger                     Hack.Contrib.Middleware.SimpleRouter                     Hack.Contrib.Middleware.Static+                    Hack.Contrib.Middleware.ETag+                    Hack.Contrib.Middleware.BounceFavicon+                    Hack.Contrib.Middleware.NotFound+                                                               

@@ -117,11 +117,15 @@   -- mime type-_TextPlain :: String-_TextHtml  :: String+_TextPlain                  :: String+_TextHtml                   :: String+_TextPlainUTF8              :: String+_TextHtmlUTF8               :: String  _TextPlain  = "text/plain" _TextHtml   = "text/html"+_TextPlainUTF8 = "text/plain; charset=UTF-8"+_TextHtmlUTF8 = "text/html; charset=UTF-8"   -- status code

@@ -0,0 +1,15 @@+module Hack.Contrib.Middleware.BounceFavicon (bounce_favicon) where++import Hack+import Hack.Contrib.Utils+import Hack.Contrib.Middleware.NotFound++import MPSUTF8+import Prelude hiding ((.), (^), (>), head)+++bounce_favicon :: Middleware+bounce_favicon app = \env -> do+  if env.path_info.is "/favicon.ico"+    then not_found dummy_app env+    else app env

@@ -12,6 +12,6 @@ content_type s app = \env -> do   response <- app env   -  case response.header _ContentType of-    Nothing -> response.set_header _ContentType s .return-    Just _ -> response .return+  return $ case response.header _ContentType of+    Nothing -> response.set_header _ContentType s+    Just _ -> response

@@ -0,0 +1,28 @@+module Hack.Contrib.Middleware.ETag (etag) where++import Hack+import Hack.Contrib.Utils+import Hack.Contrib.Response+import Hack.Contrib.Constants++import MPSUTF8+import Prelude hiding ((.), (^), (>))++import Data.Digest.Pure.MD5+import Data.ByteString.Lazy.Char8 as C+++etag :: Middleware+etag app = \env -> do+  r <- app env+  +  if r.has_header _ETag+    then r.return+    else r.set_header _ETag (r.tag) .return+  +  where +    tag = +          body+        > C.pack+        > md5+        > show

@@ -22,11 +22,11 @@      if ".." `isInfixOf` path      then forbidden-    else serve root path env+    else path.serve root  -serve :: Maybe String -> FilePath -> Env -> IO Response-serve root fname _ = do+serve :: Maybe String -> FilePath -> IO Response+serve root fname = do   cwd <- get_current_directory   let my_root = root.fromMaybe cwd   let path = my_root / makeRelative "/" fname@@ -45,8 +45,8 @@     where        serving path = do         content <- path.read_binary_file-        size <- file_size path ^ from_i-        mtime_str <- file_mtime path ^ httpdate+        size <- path.file_size ^ from_i+        mtime_str <- path.file_mtime ^ httpdate                  let default_content_type = "application/octet-stream"         let safe_lookup = lookup_mime_type > fromMaybe default_content_type

@@ -10,5 +10,5 @@ head app = \env -> do   response <- app env   if env.request_method.is HEAD -    then return $ response .set_body "" .set_content_length 0-    else return $ response+    then response .set_body "" .set_content_length 0 .return+    else response .return

@@ -1,6 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} --- the entire logging framework is stole from [innate](http://github.com/manveru/innate/tree/master)+-- the entire logging framework is stolen from [innate](http://github.com/manveru/innate/tree/master)   module Hack.Contrib.Middleware.Hub where

@@ -4,7 +4,6 @@  import Hack import Hack.Contrib.Response-import Hack.Contrib.Utils import Hack.Contrib.Constants  import MPSUTF8

@@ -4,7 +4,6 @@  import Hack import Hack.Contrib.Response-import Hack.Contrib.Utils import Hack.Contrib.Constants  import MPSUTF8

@@ -0,0 +1,17 @@+module Hack.Contrib.Middleware.NotFound (not_found) where++import Hack+import Hack.Contrib.Response+import Hack.Contrib.Constants++import MPSUTF8+import Prelude hiding ((.), (^), (>), (+))+import Data.Default+++not_found :: Middleware+not_found _ = \_ -> return $+  def+    .set_status 404+    .set_content_type _TextHtml+    .set_content_length 0

@@ -24,7 +24,7 @@     then        let            i       = response.status-          message = i.show_status_code .fromMaybe (i.show)+          message = i.show_status_message .fromMaybe (i.show)           detail  = env.custom_"hack.showstatus.detail" .fromMaybe message           result  = template message detail env response           size    = result.bytesize

@@ -13,25 +13,16 @@ import Data.Default  import Control.Arrow ((>>>), (<<<))-import Data.Map (lookup, Map)+import qualified Data.Map as M import Data.Time-import Text.Template import qualified Data.ByteString.Lazy.Char8 as B import Control.Monad (mplus, MonadPlus) import Data.Maybe import System.IO-import System.Posix.Files import System.Locale-import System.Directory-import Data.Time.Clock.POSIX import System.FilePath ((</>))-import Data.Char (ord) import Control.Category (Category) -import qualified Data.ByteString.Lazy.Char8 as B-import qualified Codec.Compression.GZip as GZip-import Codec.Binary.Base64.String as C- -- import Date.Time  (>) :: (Control.Category.Category cat) => cat a b -> cat b c -> cat a c@@ -65,58 +56,25 @@ escape_html :: String -> String escape_html = concatMap fixChar     where-      fixChar '<' = "<"-      fixChar '>' = ">"-      fixChar '&' = "&"-      fixChar '"' = "\""-      fixChar c | ord c < 0x80 = [c]-      fixChar c = "&#" ++ show (ord c) ++ ";"-+      fixChar '&' = "&amp;"+      fixChar '<' = "&lt;"+      fixChar '>' = "&gt;"+      fixChar '\'' = "&#39;"+      fixChar '"' = "&quot;"+      fixChar x = [x]  -show_status_code :: Int -> Maybe String-show_status_code x = status_code.lookup x---- MPS candidate--now :: IO UTCTime-now = getCurrentTime--format_time :: String -> UTCTime -> String-format_time = formatTime defaultTimeLocale--interpolate :: String -> [(String, String)] -> String-interpolate s params = B.unpack $ substitute (B.pack s) (context params)-  where -    context = map packPair > to_h-    packPair (x, y) = (B.pack x, B.pack y)--just_lookup :: (Ord k) => k -> Data.Map.Map k a -> a-just_lookup s xs = xs.lookup s .fromJust+show_status_message :: Int -> Maybe String+show_status_message x = status_code.M.lookup x  httpdate :: UTCTime -> String httpdate x = x.format_time rfc822DateFormat where -file_size :: String -> IO Integer-file_size path = withFile (path.u2b) ReadMode hFileSize--file_mtime :: String -> IO UTCTime-file_mtime path = getFileStatus (path.u2b) -                  ^ modificationTime ^ realToFrac ^ posixSecondsToUTCTime--read_binary_file :: String -> IO String-read_binary_file path = path.u2b.B.readFile ^ B.unpack--get_permissions :: String -> IO Permissions-get_permissions path = getPermissions (path.u2b) - url2unicode :: String -> String url2unicode s = s.unEscapeString.b2u -get_current_directory :: IO String-get_current_directory = getCurrentDirectory ^ b2u+just_lookup :: (Ord k) => k -> M.Map k a -> a+just_lookup s xs = xs.M.lookup s .fromJust -zip64, unzip64 :: String -> String-zip64 = B.pack > GZip.compress > B.unpack > C.encode-unzip64 = C.decode > B.pack > GZip.decompress > B.unpack+-- MPS candidate