Luke Plant  committed 2a184ac

Implemented validation of name for comments

  • Participants
  • Parent commits c6b1201

Comments (0)

Files changed (3)

File src/Blog/Forms.hs

 import Blog.Model (checkPassword)
 import Blog.Utils (getTimestamp)
 import Control.Monad (liftM)
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, isNothing)
 import Ella.Forms.Widgets.TextInput (TextInput(..))
 import Ella.Forms.Widgets.Textarea  (Textarea(..))
 import Ella.GenUtils (exactParse)
 import Data.String.Utils (strip)
 import qualified Blog.Comment as Cm
 import qualified Blog.Post as P
+import qualified Blog.Settings as Settings
 import qualified Data.Map as Map
 import qualified Ella.Forms.Widgets.RadioButtonList as RBL
 import qualified Ella.Forms.Widgets.TextInput as TI
       let email = postedData "email" `captureOrDefault` ""
       let format = postedData "format" `captureOrDefault` Plaintext
       let errors = (if null text
-                   then [("message", "'Message' is a required field.")]
-                   else []) ++
+                    then [("message", "'Message' is a required field.")]
+                    else []) ++
                    (if not $ format `elem` commentAllowedFormats
                     then [("format", "Please choose a format from the list")]
+                    else []) ++
+                   (if name `elem` Settings.reserved_names && not (maybe False (==name) creds)
+                    then [("name", "That name is reserved.")]
                     else [])
       return (Cm.Comment {

File src/Blog/Views.hs

     handleUserComment cn post req =
         case requestMethod req of
           "POST" -> do
-            (commentData, commentErrors) <- validateComment (getCredentials req) (getPOST req) post
+            creds <- getCredentials req
+            (commentData, commentErrors) <- validateComment creds (getPOST req) post
             if Map.null commentErrors
                then if isJust (getPOST req "submit")

File src/Blog/settingslocal.hs

 root_url = "/blog/"
 prog_uri = "/cgi-bin/blog.cgi" -- Used for redirecting
 blog_author_name = "luke"
+reserved_names = [blog_author_name]
 post_page_size = 20 :: Int
 domain = "lukeplant_local"