module Network.Akismet
(
verifyKey
, checkComment
, submitSpam
, submitHam
, 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
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)
defaultComment :: String
-> String
-> String
-> String
-> 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 = []
}
verifyKey :: String
-> String
-> 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)])
checkComment :: String
-> Comment
-> IO Bool
checkComment key comment = do
response <- simpleHTTP $ createRequest key "comment-check" comment
either (error . ("checkComment: " ++) . show)
(return . ("true" ==) . rspBody)
response
submitSpam :: String
-> Comment
-> IO ()
submitSpam key comment = do
_ <- simpleHTTP $ createRequest key "submit-spam" comment
return ()
submitHam :: String
-> 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