Put middlewares to work.
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