version 3.3:
* added reCaptcha again (got too much spam)
This commit is contained in:
Vincent Ambo
parent
5b80f528c7
commit
3e16a443e6
5 changed files with 59 additions and 15 deletions
|
|
@ -118,6 +118,15 @@ input, textarea, select {
|
|||
margin-left: 15px;
|
||||
}
|
||||
|
||||
.cCaptcha {
|
||||
padding: 5px;
|
||||
border: 1px solid #555;
|
||||
-webkit-border-radius: 0.5em;
|
||||
margin-left: 15px;
|
||||
width: 555px;
|
||||
background: #F9F9F9;
|
||||
}
|
||||
|
||||
.tt {
|
||||
font-family: "courier new",courier,monospace;
|
||||
font-size: 13px;
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
@charset UTF-8;@import url(http://fonts.googleapis.com/css?family=Droid+Sans+Mono);@import url(http://fonts.googleapis.com/css?family=PT+Sans);html,body{margin:0;padding:0;}body{font-family:'PT Sans', sans-serif;min-height:850px;color:#EEE;}a{color:#000;}input,textarea,select{border:1px solid #555;font-size:15px;line-height:1.2em;width:550px;background:#F9F9F9;-webkit-border-radius:.5em;padding:.5em;}.header{background:url(/static/hbg.jpg);z-index:4;padding-left:20px;padding-bottom:70px;padding-top:30px;position:relative;box-shadow:0 6px 5px 1px #343537;}.link{color:#EEE;}.middle{position:relative;z-index:2;display:block;width:100%;padding-top:40px;background:url(/static/bg.gif);color:#000;}.footer{background:url(/static/hbg.jpg);z-index:4;position:relative;background-color:#4A525A;margin-top:30px;padding-top:20px;box-shadow:0 -6px 5px 1px #343537;color:#EEE;}.btitle{text-decoration:none;color:#EEE;font-size:x-large;font-weight:700;margin-top:15px;margin-bottom:10px;}.contacts{float:left;font-weight:bolder;}.righttext{float:right;padding-right:20px;}.rightbox{text-align:right;padding-right:14px;}.innerTitle{margin-left:10px;font-weight:700;}.innerBoxComments{margin-left:10px;}.innerContainer{padding-right:20px;}.centerbox{text-align:center;min-height:45px;}.cInput{margin-left:15px;}.tt{font-family:"courier new",courier,monospace;font-size:13px;}.cl{text-decoration:none;color:#000;}.cHead{font-size:large;font-weight:700;}.notFoundFace{text-align:center;font-size:100px;}.notFoundText{text-align:center;font-size:24px;font-weight:700;}.code{box-shadow:3px 3px 5px 1px #888;border-radius:10px;font-size:11pt;width:60em;color:#FFF;line-height:1.2em;font-family:'Droid Sans Mono', sans-serif;background:#000;background-image:url(/static/cbg.jpg);background-repeat:no-repeat;padding:.75em;}.code pre{font-family:'Droid Sans Mono', sans-serif;}kbd{font-family:'Droid Sans Mono', sans-serif;color:#333;font-size:.8em;}.wide{width:90em;}code{line-height:1.5em;border:1px;}.source-code{font-size:.75em;color:#666;}.warning{color:red;}.hs-keyword{color:#87CEEB;}.hs-comment,.hs-comment a{color:#5F9EA0;}.hs-str{color:#FF8C00;}.hs-chr{color:#BC8F8F;}.hs-conid{color:#ADFF2F;}.hs-sel{color:#B22222;}.hs-cpp{color:#FF0;}.hs-definition{color:#FFD700;}.hs-keyglyph,.hs-varop,.hs-conop{color:#B8860B;}.hs-layout,.hs-varid,.hs-num{color:#FFF;}
|
||||
@charset UTF-8;@import url(http://fonts.googleapis.com/css?family=Droid+Sans+Mono);@import url(http://fonts.googleapis.com/css?family=PT+Sans);html,body{margin:0;padding:0;}body{font-family:'PT Sans', sans-serif;min-height:850px;color:#EEE;}a{color:#000;}input,textarea,select{border:1px solid #555;font-size:15px;line-height:1.2em;width:550px;background:#F9F9F9;-webkit-border-radius:.5em;padding:.5em;}.header{background:url(/static/hbg.jpg);z-index:4;padding-left:20px;padding-bottom:70px;padding-top:30px;position:relative;box-shadow:0 6px 5px 1px #343537;}.link{color:#EEE;}.middle{position:relative;z-index:2;display:block;width:100%;padding-top:40px;background:url(/static/bg.gif);color:#000;}.footer{background:url(/static/hbg.jpg);z-index:4;position:relative;background-color:#4A525A;margin-top:30px;padding-top:20px;box-shadow:0 -6px 5px 1px #343537;color:#EEE;}.btitle{text-decoration:none;color:#EEE;font-size:x-large;font-weight:700;margin-top:15px;margin-bottom:10px;}.contacts{float:left;font-weight:bolder;}.righttext{float:right;padding-right:20px;}.rightbox{text-align:right;padding-right:14px;}.innerTitle{margin-left:10px;font-weight:700;}.innerBoxComments{margin-left:10px;}.innerContainer{padding-right:20px;}.centerbox{text-align:center;min-height:45px;}.cInput{margin-left:15px;}.cCaptcha{border:1px solid #555;-webkit-border-radius:.5em;margin-left:15px;width:555px;background:#F9F9F9;padding:5px;}.tt{font-family:"courier new",courier,monospace;font-size:13px;}.cl{text-decoration:none;color:#000;}.cHead{font-size:large;font-weight:700;}.notFoundFace{text-align:center;font-size:100px;}.notFoundText{text-align:center;font-size:24px;font-weight:700;}.code{box-shadow:3px 3px 5px 1px #888;border-radius:10px;font-size:11pt;width:60em;color:#FFF;line-height:1.2em;font-family:'Droid Sans Mono', sans-serif;background:#000;background-image:url(/static/cbg.jpg);background-repeat:no-repeat;padding:.75em;}.code pre{font-family:'Droid Sans Mono', sans-serif;}kbd{font-family:'Droid Sans Mono', sans-serif;color:#333;font-size:.8em;}.wide{width:90em;}code{line-height:1.5em;border:1px;}.source-code{font-size:.75em;color:#666;}.warning{color:red;}.hs-keyword{color:#87CEEB;}.hs-comment,.hs-comment a{color:#5F9EA0;}.hs-str{color:#FF8C00;}.hs-chr{color:#BC8F8F;}.hs-conid{color:#ADFF2F;}.hs-sel{color:#B22222;}.hs-cpp{color:#FF0;}.hs-definition{color:#FFD700;}.hs-keyglyph,.hs-varop,.hs-conop{color:#B8860B;}.hs-layout,.hs-varid,.hs-num{color:#FFF;}
|
||||
25
src/Blog.hs
25
src/Blog.hs
|
|
@ -9,12 +9,14 @@ import Data.Monoid (mempty)
|
|||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time
|
||||
import Network.Captcha.ReCaptcha
|
||||
import System.Locale (defaultTimeLocale)
|
||||
import Text.Blaze (toValue, preEscapedText)
|
||||
import Text.Blaze (toValue, preEscapedText, preEscapedString)
|
||||
import Text.Blaze.Html5 (Html, (!), a, form, input, p, toHtml, label)
|
||||
import Text.Blaze.Html5.Attributes (action, enctype, href, name, size, type_, value)
|
||||
import qualified Text.Blaze.Html5 as H
|
||||
import qualified Text.Blaze.Html5.Attributes as A
|
||||
import Text.XHtml.Strict (showHtmlFragment)
|
||||
|
||||
import Locales
|
||||
import BlogDB
|
||||
|
|
@ -26,6 +28,21 @@ intersperse' sep l = sep : intersperse sep l
|
|||
replace :: Eq a => a -> a -> [a] -> [a]
|
||||
replace x y = map (\z -> if z == x then y else z)
|
||||
|
||||
-- javascript and others
|
||||
|
||||
captcha :: Html
|
||||
captcha = H.div ! A.class_ "cCaptcha" $
|
||||
do H.script ! A.src "http://api.recaptcha.net/challenge?k=6LfQXccSAAAAAIjKm26XlFnBMAgvaKlOAjVWEEnM" ! A.type_ "text/javascript" $ ""
|
||||
H.noscript $ H.iframe ! A.src "http://api.recaptcha.net/noscript?k=6LfQXccSAAAAAIjKm26XlFnBMAgvaKlOAjVWEEnM" ! A.height "300" !
|
||||
A.width "500" ! A.seamless "" $ do
|
||||
H.br
|
||||
H.textarea ! A.name "recaptcha_challenge_field" ! A.rows "3" ! A.cols "40" $ ""
|
||||
H.input ! A.type_ "hidden" ! A.name "recaptcha_response_field" ! A.value "manual_challenge"
|
||||
|
||||
captchaOptions :: BlogLang -> Html
|
||||
captchaOptions lang = H.script ! A.type_ "text/javascript" $ toHtml $
|
||||
T.concat ["var RecaptchaOptions = { theme: 'clean', lang: '", showLangText lang, "'};"]
|
||||
|
||||
analytics :: Text
|
||||
analytics = T.pack $ unlines ["<script type=\"text/javascript\">"
|
||||
," var _gaq = _gaq || [];"
|
||||
|
|
@ -38,12 +55,14 @@ analytics = T.pack $ unlines ["<script type=\"text/javascript\">"
|
|||
," })();"
|
||||
,"</script>"]
|
||||
|
||||
-- blog HTML
|
||||
|
||||
blogTemplate :: BlogLang -> Text -> Html -> Html
|
||||
blogTemplate lang t_append body = H.docTypeHtml $ do --add body
|
||||
H.head $ do
|
||||
H.title $ (toHtml $ blogTitle lang t_append)
|
||||
H.link ! A.rel "alternate" ! A.type_ "application/rss+xml" ! A.title "RSS-Feed" ! A.href (toValue feedURL)
|
||||
H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/static/blogv312.css" ! A.media "all"
|
||||
H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/static/blogv33.css" ! A.media "all"
|
||||
--H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/res/blogstyle.css" ! A.media "all"
|
||||
H.meta ! A.httpEquiv "content-type" ! A.content "text/html;charset=UTF-8"
|
||||
--H.style ! A.type_ "text/css" ! A.title "iOS iMessage" ! A.media "screen and (max-device-width: 1024px)" $ "#cosx{display:none;}"
|
||||
|
|
@ -116,10 +135,12 @@ renderEntry (Entry{..}) = do
|
|||
renderCommentBox :: BlogLang -> EntryId -> Html
|
||||
renderCommentBox cLang cId = do
|
||||
H.div ! A.class_ "cHead" $ toHtml $ cwHead cLang
|
||||
captchaOptions cLang
|
||||
H.form ! A.method "POST" ! A.action (toValue $ "/" ++ (show cLang) ++ "/postcomment/" ++ show cId) $ do
|
||||
H.p $ H.input ! A.name "cname" ! A.placeholder "Name" ! A.class_ "cInput"
|
||||
H.p $ H.label $ H.textarea ! A.name "ctext" ! A.cols "50" ! A.rows "13" ! A.class_ "cInput" !
|
||||
A.placeholder (toValue $ cTextPlaceholder cLang) $ mempty
|
||||
H.p $ H.label $ captcha
|
||||
H.p $ H.input ! A.class_ "cInput" ! A.style "width: 120px;" ! A.type_ "submit" ! A.value (toValue $ cSend cLang)
|
||||
|
||||
renderComments :: [Comment] -> BlogLang -> Html
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ import BlogDB (BlogLang (..))
|
|||
|
||||
data BlogError = NotFound | DBError
|
||||
|
||||
version = "3.2"
|
||||
version = "3.3"
|
||||
|
||||
allLang = [EN, DE]
|
||||
|
||||
|
|
@ -28,6 +28,10 @@ blogTitle :: BlogLang -> Text -> Text
|
|||
blogTitle DE s = T.concat ["Tazjins Blog", s]
|
||||
blogTitle EN s = T.concat ["Tazjin's Blog", s]
|
||||
|
||||
showLangText :: BlogLang -> Text
|
||||
showLangText EN = "en"
|
||||
showLangText DE = "de"
|
||||
|
||||
-- index site headline
|
||||
topText DE = "Aktuelle Einträge"
|
||||
topText EN = "Latest entries"
|
||||
|
|
|
|||
32
src/Main.hs
32
src/Main.hs
|
|
@ -24,6 +24,7 @@ import Data.Time
|
|||
import Data.SafeCopy (base, deriveSafeCopy)
|
||||
import Happstack.Server hiding (Session)
|
||||
import Happstack.Server.Compression
|
||||
import Network.Captcha.ReCaptcha
|
||||
import Options
|
||||
import System.Locale (defaultTimeLocale)
|
||||
|
||||
|
|
@ -38,6 +39,8 @@ defineOptions "MainOptions" $ do
|
|||
stringOption "optState" "statedir" "../"
|
||||
"Directory in which the /BlogState dir is located.\
|
||||
\ The default is ../ (if run from src/)"
|
||||
stringOption "optCaptcha" "captchakey" ""
|
||||
"The reCaptcha private key"
|
||||
intOption "optPort" "port" 8000
|
||||
"The port to run the web server on. Default is 8000"
|
||||
|
||||
|
|
@ -50,12 +53,12 @@ main = do
|
|||
runCommand $ \opts args ->
|
||||
bracket (openLocalStateFrom (optState opts ++ "BlogState") initialBlogState)
|
||||
(createCheckpointAndClose)
|
||||
(\acid -> simpleHTTP nullConf {port = optPort opts} $ tazBlog acid)
|
||||
(\acid -> simpleHTTP nullConf {port = optPort opts} $ tazBlog acid $ optCaptcha opts)
|
||||
|
||||
tazBlog :: AcidState Blog -> ServerPart Response
|
||||
tazBlog acid = do
|
||||
tazBlog :: AcidState Blog -> String -> ServerPart Response
|
||||
tazBlog acid captchakey = do
|
||||
compr <- compressedResponseFilter
|
||||
msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang
|
||||
msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang captchakey
|
||||
, nullDir >> showIndex acid DE
|
||||
, dir " " $ nullDir >>
|
||||
seeOther ("https://plus.google.com/115916629925754851590" :: Text) (toResponse ())
|
||||
|
|
@ -87,12 +90,12 @@ tazBlog acid = do
|
|||
, notFound $ toResponse $ showError NotFound DE
|
||||
]
|
||||
|
||||
blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response
|
||||
blogHandler acid lang =
|
||||
blogHandler :: AcidState Blog -> BlogLang -> String -> ServerPart Response
|
||||
blogHandler acid lang captchakey =
|
||||
msum [ path $ \(eId :: Integer) -> showEntry acid lang $ EntryId eId
|
||||
, do decodeBody tmpPolicy
|
||||
dir "postcomment" $ path $
|
||||
\(eId :: Integer) -> addComment acid lang $ EntryId eId
|
||||
\(eId :: Integer) -> addComment acid lang captchakey $ EntryId eId
|
||||
, nullDir >> showIndex acid lang
|
||||
, dir "rss" $ nullDir >> showRSS acid lang
|
||||
, dir "rss.xml" $ nullDir >> showRSS acid lang
|
||||
|
|
@ -134,15 +137,22 @@ showRSS acid lang = do
|
|||
setHeaderM "content-type" "text/xml"
|
||||
ok $ toResponse feed
|
||||
|
||||
addComment :: AcidState Blog -> BlogLang -> EntryId -> ServerPart Response
|
||||
addComment acid lang eId = do
|
||||
addComment :: AcidState Blog -> BlogLang -> String -> EntryId -> ServerPart Response
|
||||
addComment acid lang captchakey eId = do
|
||||
now <- liftIO $ getCurrentTime >>= return
|
||||
nCtext <- lookText' "ctext"
|
||||
nComment <- Comment <$> pure now
|
||||
<*> lookText' "cname"
|
||||
<*> pure (commentEscape nCtext)
|
||||
update' acid (AddComment eId nComment)
|
||||
seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
|
||||
-- captcha verification
|
||||
challenge <- look "recaptcha_challenge_field"
|
||||
response <- look "recaptcha_response_field"
|
||||
(userIp, _) <- askRq >>= return . rqPeer
|
||||
validation <- liftIO $ validateCaptcha captchakey userIp challenge response
|
||||
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())
|
||||
|
||||
commentEscape :: Text -> Text
|
||||
commentEscape = newlineEscape . ltEscape . gtEscape . ampEscape
|
||||
|
|
|
|||
Loading…
Reference in a new issue