* re-enabled captchas
This commit is contained in:
parent
1bdbe4af64
commit
b3fb7f0f34
2 changed files with 22 additions and 4 deletions
20
src/Blog.hs
20
src/Blog.hs
|
@ -152,15 +152,35 @@ $forall comment <- comments
|
|||
where
|
||||
timeString = formatTime defaultTimeLocale (cTimeFormat lang)
|
||||
|
||||
captcha :: Html
|
||||
captcha = [shamlet|
|
||||
<div class="cCaptcha">
|
||||
<script src="http://api.recaptcha.net/challenge?k=6LfQXccSAAAAAIjKm26XlFnBMAgvaKlOAjVWEEnM" type="text/javascript">
|
||||
<noscript>
|
||||
<iframe src="http://api.recaptcha.net/noscript?k=6LfQXccSAAAAAIjKm26XlFnBMAgvaKlOAjVWEEnM" height="300" width="500" seamless>
|
||||
<br>
|
||||
<textarea name="recaptcha_challenge_field" rows="3" cols="40">
|
||||
<input type="hidden" name="recaptcha_response_field" value="manual_challenge">
|
||||
|]
|
||||
|
||||
captchaOptions :: BlogLang -> Html
|
||||
captchaOptions lang = [shamlet|<script type="text/javascript">^{preEscapedToHtml options}|]
|
||||
where
|
||||
options = T.concat ["var RecaptchaOptions = { theme: 'clean', lang: '", showLangText lang, "'};"]
|
||||
|
||||
|
||||
renderCommentBox :: BlogLang -> EntryId -> Html
|
||||
renderCommentBox cLang cId = [shamlet|
|
||||
<div class="cHead">#{cwHead cLang}
|
||||
^{captchaOptions cLang}
|
||||
<form method="POST" action=#{aLink}>
|
||||
<p><input name="cname" placeholder="Name" class="cInput">
|
||||
<p>
|
||||
<label>
|
||||
<textarea name="ctext" cols="50" rows="13" class="cInput" placeholder=#{cTextPlaceholder cLang}>
|
||||
<p>
|
||||
<label>
|
||||
^{captcha}
|
||||
<p><input class="cInput" style="width:120px;" type="submit" value=#{cSend cLang}>
|
||||
|]
|
||||
where
|
||||
|
|
|
@ -154,9 +154,7 @@ addComment acid lang captchakey eId = do
|
|||
nComment <- Comment <$> pure now
|
||||
<*> lookText' "cname"
|
||||
<*> pure (commentEscape nCtext)
|
||||
update' acid (AddComment eId nComment)
|
||||
>> seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
|
||||
{- -- captcha verification
|
||||
-- captcha verification
|
||||
challenge <- look "recaptcha_challenge_field"
|
||||
response <- look "recaptcha_response_field"
|
||||
(userIp, _) <- askRq >>= return . rqPeer
|
||||
|
@ -164,7 +162,7 @@ addComment acid lang captchakey eId = do
|
|||
case validation of
|
||||
Right _ -> update' acid (AddComment eId nComment)
|
||||
>> seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
|
||||
Left _ -> (liftIO $ putStrLn "Captcha failed") >> seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse()) -}
|
||||
Left _ -> (liftIO $ putStrLn "Captcha failed") >> seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
|
||||
|
||||
commentEscape :: Text -> Text
|
||||
commentEscape = newlineEscape . ltEscape . gtEscape . ampEscape
|
||||
|
|
Loading…
Reference in a new issue