Use Modules.Auth in Blog.
Use Modules.Auth in Blog.
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