diff options
| -rw-r--r-- | src/Blog.hs | 20 | ||||
| -rw-r--r-- | src/Main.hs | 6 |
2 files changed, 22 insertions, 4 deletions
diff --git a/src/Blog.hs b/src/Blog.hs index 4906ad5d4004..10b118861568 100644 --- a/src/Blog.hs +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 0c4fcdffcd3f..a6f59acc2870 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 |