diff options
| -rw-r--r-- | TazBlog.cabal | 3 | ||||
| -rw-r--r-- | src/Blog.hs | 64 | ||||
| -rw-r--r-- | src/Locales.hs | 2 | ||||
| -rw-r--r-- | src/Main.hs | 43 |
4 files changed, 8 insertions, 104 deletions
diff --git a/TazBlog.cabal b/TazBlog.cabal index 295d4e8ae36f..c254361f2ff0 100644 --- a/TazBlog.cabal +++ b/TazBlog.cabal @@ -1,5 +1,5 @@ Name: TazBlog -Version: 4.0 +Version: 4.1 Synopsis: Tazjin's Blog License-file: LICENSE Author: Vincent Ambo @@ -34,7 +34,6 @@ Executable tazblog network, options, rss, - recaptcha, hamlet, shakespeare-css, markdown diff --git a/src/Blog.hs b/src/Blog.hs index a814a746170d..67adf0cd3cf4 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -17,7 +17,6 @@ import Data.Text (Text, append, empty, pack) import Data.Text.Lazy (fromStrict) import Data.Time import Locales -import Network.Captcha.ReCaptcha import System.Locale (defaultTimeLocale) import Text.Blaze.Html (preEscapedToHtml) import Text.Hamlet @@ -121,9 +120,6 @@ $forall entry <- elist <b>#{title entry} <br> <i>#{pack $ formatTime defaultTimeLocale "%Y-%m-%d" $ edate entry} - <br> - #{linkText $ length $ comments entry} - #{cHead $ lang entry} <div .span10 .entry> $if (isEntryMarkdown entry) ^{renderEntryMarkdown $ append " " $ btext entry} @@ -140,7 +136,6 @@ $maybe links <- footerLinks where elist = if' showAll entries (take 6 entries) linkElems Entry{..} = concat $ intersperse' "/" [show lang, show entryId] - linkText n = T.concat ["[", show' n, "]"] showLinks :: Maybe Int -> BlogLang -> Html showLinks (Just i) lang = [shamlet| @@ -179,69 +174,10 @@ renderEntry e@Entry{..} = [shamlet| $else ^{preEscapedToHtml $ btext} <p>^{preEscapedToHtml $ mtext} -<div .row .innerBoxComments> - <div .span10> - <div .boldify>#{cHead lang}: -#{renderComments comments lang} -<div .row .innerBoxComments> - <div .span10> - <div .boldify>#{cwHead lang} -^{renderCommentBox lang entryId} |] where woText = flip T.append author $ T.pack $ formatTime defaultTimeLocale (eTimeFormat lang) edate -renderComments :: [Comment] -> BlogLang -> Html -renderComments [] lang = [shamlet| -<div .row> - <div .span10>#{noComments lang} -|] -renderComments comments lang = [shamlet| -$forall comment <- comments - <div .row> - <div .span1 .commentname> - <i>#{append (cauthor comment) ": "} - <div .span9> - ^{preEscapedToHtml $ ctext comment} - <p .tt>#{timeString $ cdate comment} -|] - where - timeString = formatTime defaultTimeLocale (cTimeFormat lang) - -renderCommentBox :: BlogLang -> EntryId -> Html -renderCommentBox cLang cId = [shamlet| -^{captchaOptions cLang} -<div .row> - <div .span10> - <form method="POST" action=#{aLink}> - <fieldset> - <label> - <input .span8 name="cname" placeholder="Name" type="text"> - <label> - <textarea .span8 name="ctext" cols="50" rows="13" placeholder=#{cTextPlaceholder cLang}> - ^{captcha} - <label> - <input .btn type="submit" value=#{cSend cLang}> -|] - where - aLink = T.concat ["/", show' cLang, "/postcomment/", show' cId] - - -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, "'};"] showSiteNotice :: Html showSiteNotice = [shamlet| diff --git a/src/Locales.hs b/src/Locales.hs index 34d3fadf25d0..7fd874c1d07f 100644 --- a/src/Locales.hs +++ b/src/Locales.hs @@ -18,7 +18,7 @@ import BlogDB (BlogLang (..)) data BlogError = NotFound | DBError -version = "4.0" +version = "4.1" allLang = [EN, DE] diff --git a/src/Main.hs b/src/Main.hs index 1a9331f41841..88bf59121eac 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -31,7 +31,6 @@ import qualified Data.Text as T import Data.Time import Happstack.Server hiding (Session) import Happstack.Server.Compression -import Network.Captcha.ReCaptcha import Options import System.Locale (defaultTimeLocale) @@ -47,8 +46,6 @@ 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" @@ -61,12 +58,12 @@ main = do runCommand $ \opts args -> bracket (openLocalStateFrom (optState opts ++ "BlogState") initialBlogState) createCheckpointAndClose - (\acid -> simpleHTTP nullConf {port = optPort opts} $ tazBlog acid $ optCaptcha opts) + (\acid -> simpleHTTP nullConf {port = optPort opts} $ tazBlog acid) -tazBlog :: AcidState Blog -> String -> ServerPart Response -tazBlog acid captchakey = do +tazBlog :: AcidState Blog -> ServerPart Response +tazBlog acid = do compr <- compressedResponseFilter - msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang captchakey + msum [ path $ \(lang :: BlogLang) -> blogHandler acid lang , nullDir >> showIndex acid EN , dir " " $ nullDir >> seeOther ("https://plus.google.com/115916629925754851590" :: Text) (toResponse ()) @@ -107,12 +104,9 @@ tazBlog acid captchakey = do , notFound $ toResponse $ showError NotFound DE ] -blogHandler :: AcidState Blog -> BlogLang -> String -> ServerPart Response -blogHandler acid lang captchakey = +blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response +blogHandler acid lang = msum [ path $ \(eId :: Integer) -> showEntry acid lang $ EntryId eId - , do decodeBody tmpPolicy - dir "postcomment" $ path $ - \(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 @@ -154,31 +148,6 @@ showRSS acid lang = do setHeaderM "content-type" "text/xml" ok $ toResponse feed -addComment :: AcidState Blog -> BlogLang -> String -> EntryId -> ServerPart Response -addComment acid lang captchakey eId = do - now <- liftIO getCurrentTime - nCtext <- lookText' "ctext" - nComment <- Comment <$> pure now - <*> lookText' "cname" - <*> pure (commentEscape nCtext) - -- captcha verification - challenge <- look "recaptcha_challenge_field" - response <- look "recaptcha_response_field" - (userIp, _) <- liftM rqPeer askRq - 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 - where - newlineEscape = T.replace "\n" "<br>" - ampEscape = T.replace "&" "&" - ltEscape = T.replace "<" "<" - gtEscape = T.replace ">" ">" - {- ADMIN stuff -} postEntry :: AcidState Blog -> ServerPart Response |