Source

haskellblog / src / Blog / Forms.hs

{-# LANGUAGE DisambiguateRecordFields #-}

module Blog.Forms

where

import Blog.Formats (Format(..), getFormatter)
import Blog.Utils (getTimestamp)
import Control.Monad (liftM)
import Data.Maybe (fromJust)
import Ella.Forms.Widgets.TextInput (TextInput(..))
import Ella.Forms.Widgets.Textarea  (Textarea(..))
import Ella.GenUtils (exactParse)
import Ella.Param (captureOrDefault, Param(..))
import qualified Blog.Comment as Cm
import qualified Blog.Post as P
import qualified Data.Map as Map
import qualified Ella.Forms.Widgets.RadioButtonList as RBL
import qualified Ella.Forms.Widgets.TextInput as TI
import qualified Ella.Forms.Widgets.Textarea as TA
import qualified Text.XHtml as X

-- Widgets

nameWidget = TextInput { value = ""
                       , size = Just 20
                       , maxlength = Just 50
                       , name = "name"
                       , identifier = "id_name"
                       , password = False
                       }

emailWidget = TextInput { value = ""
                        , size = Just 20
                        , maxlength = Just 320
                        , name = "email"
                        , identifier = "id_email"
                       , password = False
                        }

commentAllowedFormats =  [Plaintext, RST]

formatWidget = RBL.RadioButtonList { value = ""
                                   , name = "format"
                                   , identifier = "id_format"
                                   , values = map (show . fromEnum) commentAllowedFormats
                                   , captions = map X.toHtml ["Plain text", "Restructured text"]
                                   }

messageWidget = Textarea { value = ""
                         , cols = Just 60
                         , rows = Just 20
                         , name = "message"
                         , identifier = "id_message"
                         }

passwordWidget = TextInput { value = ""
                           , size = Just 20
                           , maxlength = Just 20
                           , name = "password"
                           , identifier = "id_password"
                           , password = True
                           }

usernameWidget = nameWidget { TI.name = "username"
                            , TI.identifier = "id_username"
                            }

-- | Enum for the different stages of submitting a comment
data CommentStage = NoComment
                  | CommentPreview
                  | CommentInvalid
                  | CommentAccepted
                    deriving (Eq, Ord, Enum, Read, Show)


-- | An empty comment used for populating the default form.
emptyComment = Cm.Comment {
                 uid = undefined
               , post_id = undefined
               , timestamp = undefined
               , name = ""
               , email = ""
               , text_raw = ""
               , text_formatted = undefined
               , format = Plaintext
               }

instance Param Format where
    -- Read integer then convert.
    -- TODO error handling for out of bounds.
    capture s = liftM toEnum $ exactParse s

-- | extract the posted data from a POST request and build
-- a Comment from it, returning a Comment and a list of validation errors
validateComment postedData blogpost =
    do
    -- TODO - protect name -- some names are reserved for logged in users.
    -- TODO - posts that are closed for comments
    -- TODO - nicer mechanism for validation
    -- TODO - validate lengths of fields
    -- TODO - CSRF protection

    -- TODO - Spam protection
    --    Method - add 10 second minimum time for adding comment.  On
    --             first request, send back field with hash of time +
    --             IP address + secret, and field with time only. Time
    --             and hash fields are propagated if the user presses
    --             preview.  If hash doesn't match when user presses
    --             submit or if timedelta less than 10 seconds,
    --             emit validation error.

      ts <- getTimestamp
      let text = postedData "message" `captureOrDefault` ""
      let name = postedData "name" `captureOrDefault` ""
      let email = postedData "email" `captureOrDefault` ""
      let format = postedData "format" `captureOrDefault` Plaintext
      let errors = (if null text
                   then [("message", "'Message' is a required field.")]
                   else []) ++
                   (if not $ format `elem` commentAllowedFormats
                    then [("format", "Please choose a format from the list")]
                    else [])

      return (Cm.Comment {
                      uid = undefined
                    , post_id = P.uid blogpost
                    , timestamp = ts
                    , name = name
                    , email = email
                    , text_raw = text
                    , text_formatted = getFormatter format $ text
                    , format = format
                    }, Map.fromList errors)


emptyLoginData = Map.fromList [("username", "")
                              ,("password", "")]
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.