Use Modules.Auth in Blog.

portnov [2009-07-13 12:49:28]
Use Modules.Auth in Blog.
Filename
Blog/Blog.hs
Blog/Settings.hs
Framework/Exceptions.hs
diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index d043df4..3b1e619 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -7,6 +7,7 @@ import Framework.API
 import Framework.Utils

 import Framework.Modules.Auth.Controllers
+import Framework.Modules.Auth.Utils

 import Models

@@ -23,8 +24,8 @@ urlconf = "blog" // "new" --> newpost

 login :: HttpAction
 login = do
+    methodOnly GET
     rq <- asks request
-    errorIf 400 "Invalid request" $ rqMethod rq /= GET
     already <- sessionLookup "username"
     if not $ null already
       then returnNow $ redirect "/blog/"
@@ -49,8 +50,8 @@ i18ntest = do

 allposts :: HttpAction
 allposts = do
+    methodOnly GET
     rq <- asks request
-    errorIf 400 "Invalid method" $ rqMethod rq /= GET
     let getvars = _GET rq
         key = "allposts" ++ (getString' getvars "page" "1")
     tryReturnFromCache key
@@ -63,7 +64,7 @@ allposts = do
                                             ("pager",    C pagerHtml)]

 newpost :: HttpAction
-newpost = do
+newpost = loginRequired $ do
     rq <- asks request
     let url = myUrl rq
     case rqMethod rq of
@@ -77,7 +78,7 @@ newpost = do
           return $ redirect "/blog/"

 editpost :: StrAction
-editpost sid = do
+editpost sid = loginRequired $ do
     rq <- asks request
     let url = myUrl rq
         pid = read sid
diff --git a/Blog/Settings.hs b/Blog/Settings.hs
index b9cc05b..78bb421 100644
--- a/Blog/Settings.hs
+++ b/Blog/Settings.hs
@@ -21,7 +21,8 @@ requestExcHandler rq code msg = do

 -- | Handle controller exception. See notes for requestExcHandler.
 controllerExcHandler :: ExcHandler
-controllerExcHandler rq code msg = return ()
+-- controllerExcHandler rq code msg = return ()
+controllerExcHandler rq code msg = requestExcHandler rq code msg

 -- | These functions may modify each Form.
 formProcessors :: [Form -> Form]
diff --git a/Framework/Exceptions.hs b/Framework/Exceptions.hs
index 469ee78..7b81e13 100644
--- a/Framework/Exceptions.hs
+++ b/Framework/Exceptions.hs
@@ -3,10 +3,13 @@ module Framework.Exceptions
      raiseIO,
      -- * Functions that are specific to application-level controllers
      internalError,
-     errorIf, forceMaybe
+     errorIf,
+     methodOnly,
+     forceMaybe
     ) where

 import Control.Monad.Reader.Class
+import Network.HTTP

 import Framework.Types
 import Framework.Controller
@@ -64,6 +67,12 @@ errorIf code msg b =
       then returnNow $ response code [] msg
       else return ()

+methodOnly :: RequestMethod
+           -> AController ()
+methodOnly meth = do
+    rq <- asks request
+    errorIf 400 "Invalid request method" $ rqMethod rq /= meth
+
 -- | If value is supplied, return it. Otherwise, raise HTTP 500 error.
 forceMaybe :: String         -- ^ Error message
            -> Maybe a        -- ^ Maybe value
ViewGit