Removed comments

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

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|

src/Locales.hs

@@ -18,7 +18,7 @@ import           BlogDB      (BlogLang (..))
 
 data BlogError = NotFound | DBError
 
-version = "4.0"
+version = "4.1"
 
 allLang = [EN, DE]
 

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 :: AcidState Blog -> ServerPart Response
-tazBlog acid captchakey = do
+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 :: AcidState Blog -> BlogLang -> ServerPart Response
-blogHandler acid lang captchakey =
+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 "&" "&amp;"
-        ltEscape = T.replace "<" "&lt;"
-        gtEscape = T.replace ">" "&gt;"
-
 {- ADMIN stuff -}
 
 postEntry :: AcidState Blog -> ServerPart Response