Further updates

diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index 9a1c581..6be99ef 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -47,6 +47,7 @@ testform = do
 allposts :: HttpAction
 allposts = do
     rq <- asks request
+    errorIf 400 "Invalid method" $ rqMethod rq /= GET
     let getvars = _GET rq
         key = "allposts" ++ (getString' getvars "page" "1")
     tryReturnFromCache key
@@ -75,20 +76,14 @@ newpost = do
     rq <- asks request
     let url = myUrl rq
     case rqMethod rq of
-      GET  ->
-          do (form,err) <- retryForm postForm "1" [] url
-             return $ renderToResponse "newpost.html" [("form", C form),
+      GET  -> do
+          (form,err) <- retryForm postForm "1" [] url
+          return $ renderToResponse "newpost.html" [("form", C form),
                                                        ("invalid", C err)]
       POST -> do
-          let (d,_) = getForm allForms rq "postform"
-          case d of
-            Right post -> let ptitle = post -:> "title"
-                              pbody  = post -:> "body"
-                          in do queryListSQL (insertM postModel) [ptitle, pbody]
-                                commit
-                                invalidatePostsCache
-                                return $ redirectG "/blog/" ["code" := "1"]
-            Left e -> returnInvalidForm postForm "1" e
+          insertModel allForms postModel postForm "1" []
+          invalidatePostsCache
+          return $ redirectG "/blog/" ["code" := "1"]

 editpost :: StrAction
 editpost sid = do
@@ -123,15 +118,8 @@ onepost sid = do
                                                       ("message", C message),
                                                       ("form", C form)]
         POST -> do
-            let (d,_) = getForm allForms rq "comment"
-            case d of
-              Right comment ->
-                  do liftC $ print $ mFields comment
-                     let cAuthor = comment -:> "author"
-                     let cBody   = comment -:> "body"
-                     queryListSQL (insertM commentModel) [SqlInt32 $ fromIntegral pid, cAuthor, cBody]
-                     commit
-                     return $ redirectG url ["code" := "2"]
-              Left e -> returnInvalidForm commentForm "1" e
+            insertModel allForms commentModel commentForm "1" [SqlInt32 $ fromIntegral pid]
+            invalidatePostsCache
+            return $ redirectG url ["code" := "2"]

 main = serveHttp "blog.conf" urlconf
diff --git a/Framework/API/SQL.hs b/Framework/API/SQL.hs
index a0e268e..a775b2a 100644
--- a/Framework/API/SQL.hs
+++ b/Framework/API/SQL.hs
@@ -50,6 +50,24 @@ getOneObject model oid = do
     assertC $ (length objs)==1
     return $ head objs

+insertModel :: M.Map String Form         -- ^ Map of all forms
+            -> Model
+            -> Form
+            -> String                    -- ^ Form ID
+            -> [HDBC.SqlValue]           -- ^ Additional fields (which are not in form)
+            -> Controller ActionConfig ()
+insertModel mm model form fid params = do
+    rq <- asks request
+    let (d,_) = getForm mm rq (formName form)
+    case d of
+      Right obj ->
+          do queryListSQL (insertM model) $ params ++ values
+             commit
+          where
+             fields = map fieldName $ filter (not . isExternalField) $ mFields model
+             values = map (obj -:>) fields
+      Left e -> returnInvalidForm form fid e
+
 updateModel :: M.Map String Form        -- ^ Map of all forms
             -> Model                    -- ^ Model
             -> Form
@@ -61,11 +79,12 @@ updateModel mm model form fid oid = do
     idf <- forceMaybe "Could not find PK!" $ getPK model
     let (d,_) = getForm mm rq (formName form)
     case d of
-      Right obj -> do queryListSQL (updateM model (idf :==: oid)) values
-                      commit
-                   where
-                      fields = map fieldName $ filter (not . isExternalField) $ mFields model
-                      values = map (obj -:>) fields
+      Right obj ->
+          do queryListSQL (updateM model (idf :==: oid)) values
+             commit
+          where
+             fields = map fieldName $ filter (not . isExternalField) $ mFields model
+             values = map (obj -:>) fields
       Left e -> returnInvalidForm form fid e


diff --git a/Framework/Controller.hs b/Framework/Controller.hs
index 2503a88..31f648b 100644
--- a/Framework/Controller.hs
+++ b/Framework/Controller.hs
@@ -53,10 +53,10 @@ returnNow v = Controller $ \_ -> return (RightNow v)
 internalError :: String -> Controller s a
 internalError msg = returnNow $ response 500 [] msg

-errorIf :: String -> Bool -> Controller s ()
-errorIf msg b =
+errorIf :: Int -> String -> Bool -> Controller s ()
+errorIf code msg b =
     if b
-      then internalError msg
+      then returnNow $ response code [] msg
       else return ()

 forceMaybe :: String -> Maybe a -> Controller s a