diff options
| -rw-r--r-- | res/blogstyle.css | 9 | ||||
| -rw-r--r-- | res/blogv33.css (renamed from res/blogv312.css) | 2 | ||||
| -rw-r--r-- | src/Blog.hs | 25 | ||||
| -rw-r--r-- | src/Locales.hs | 6 | ||||
| -rw-r--r-- | src/Main.hs | 32 |
5 files changed, 59 insertions, 15 deletions
diff --git a/res/blogstyle.css b/res/blogstyle.css index 5f8475613a3d..c2cacfd01144 100644 --- a/res/blogstyle.css +++ b/res/blogstyle.css @@ -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; diff --git a/res/blogv312.css b/res/blogv33.css index 69c3775b2e17..3be4840a9b57 100644 --- a/res/blogv312.css +++ b/res/blogv33.css @@ -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;} \ No newline at end of file +@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;} diff --git a/src/Blog.hs b/src/Blog.hs index 631bfa013d34..2d3fe305bf85 100644 --- a/src/Blog.hs +++ b/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 diff --git a/src/Locales.hs b/src/Locales.hs index 8041c4178b0f..b49434303658 100644 --- a/src/Locales.hs +++ b/src/Locales.hs @@ -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" diff --git a/src/Main.hs b/src/Main.hs index 0ad5d979c288..203d0af0af85 100644 --- a/src/Main.hs +++ b/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 |