Put middlewares to work.

portnov [2009-07-11 09:47:55]
Put middlewares to work.
Filename
Blog/Settings.hs
Framework/Http/HTTPServer.hs
Framework/Http/Middlewares.hs
diff --git a/Blog/Settings.hs b/Blog/Settings.hs
index 6633a5a..158636f 100644
--- a/Blog/Settings.hs
+++ b/Blog/Settings.hs
@@ -21,3 +21,6 @@ formProcessors = [simple]

 simple :: Form -> Form
 simple = id
+
+requestMiddlewares = []
+responseMiddlewares = []
diff --git a/Framework/Http/HTTPServer.hs b/Framework/Http/HTTPServer.hs
index ff57e94..16b709d 100644
--- a/Framework/Http/HTTPServer.hs
+++ b/Framework/Http/HTTPServer.hs
@@ -69,11 +69,12 @@ serveStatic' ps rq resource =
 -- | This function is called on each HTTP request
 httpWorker :: StaticConfig -> URLConf -> HttpRequest -> IO HttpResponse
 httpWorker hap conf req@(Request {rqURI = URI {uriPath}}) = do
-    let s = unEscapeString $ rqBody req
+    req' <- requestMiddlewares req
+    let s = unEscapeString $ rqBody req'
 --     putStrLn $ "Request body: "++show s
 --     putStrLn $ "deUTF:"++(decodeString s)
 --     putStrLn $ "Serving "++uriPath
-    resp <- runURLConf hap req (tail uriPath) conf
+    resp <- runURLConf hap req' (tail uriPath) conf
     responseMiddlewares resp

 defaultURLConf :: URLConf
diff --git a/Framework/Http/Middlewares.hs b/Framework/Http/Middlewares.hs
index 4a47acc..cc00fc1 100644
--- a/Framework/Http/Middlewares.hs
+++ b/Framework/Http/Middlewares.hs
@@ -2,18 +2,26 @@
 module Framework.Http.Middlewares
     (RequestMiddleware,
      ResponseMiddleware,
+     requestMiddlewares,
      responseMiddlewares) where

 import Network.HTTP
 -- import Framework.Utils
 import Framework.Types
+import qualified Settings (requestMiddlewares, responseMiddlewares)

 type RequestMiddleware = HttpRequest -> IO HttpRequest
 type ResponseMiddleware = HttpResponse -> IO HttpResponse

-addEncoding enc resp =
+addEncoding enc resp = return $
     case lookupHeader HdrContentType (rspHeaders resp) of
         Nothing               -> replaceHeader HdrContentType ("text/html; charset="++enc) resp
         Just ctype            -> insertHeader  HdrContentType (ctype++"; charset="++enc) resp

-responseMiddlewares = return . (addEncoding "UTF-8")
+defaultRqMiddlewares = [addEncoding "UTF-8"]
+defaultRspMiddlewares = []
+
+f `o` g = \x -> f x >>= g
+
+responseMiddlewares = foldr o return $ defaultRqMiddlewares ++ Settings.requestMiddlewares
+requestMiddlewares =  foldr o return $ defaultRspMiddlewares ++ Settings.responseMiddlewares
ViewGit