packages feed

hack2-contrib (empty) → 2010.9.28

raw patch · 30 files changed

+1295/−0 lines, 30 filesdep +airdep +air-extradep +ansi-wl-pprintsetup-changed

Dependencies added: air, air-extra, ansi-wl-pprint, base, bytestring, cgi, containers, data-default, directory, filepath, hack2, haskell98, network, old-locale, old-time, time, utf8-string

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2011, Jinjing Wang++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jinjing Wang nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ changelog.md view
+ hack2-contrib.cabal view
@@ -0,0 +1,69 @@+Name:                 hack2-contrib+Version:              2010.9.28+Build-type:           Simple+Synopsis:             Hack2 contrib+Description:          Common middlewares and utilities that helps working with Hack2+License:              BSD3+License-file:         LICENSE+Author:               Jinjing Wang+Maintainer:           Jinjing Wang <nfjinjing@gmail.com>+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Web+homepage:             http://github.com/nfjinjing/hack2-contrib+data-files:           readme.md, changelog.md++library+  ghc-options: -Wall+  build-depends: +                    base >=4 && < 5+                  , cgi+                  , network+                  , haskell98+                  , old-locale+                  , old-time+                  , directory+                  , filepath+                  , containers+                  , bytestring+                  , data-default >= 0.2+                  , time+                  , air >= 2011.6.11+                  , air-extra >= 2011.6.11+                  , hack2 >= 2009.10.30+                  , utf8-string+                  , ansi-wl-pprint+                  +  hs-source-dirs: src/+  exposed-modules:  +                    +                    Hack2.Contrib.Constants+                    Hack2.Contrib.Middleware.BounceFavicon+                    Hack2.Contrib.Middleware.Censor+                    Hack2.Contrib.Middleware.Config+                    Hack2.Contrib.Middleware.ContentLength+                    Hack2.Contrib.Middleware.ContentType+                    Hack2.Contrib.Middleware.Debug+                    -- Hack2.Contrib.Middleware.ETag+                    Hack2.Contrib.Middleware.File+                    Hack2.Contrib.Middleware.Head+                    Hack2.Contrib.Middleware.Inspect+                    Hack2.Contrib.Middleware.NotFound+                    Hack2.Contrib.Middleware.RegexpRouter+                    Hack2.Contrib.Middleware.ShowExceptions+                    Hack2.Contrib.Middleware.SimpleAccessLogger+                    Hack2.Contrib.Middleware.Hub+                    Hack2.Contrib.Middleware.Static+                    Hack2.Contrib.Middleware.URLMap+                    Hack2.Contrib.Middleware.IOConfig+                    Hack2.Contrib.Middleware.UserMime+                    Hack2.Contrib.Middleware.UTF8Body+                    Hack2.Contrib.Middleware.Cascade+                    Hack2.Contrib.Mime+                    Hack2.Contrib.Request+                    Hack2.Contrib.Response+                    Hack2.Contrib.Utils++++
+ readme.md view
@@ -0,0 +1,1 @@+Middleware and Helper for Hack2
+ src/Hack2/Contrib/Constants.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE OverloadedStrings #-}+++module Hack2.Contrib.Constants where++import Air.Light+import Prelude hiding ((.))+import Data.Map+import Data.ByteString.Lazy.Char8 (ByteString)++status_with_no_entity_body :: [Int]+status_with_no_entity_body = [100 .. 199] ++ [204, 304]+++-- header constants+_CacheControl                   :: ByteString+_Connection                     :: ByteString+_Date                           :: ByteString+_Pragma                         :: ByteString+_TransferEncoding               :: ByteString+_Upgrade                        :: ByteString+_Via                            :: ByteString+_Accept                         :: ByteString+_AcceptCharset                  :: ByteString+_AcceptEncoding                 :: ByteString+_AcceptLanguage                 :: ByteString+_Authorization                  :: ByteString+_Cookie                         :: ByteString+_Expect                         :: ByteString+_From                           :: ByteString+_Host                           :: ByteString+_IfModifiedSince                :: ByteString+_IfMatch                        :: ByteString+_IfNoneMatch                    :: ByteString+_IfRange                        :: ByteString+_IfUnmodifiedSince              :: ByteString+_MaxForwards                    :: ByteString+_ProxyAuthorization             :: ByteString+_Range                          :: ByteString+_Referer                        :: ByteString+_UserAgent                      :: ByteString+_Age                            :: ByteString+_Location                       :: ByteString+_ProxyAuthenticate              :: ByteString+_Public                         :: ByteString+_RetryAfter                     :: ByteString+_Server                         :: ByteString+_SetCookie                      :: ByteString+_TE                             :: ByteString+_Trailer                        :: ByteString+_Vary                           :: ByteString+_Warning                        :: ByteString+_WWWAuthenticate                :: ByteString+_Allow                          :: ByteString+_ContentBase                    :: ByteString+_ContentEncoding                :: ByteString+_ContentLanguage                :: ByteString+_ContentLength                  :: ByteString+_ContentLocation                :: ByteString+_ContentMD5                     :: ByteString+_ContentRange                   :: ByteString+_ContentType                    :: ByteString+_ETag                           :: ByteString+_Expires                        :: ByteString+_LastModified                   :: ByteString+_ContentTransferEncoding        :: ByteString++++_CacheControl                   =  "Cache-Control"        +_Connection                     =  "Connection"           +_Date                           =  "Date"                 +_Pragma                         =  "Pragma"               +_TransferEncoding               =  "Transfer-Encoding"    +_Upgrade                        =  "Upgrade"              +_Via                            =  "Via"                  +_Accept                         =  "Accept"               +_AcceptCharset                  =  "Accept-Charset"       +_AcceptEncoding                 =  "Accept-Encoding"      +_AcceptLanguage                 =  "Accept-Language"      +_Authorization                  =  "Authorization"        +_Cookie                         =  "Cookie"               +_Expect                         =  "Expect"               +_From                           =  "From"                 +_Host                           =  "Host"                 +_IfModifiedSince                =  "If-Modified-Since"    +_IfMatch                        =  "If-Match"             +_IfNoneMatch                    =  "If-None-Match"        +_IfRange                        =  "If-Range"             +_IfUnmodifiedSince              =  "If-Unmodified-Since"  +_MaxForwards                    =  "Max-Forwards"         +_ProxyAuthorization             =  "Proxy-Authorization"  +_Range                          =  "Range"                +_Referer                        =  "Referer"              +_UserAgent                      =  "User-Agent"           +_Age                            =  "Age"                  +_Location                       =  "Location"             +_ProxyAuthenticate              =  "Proxy-Authenticate"   +_Public                         =  "Public"               +_RetryAfter                     =  "Retry-After"          +_Server                         =  "Server"               +_SetCookie                      =  "Set-Cookie"           +_TE                             =  "TE"                   +_Trailer                        =  "Trailer"              +_Vary                           =  "Vary"                 +_Warning                        =  "Warning"              +_WWWAuthenticate                =  "WWW-Authenticate"     +_Allow                          =  "Allow"                +_ContentBase                    =  "Content-Base"         +_ContentEncoding                =  "Content-Encoding"     +_ContentLanguage                =  "Content-Language"     +_ContentLength                  =  "Content-Length"       +_ContentLocation                =  "Content-Location"     +_ContentMD5                     =  "Content-MD5"          +_ContentRange                   =  "Content-Range"        +_ContentType                    =  "Content-Type"         +_ETag                           =  "ETag"                 +_Expires                        =  "Expires"              +_LastModified                   =  "Last-Modified"        +_ContentTransferEncoding        =  "Content-Transfer-Encodeing"+++-- mime type+_TextPlain                  :: ByteString+_TextHtml                   :: ByteString+_TextPlainUTF8              :: ByteString+_TextHtmlUTF8               :: ByteString++_TextPlain     = "text/plain"+_TextHtml      = "text/html"+_TextPlainUTF8 = "text/plain; charset=UTF-8"+_TextHtmlUTF8  = "text/html; charset=UTF-8"+++-- status code+status_code :: Map Int ByteString+status_code =+  [  x       100          "Continue"+  ,  x       101          "Switching Protocols"+  ,  x       200          "OK"+  ,  x       201          "Created"+  ,  x       202          "Accepted"+  ,  x       203          "Non-Authoritative Information"+  ,  x       204          "No Content"+  ,  x       205          "Reset Content"+  ,  x       206          "Partial Content"+  ,  x       300          "Multiple Choices"+  ,  x       301          "Moved Permanently"+  ,  x       302          "Found"+  ,  x       303          "See Other"+  ,  x       304          "Not Modified"+  ,  x       305          "Use Proxy"+  ,  x       307          "Temporary Redirect"+  ,  x       400          "Bad Request"+  ,  x       401          "Unauthorized"+  ,  x       402          "Payment Required"+  ,  x       403          "Forbidden"+  ,  x       404          "Not Found"+  ,  x       405          "Method Not Allowed"+  ,  x       406          "Not Acceptable"+  ,  x       407          "Proxy Authentication Required"+  ,  x       408          "Request Timeout"+  ,  x       409          "Conflict"+  ,  x       410          "Gone"+  ,  x       411          "Length Required"+  ,  x       412          "Precondition Failed"+  ,  x       413          "Request Entity Too Large"+  ,  x       414          "Request-URI Too Large"+  ,  x       415          "Unsupported Media Type"+  ,  x       416          "Requested Range Not Satisfiable"+  ,  x       417          "Expectation Failed"+  ,  x       500          "Internal Server Error"+  ,  x       501          "Not Implemented"+  ,  x       502          "Bad Gateway"+  ,  x       503          "Service Unavailable"+  ,  x       504          "Gateway Timeout"+  ,  x       505          "HTTP Version Not Supported"+  ] .to_h+  where x a b = (a, b)
+ src/Hack2/Contrib/Middleware/BounceFavicon.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Stolen from rack-contrib: Bounce those annoying favicon.ico requests++module Hack2.Contrib.Middleware.BounceFavicon (bounce_favicon) where++import Hack2+import Hack2.Contrib.Middleware.NotFound+import Hack2.Contrib.Utils+import Air.Light+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
+ src/Hack2/Contrib/Middleware/Cascade.hs view
@@ -0,0 +1,16 @@+module Hack2.Contrib.Middleware.Cascade (cascade) where++import Prelude ()+import Air.Env+import Hack2+import Data.Default++cascade :: [Application] -> Application+cascade [] = const - return def { status = 404 }+cascade (x:xs) = \env -> do+  r <- x env+  if r.status == 404+    then+      cascade xs env+    else+      return r
+ src/Hack2/Contrib/Middleware/Censor.hs view
@@ -0,0 +1,8 @@+-- Censor it !++module Hack2.Contrib.Middleware.Censor (censor) where++import Hack2++censor :: (Response -> IO Response) -> Middleware+censor alter app = \env -> app env >>= alter
+ src/Hack2/Contrib/Middleware/Config.hs view
@@ -0,0 +1,9 @@+-- | Stolen from rack-contrib: modifies the environment using the block given +--   during initialization.++module Hack2.Contrib.Middleware.Config (config) where++import Hack2++config :: (Env -> Env) -> Middleware+config alter app = \env -> app (alter env)
+ src/Hack2/Contrib/Middleware/ContentLength.hs view
@@ -0,0 +1,28 @@+-- | Stolen from rack: Sets the Content-Length header on responses with +--   fixed-length bodies.++module Hack2.Contrib.Middleware.ContentLength (content_length) where++import Hack2+import Hack2.Contrib.Constants+import Hack2.Contrib.Response+import Hack2.Contrib.Utils+import Air.Light+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_bytestring) .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/Hack2/Contrib/Middleware/ContentType.hs view
@@ -0,0 +1,20 @@+-- | Stolen from rack: Sets the Content-Type header on responses which don't +--   have one.++module Hack2.Contrib.Middleware.ContentType (content_type) where++import Hack2+import Hack2.Contrib.Constants+import Hack2.Contrib.Response+import Air.Light+import Prelude hiding ((.), (^), (>), (-))+import Data.ByteString.Lazy.Char8 (ByteString)+++content_type :: ByteString -> Middleware+content_type s app = \env -> do+  response <- app env+  +  return - case response.header _ContentType of+    Nothing -> response.set_header _ContentType s+    Just _ -> response
+ src/Hack2/Contrib/Middleware/Debug.hs view
@@ -0,0 +1,11 @@+-- | print the env and response in the console++module Hack2.Contrib.Middleware.Debug (debug) where++import Hack2++debug :: (Env -> Response -> IO ()) -> Middleware+debug f app = \env -> do+  r <- app env+  f env r+  return r
+ src/Hack2/Contrib/Middleware/File.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+++-- | Stolen from rack: serves files below the +root+ given, according to the +--   path info of the Rack request.++module Hack2.Contrib.Middleware.File (file) where++import Data.Default+import Data.List (isInfixOf)+import Data.Maybe+import Hack2+import Hack2.Contrib.Constants+import Hack2.Contrib.Mime+import Hack2.Contrib.Response+import Hack2.Contrib.Utils+import Air.Env+import Air.Extra+import Prelude ()+import System.Directory+import System.FilePath+import qualified Data.ByteString.Lazy.Char8 as B+import Data.ByteString.Lazy.Char8 (ByteString)+++file :: Maybe ByteString -> Middleware+file root _ = \env -> do+  let path = env.path_info .as_string unescape_uri+  +  if B.unpack ".." `isInfixOf` B.unpack path+    then forbidden+    else serve root path+++serve :: Maybe ByteString -> ByteString -> IO Response+serve root fname = do+  cwd <- getCurrentDirectory+  let my_root = ( root ^ B.unpack ).fromMaybe cwd+  let path = my_root / makeRelative "/" (fname.B.unpack)+  +  exist <- doesFileExist path++  if not exist+      then path.B.pack.not_found+      else+        do +          can_read <- path.getPermissions ^ readable+          if not can_read+            then path.B.pack.no_permission+            else path.serving+    +    where +      serving path = do+        content <- path.B.readFile+        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+        let content_type = path.takeExtension.B.pack.safe_lookup+        +        return - +          def +            .set_body content+            .set_content_length size+            .set_content_type content_type+            .set_last_modified (B.pack mtime_str)+            .set_status 200++no_permission :: ByteString -> IO Response+no_permission path = return $+  def+    .set_status 404+    .set_content_type _TextPlain+    .set_content_length (msg.B.length)+    .set_body msg++  where msg = "No permission: " + path + "\n"++not_found :: ByteString -> IO Response+not_found path = return $+  def+    .set_status 404+    .set_content_type _TextPlain+    .set_content_length (msg.B.length)+    .set_body msg+  +  where msg = "File not found: " + path + "\n"++forbidden :: IO Response+forbidden = return - +  def+    .set_status 403+    .set_content_type _TextPlain+    .set_content_length (msg.B.length)+    .set_body msg++  where msg = "Forbidden\n"+  
+ src/Hack2/Contrib/Middleware/Head.hs view
@@ -0,0 +1,16 @@+module Hack2.Contrib.Middleware.Head (head) where++import Hack2+import Hack2.Contrib.Response+import Hack2.Contrib.Utils+import Air.Light+import Prelude hiding ((.), (^), (>), head)+import qualified Data.ByteString.Lazy.Char8 as B+++head :: Middleware+head app = \env -> do+  response <- app env+  if env.request_method.is HEAD +    then response .set_body B.empty .set_content_length 0 .return+    else response .return
+ src/Hack2/Contrib/Middleware/Hub.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE CPP #-}++-- the entire logging module is stolen from+-- [innate](http://github.com/manveru/innate/tree/master)++module Hack2.Contrib.Middleware.Hub where++import Data.Maybe+import Data.Time+import Air+import Air.Extra+import Prelude hiding ((.), (^), (>), (+), (-))+import Text.PrettyPrint.ANSI.Leijen+import Text.Printf++#ifdef UNIX+import System.Posix.Process (getProcessID)+#endif++data Severity = +     Debug+  |  Info+  |  Warn+  |  Error+  |  Fatal+  |  Unknown+  deriving (Show, Eq)++hint :: Severity -> String+hint = show > slice 0 1++type Formatter = Severity -> UTCTime -> Int -> String -> String -> String++type Logger = String -> Severity -> IO ()++hub :: (String -> IO ()) -> Formatter -> String -> Logger+hub stream formatter program = \message severity -> +  do+    time <- now+    pid <- get_pid+    stream - formatter severity time pid program message++get_pid :: IO Int+get_pid =+#ifdef UNIX+  getProcessID ^ from_i+#else+  return (-1)+#endif++simple_logger :: (String -> IO ()) -> String -> Logger+simple_logger = flip hub simple_formatter++simple_formatter :: Formatter+simple_formatter severity time pid program message =+  printf line_format h t pid l program s+  +  where+    line_format = "%s [%s $%d] %5s | %-25s: %s\n"+    h           = severity.hint+    time_format = "%Y-%m-%d %H:%M:%S"+    t           = time.format_time time_format+    l           = severity.show.upper+    s           = colorize severity message+++colorize :: Severity -> String -> String+colorize severity message = color severity (message.text) .show+  where+    level_color = +      [ (   Debug           , blue    )+      , (   Info            , white   )+      , (   Warn            , yellow  )+      , (   Error           , red     )+      , (   Fatal           , red     )+      , (   Unknown         , green   )+      ]+    +    color severity' = level_color.lookup severity' .fromMaybe green+
+ src/Hack2/Contrib/Middleware/IOConfig.hs view
@@ -0,0 +1,6 @@+module Hack2.Contrib.Middleware.IOConfig (ioconfig) where++import Hack2++ioconfig :: (Env -> IO Env) -> Middleware+ioconfig before app = \env -> before env >>= app
+ src/Hack2/Contrib/Middleware/Inspect.hs view
@@ -0,0 +1,10 @@+-- | print the env and response in the console++module Hack2.Contrib.Middleware.Inspect (inspect) where++import Hack2+import Air.Light+import Prelude hiding ((.), (^))++inspect :: Middleware+inspect app = \env -> env.trace'.app ^ trace'
+ src/Hack2/Contrib/Middleware/NotFound.hs view
@@ -0,0 +1,17 @@+module Hack2.Contrib.Middleware.NotFound (not_found) where++import Hack2+import Hack2.Contrib.Response+import Hack2.Contrib.Constants++import Air.Light+import Prelude hiding ((.), (^), (>), (+))+import Data.Default+++not_found :: Middleware+not_found _ = \_ -> return $+  def+    .set_status 404+    .set_content_type _TextHtml+    .set_content_length 0
+ src/Hack2/Contrib/Middleware/RegexpRouter.hs view
@@ -0,0 +1,23 @@+-- | matching a list of regexp agains a path_info, if matched, consponding app+--   is used, otherwise, pass the env down to lower middleware++module Hack2.Contrib.Middleware.RegexpRouter (regexp_router) where++import Data.Maybe+import Hack2+import Hack2.Contrib.Utils+import List (find)+import Air+import Air.Extra+import Prelude hiding ((.), (^), (>), (-))+import qualified Data.ByteString.Lazy.Char8 as B++type RoutePath = (String, Application)++regexp_router :: [RoutePath] -> Middleware+regexp_router h app = \env ->+  let path = env.path_info.B.unpack+  in+  case h.find (fst > flip match path > isJust) of+    Nothing -> app env+    Just (_, found_app) -> found_app env
+ src/Hack2/Contrib/Middleware/ShowExceptions.hs view
@@ -0,0 +1,32 @@+-- | Stolen from rack: catches all exceptions raised from the app it wraps.++module Hack2.Contrib.Middleware.ShowExceptions (show_exceptions) where+++import Data.Default+import Data.Maybe+import Hack2+import Hack2.Contrib.Middleware.Hub+import Hack2.Contrib.Utils+import Air.Light+import Prelude hiding ((.), (^), (>), (-), log)+import System.IO  +import System.IO.Error+import qualified Data.ByteString.Lazy.Char8 as B++program :: String+program = "ShowExceptions"++show_exceptions :: Maybe HackErrors -> Middleware+show_exceptions stream app = \env -> do+  let my_stream = unHackErrors - stream.fromMaybe (env.hack_errors)+  let log = simple_logger (\x -> my_stream (B.pack x)) program+  +  app env `catch` (handler log)++  where+    handler :: Logger -> IOError -> IO Response+    handler log e = do+      let message = e.show+      Error. log message+      return - def { status = 500, body = B.pack message }
+ src/Hack2/Contrib/Middleware/SimpleAccessLogger.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+++module Hack2.Contrib.Middleware.SimpleAccessLogger (simple_access_logger) where++import Data.Maybe+import Hack2+import Hack2.Contrib.Request hiding (referer)+import Hack2.Contrib.Constants+import Hack2.Contrib.Utils+import Air.Extra (simple_time_format, purify)+import Air.Env+import Data.Maybe+import Prelude ()+import qualified Data.ByteString.Lazy.Char8 as B+import System.IO+import Control.Concurrent++sync_lock :: MVar ()+sync_lock = purify - newMVar ()++jailed :: IO a -> IO a+jailed io = do+  withMVar sync_lock (const io)+  +simple_access_logger :: Maybe (B.ByteString -> IO ()) -> Middleware+simple_access_logger stream app = \env -> do+  r <- app env+  time <- now ^ format_time simple_time_format ^ B.pack+  let+      puts        = stream.fromMaybe default_stream+      +      method      = env.request_method.show_bytestring+      http_status = env.hack_url_scheme.show_bytestring+      access_path = env.fullpath.as_string unescape_uri+      +      fields =+        [ env.remote_host+        , "-"+        , "[" + time + "]"+        , "\"" + method + " " + access_path + " " + http_status + "\""+        , r.status.show_bytestring+        , r.headers.get _ContentLength .fromMaybe "-"+        ]+  +  puts - fields.B.intercalate " "+  return r+  +  where+    default_stream x = jailed - x.B.putStrLn >> hFlush stdout
+ src/Hack2/Contrib/Middleware/Static.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++-- | 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 Hack2.Contrib.Middleware.Static (static) where++import Data.Maybe+import Hack2+import Hack2.Contrib.Middleware.File (file)+import Hack2.Contrib.Utils+import List (find, isPrefixOf)+import Air.Light+import Prelude hiding ((.), (^), (>), (+))+import qualified Data.ByteString.Lazy.Char8 as B+import Data.ByteString.Lazy.Char8 (ByteString)++static :: Maybe ByteString -> [ByteString] -> Middleware+static root urls app = \env -> do+  let my_urls = if urls.null then ["/favicon.ico"] else urls++  let path = env.path_info .as_string unescape_uri++  let can_serve = my_urls.find ( `B.isPrefixOf` path ) .isJust+  +  if can_serve+    then file root app env+    else app env
+ src/Hack2/Contrib/Middleware/URLMap.hs view
@@ -0,0 +1,36 @@+-- | 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 Hack2.Contrib.Middleware.URLMap (url_map) where++import Hack2+import Hack2.Contrib.Utils+import List (find, isPrefixOf)+import Air.Env+import Prelude ()+import qualified Data.ByteString.Lazy.Char8 as B+++type RoutePath = (B.ByteString, 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.B.drop (location.B.length)+        }+  in+  case h.find (fst > (`B.isPrefixOf` path) ) of+    Nothing -> app env+    Just (location, app') -> app' (mod_env location)
+ src/Hack2/Contrib/Middleware/UTF8Body.hs view
@@ -0,0 +1,14 @@+module Hack2.Contrib.Middleware.UTF8Body (utf8_body) where++import Air.Env+import Prelude ()+import Air.Heavy+import Hack2+import Data.ByteString.Lazy.Char8 (unpack)+import Data.ByteString.Lazy.UTF8 (fromString)++utf8_body :: Middleware+utf8_body app = \env -> do+  r <- app env+  let raw_body = r.body+  return r {body = raw_body.unpack.unescape_xml.fromString}
+ src/Hack2/Contrib/Middleware/UserMime.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}++module Hack2.Contrib.Middleware.UserMime (user_mime) where++import Data.List (find)+import Hack2+import Hack2.Contrib.Response+import Hack2.Contrib.Utils+import Air.Light+import Prelude hiding ((.), (-))+import qualified Data.ByteString.Lazy.Char8 as B+import Data.ByteString.Lazy.Char8 (ByteString)++user_mime :: [(ByteString, ByteString)] -> Middleware+user_mime h app env = do+  r <- app env+  case h.only_fst.find mime >>= flip lookup h of+    Nothing -> return r+    Just v -> return - r.set_content_type v+  where mime x = env.path_info.B.unpack.ends_with ('.' : x.B.unpack)
+ src/Hack2/Contrib/Mime.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE OverloadedStrings #-}+++module Hack2.Contrib.Mime where++import Air.Light+import Prelude hiding ((.))+import qualified Data.Map as M+import Data.ByteString.Lazy.Char8 (ByteString)++lookup_mime_type :: ByteString -> Maybe ByteString+lookup_mime_type = flip M.lookup mime_types++mime_types :: M.Map ByteString ByteString+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     ".oga"          "audio/ogg"+   ,  x     ".ogg"          "audio/ogg"+   ,  x     ".ogv"          "video/ogg"+   ,  x     ".ogx"          "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     ".spx"          "audio/ogg"+   ,  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)
+ src/Hack2/Contrib/Request.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}++module Hack2.Contrib.Request where++import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Maybe+import Hack2 hiding (body)+import Hack2.Contrib.Constants+import Hack2.Contrib.Utils+import Air.Env+import Air.Extra+import Network.CGI.Cookie+import Network.CGI.Protocol+import Prelude ()+import qualified Data.ByteString.Lazy.Char8 as B++body :: Env -> ByteString+body = hack_input++scheme :: Env -> ByteString+scheme = hack_url_scheme > show > lower > B.pack++port :: Env -> Int+port = server_port++path :: Env -> ByteString+path env = env.script_name + env.path_info++content_type :: Env -> ByteString+content_type env = env.httpHeaders.get _ContentType .fromMaybe ""++media_type :: Env -> ByteString+media_type env = case env.content_type.B.unpack.split "\\s*[;,]\\s*" of+  [] -> ""+  x:_ -> x.lower.B.pack++media_type_params :: Env -> [(ByteString, ByteString)]+media_type_params env+  | env.content_type.B.null = []+  | otherwise = +      env+        .content_type+        .B.unpack+        .split "\\s*[;,]\\s"+        .drop 1+        .map (split "=")+        .select (length > is 2)+        .map tuple2+        .map_fst (lower > B.pack)+        .map_snd (B.pack)++content_charset :: Env -> ByteString+content_charset env = env.media_type_params.lookup "charset" .fromMaybe ""++host :: Env -> ByteString+host env = env.httpHeaders.get _Host .fromMaybe (env.server_name) .B.unpack.gsub ":\\d+\\z" "" .B.pack++params :: Env -> [(ByteString, ByteString)]+params env =+  if env.query_string.B.null+    then []+    else env.query_string.B.unpack.formDecode.map_both B.pack++inputs :: Env -> [(ByteString, ByteString)]+inputs env = +  env+    .httpHeaders+    .map_fst (B.unpack > upper > gsub "-" "_") -- cgi env use all cap letters+    .map_snd B.unpack+    .(("REQUEST_METHOD", env.request_method.show) : ) -- for cgi request+    .flip decodeInput (env.body)+    .fst+    .concatMap to_headers+  where+    to_headers (k, input) = case input.inputFilename of+      Nothing -> [(k.B.pack, input.inputValue)]+      Just name -> +        [  (k.B.pack, input.inputValue)+        ,  ("hack2_input_file_name_" + k.B.pack, name.B.pack)+        ]++referer :: Env -> ByteString+referer = httpHeaders > get _Referer > fromMaybe "/"++cookies :: Env -> [(ByteString, ByteString)]+cookies env = case env.httpHeaders.get _Cookie of+  Nothing -> []+  Just s -> s.B.unpack.readCookies .map_both B.pack++fullpath :: Env -> ByteString+fullpath env = +  if env.query_string.B.null +    then env.path +    else env.path + "?" + env.query_string++set_http_header :: ByteString -> ByteString -> Env -> Env+set_http_header k v env = env {httpHeaders = env.httpHeaders.put k v}++set_hack_header :: ByteString -> ByteString -> Env -> Env+set_hack_header k v env = env {hackHeaders = env.hackHeaders.put k v}++url :: Env -> ByteString+url env =+  [  env.scheme+  ,  "://"+  ,  env.host+  ,  port_string+  ,  env.fullpath+  ]+  .B.concat+  where+    port_string = +      if (env.scheme.is "https" && env.port.is_not 443 || +          env.scheme.is "http" && env.port.is_not 80 )+        then ":" + env.server_port.show_bytestring+        else ""+++remote_host :: Env -> ByteString+remote_host env = +  ( env.hackHeaders + env.httpHeaders ) .lookup "RemoteHost" .fromMaybe ""
+ src/Hack2/Contrib/Response.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE QuasiQuotes #-}++module Hack2.Contrib.Response where++import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Maybe+import Hack2+import Hack2.Contrib.Constants+import Hack2.Contrib.Utils+import Air.Env+import Prelude hiding ((.), (^), (>), (+))+import qualified Data.ByteString.Lazy.Char8 as B+++redirect :: ByteString -> Maybe Int -> Response -> Response+redirect target code = +    set_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 B.empty+  | otherwise = r+++header :: ByteString -> Response -> Maybe ByteString+header s r = r.headers.get s++has_header :: ByteString -> Response -> Bool+has_header s r = r.header s .isJust++set_header :: ByteString -> ByteString -> Response -> Response+set_header k v r = r { headers = r.headers.put k v }++delete_header :: ByteString -> Response -> Response+delete_header k r = r { headers = r.headers.reject (fst > is k) }+  +set_content_type :: ByteString -> Response -> Response+set_content_type s r = r.set_header _ContentType s++set_content_length :: (Integral a) => a -> Response -> Response+set_content_length i r = r.set_header _ContentLength (i.show_bytestring)++set_body :: ByteString -> Response -> Response+set_body s r = r { body = s }++set_status :: Int -> Response -> Response+set_status i r = r { status = i }++set_last_modified :: ByteString -> Response -> Response+set_last_modified s r = r.set_header _LastModified s
+ src/Hack2/Contrib/Utils.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Hack2.Contrib.Utils where++import Control.Arrow ((<<<))+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Default+import Data.List (lookup)+import Data.Time+import Hack2+import Hack2.Contrib.Constants+import Air.Light+import Network.URI hiding (path)+import Prelude hiding ((.), (^), (>), lookup, (+), (/), (-))+import System.Locale (defaultTimeLocale)+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.Map as M++empty_app :: Application+empty_app = return def++-- | usage: app.use [content_type, cache]+use :: [Middleware] -> Middleware+use = reduce (<<<)++-- use the get / put helper to deal with headers+put :: (Eq a) => a -> b -> [(a, b)] -> [(a, b)]+put k v xs = (k,v) : xs.reject (fst > is k)++get :: (Eq a) => a -> [(a, b)] -> Maybe b+get = lookup++bytesize :: ByteString -> Int+bytesize = B.length > from_i++show_bytestring :: (Show a) => a -> ByteString+show_bytestring = show > B.pack++map_both :: (a -> b) -> [(a,a)] -> [(b,b)]+map_both f = map_fst f > map_snd f++as_string :: (String -> String) -> ByteString -> ByteString+as_string f x = x.B.unpack.f.B.pack++dummy_middleware :: Middleware+dummy_middleware = id++dummy_app :: Application+dummy_app _ = return - def { status = 500 }++escape_html :: String -> String+escape_html = concatMap fixChar+  where+    fixChar '&'   = "&amp;"+    fixChar '<'  = "&lt;"+    fixChar '>'  = "&gt;"+    fixChar '\'' = "&#39;"+    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 ByteString+show_status_message x = status_code.M.lookup x++now :: IO UTCTime+now = getCurrentTime++httpdate :: UTCTime -> String+httpdate x = x.format_time "%a, %d %b %Y %X GMT"+++format_time :: String -> UTCTime -> String+format_time = formatTime defaultTimeLocale++request_method    :: Env -> RequestMethod+script_name       :: Env -> ByteString+path_info         :: Env -> ByteString+query_string      :: Env -> ByteString+server_name       :: Env -> ByteString+server_port       :: Env -> Int+hack_version      :: Env -> (Int, Int, Int)+hack_url_scheme   :: Env -> HackUrlScheme+hack_input        :: Env -> ByteString+hack_errors       :: Env -> HackErrors+hack_headers       :: Env -> [(ByteString, ByteString)]++request_method  = requestMethod+script_name     = scriptName+path_info       = pathInfo+query_string    = queryString+server_name     = serverName+server_port     = serverPort+hack_version    = hackVersion+hack_url_scheme = hackUrlScheme+hack_input      = hackInput+hack_errors     = hackErrors+hack_headers    = hackHeaders+