diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2010 Oliver Mader, Nils Schweinsberg + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hakismet.cabal b/hakismet.cabal new file mode 100644 --- /dev/null +++ b/hakismet.cabal @@ -0,0 +1,34 @@ +Name: hakismet +Version: 0.1 +Synopsis: Akismet spam protection library +Description: Network.Akismet offers an easy way to interact with the stop spam service Akismet. + +License: MIT +License-File: LICENSE +Category: Web +Author: Oliver Mader , Nils Schweinsberg +Maintainer: mail@n-sch.de +Homepage: https://code.reaktor42.de/projects/hakismet + +Build-type: Simple +Cabal-version: >= 1.8 + +Source-Repository head + type: git + location: git://reaktor42.de/hakismet.git + +Library + + GHC-Options: -Wall + HS-Source-Dirs: src + + Build-depends: + base == 4.*, + network == 2.2.*, + HTTP == 4000.* + + Exposed-Modules: + Network.Akismet + + Other-Modules: + Paths_hakismet diff --git a/src/Network/Akismet.hs b/src/Network/Akismet.hs new file mode 100644 --- /dev/null +++ b/src/Network/Akismet.hs @@ -0,0 +1,142 @@ +------------------------------------------------------------------------------ +-- | +-- Module : Network.Akismet +-- Copyright : (c) 2010 Oliver Mader, Nils Schweinsberg +-- License : MIT (see LICENSE file) +-- +-- Maintainer : mail@n-sch.de +-- Stability : experimental +-- Portability : non-portable +-- +-- Network.Akismet offers an easy way to interact with the stop spam service +-- Akismet. For more information about Akismet and what each value means +-- check . +-- +-------------------------------------------------------------------------------- + +module Network.Akismet + ( + -- * Akismet API + verifyKey + , checkComment + , submitSpam + , submitHam + + -- * Data types + , Comment (..) + , defaultComment + ) where + +import Control.Applicative +import Data.Maybe +import Data.List +import Network.Browser +import Network.HTTP +import Network.URI + +import Paths_hakismet +import Data.Version + +-- | Comment represents the Content you want to check using Akismet. +-- For the exact meaning of each record selector check +-- http://akismet.com/development/api/ +data Comment = Comment + { cBlog :: String + , cUserIp :: String + , cUserAgent :: String + , cContent :: String + , cReferrer :: Maybe String + , cPermalink :: Maybe String + , cType :: Maybe String + , cAuthor :: Maybe String + , cAuthorEmail :: Maybe String + , cAuthorUrl :: Maybe String + , cEnvVars :: [(String, String)] + } + +userAgent :: String +userAgent = "HAkismet/" ++ intercalate "." (map show $ versionBranch version) + +-- | Create a Comment with all required fields +defaultComment :: String -- ^ Blog + -> String -- ^ UserIp + -> String -- ^ UserAgent + -> String -- ^ Content + -> Comment +defaultComment blog userip useragent content = + Comment { cBlog = blog + , cUserIp = userip + , cContent = content + , cUserAgent = useragent + , cReferrer = Nothing + , cPermalink = Nothing + , cType = Nothing + , cAuthor = Nothing + , cAuthorEmail = Nothing + , cAuthorUrl = Nothing + , cEnvVars = [] + } + +-- | Try to verify your API key, it should be called before +-- every other akismet related operation. +verifyKey :: String -- ^ Akismet API key + -> String -- ^ Blog url + -> IO Bool +verifyKey key blog = do + response <- simpleHTTP $ replaceHeader HdrUserAgent userAgent req + either (error . ("verifyKey: " ++) . show) + (return . ("valid" ==) . rspBody) + response + where + Just uri = parseURI "http://rest.akismet.com/1.1/verify-key" + req = formToRequest (Form POST uri [("key", key), ("blog", blog)]) + +-- | Check a comment, in case of spam it returns True else False +checkComment :: String -- ^ Akismet API key + -> Comment -- ^ Comment + -> IO Bool +checkComment key comment = do + response <- simpleHTTP $ createRequest key "comment-check" comment + either (error . ("checkComment: " ++) . show) + (return . ("true" ==) . rspBody) + response + +-- | Submit a spam comment +submitSpam :: String -- ^ Akismet API key + -> Comment -- ^ Spam comment + -> IO () +submitSpam key comment = do + _ <- simpleHTTP $ createRequest key "submit-spam" comment + return () + +-- | Submit a false positive spam comment aka ham +submitHam :: String -- ^ Akismet API key + -> Comment -- ^ Ham comment + -> IO () +submitHam key comment = do + _ <- simpleHTTP $ createRequest key "submit-ham" comment + return () + +createRequest :: String + -> String + -> Comment + -> Request_String +createRequest key service comment = replaceHeader HdrUserAgent userAgent req + where + uri = case parseURI ("http://" ++ key ++ ".rest.akismet.com/1.1/" ++ service) of + Nothing -> error "createRequest: unable to create URI" + Just s -> s + values = [ ("blog", cBlog comment) + , ("user_ip", cUserIp comment) + , ("user_agent", cUserAgent comment) + , ("comment_content", cContent comment) + ] + ++ catMaybes [ (,) "referrer" <$> cReferrer comment + , (,) "permalink" <$> cPermalink comment + , (,) "comment_type" <$> cType comment + , (,) "comment_author" <$> cAuthor comment + , (,) "comment_author_email" <$> cAuthorEmail comment + , (,) "comment_author_url" <$> cAuthorUrl comment + ] + ++ cEnvVars comment + req = formToRequest $ Form POST uri values