hMollom (empty) → 0.1
raw patch · 5 files changed
+352/−0 lines, 5 filesdep +Cryptodep +basedep +bytestringsetup-changed
Dependencies added: Crypto, base, bytestring, dataenc, haxr, mtl, old-locale, time
Files
- LICENSE +29/−0
- Setup.hs +2/−0
- hMollom.cabal +30/−0
- src/Network/Mollom.hs +254/−0
- src/Network/Mollom/Auth.hs +37/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright © 2010 Andy Georges. All Rights Reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++3. The name of the author may not be used to endorse or promote products+derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY Andy Georges "AS IS" AND ANY EXPRESS OR IMPLIED+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT+OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING+IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.++The views and conclusions contained in the software and documentation are those of the+authors and should not be interpreted as representing official policies, either expressed+or implied, of Andy Georges.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hMollom.cabal view
@@ -0,0 +1,30 @@+name: hMollom+version: 0.1+cabal-version: >= 1.2+stability: experimental+synopsis: Library to interact with the Mollom anti-spam service+description: Library to interact with the Mollom anti-spam service+license: BSD3+license-file: LICENSE+author: Andy Georges+homepage: http://github.com/itkovian/hMollom+category: Network+maintainer: itkovian@gmail.com+build-Type: Simple+extra-source-files: src/Network/Mollom/Auth.hs+++library+ build-depends: + base >= 3 && < 5, + haxr >= 3000.5,+ old-locale >= 1,+ time >= 1.1.4,+ Crypto >= 4.2.0,+ bytestring >= 0.9.1.4,+ dataenc >= 0.13,+ mtl >= 1.1.0.2+ exposed-modules: Network.Mollom+ ghc-options: -Wall+ hs-source-dirs: src+
+ src/Network/Mollom.hs view
@@ -0,0 +1,254 @@+-- |Interface to the Mollom API+module Network.Mollom+ ( getServerList+ , checkContent+ , sendFeedback+ , getImageCaptcha+ , getAudioCaptcha+ , checkCaptcha+ , getStatistics+ , verifyKey+ , detectLanguage+ , addBlacklistText+ , removeBlacklistText+ , listBlacklistText+ , addBlacklistURL+ , removeBlacklistURL+ , listBlacklistURL+ , MollomConn(..)+ ) where++import Control.Monad.Error+import Data.Maybe(fromJust, isJust)+import Network.XmlRpc.Client+import Network.XmlRpc.Internals +--import Network.XmlRpc.THDeriveXmlRpcType (asXmlRpcStruct)++import Network.Mollom.Auth+++mollomApiVersion :: String+mollomApiVersion = "1.0"++mollomFallbackServer :: String+mollomFallbackServer = "http://xmlrpc2.mollom.com/"++-- FIXME: This should be specified in some configuration file+-- or use the system locale+mollomTimeFormat = "%Y-%m-%dT%H:%M:%S.000+0200"++-- |Describes connection with the Mollom server+data MollomConn = MollomConn+ { mcPublicKey :: String+ , mcPrivateKey :: String+ , mcSessionID :: String+ , mcServerList :: [String]+ }++-- |A computation that interacts with the Mollom server.+data MollomMonad a = MollomMonad (MollomConn -> IO (a, MollomConn))++instance Monad MollomMonad where+ return a = MollomMonad $ \conn -> return (a, conn)++ (MollomMonad m) >>= k = MollomMonad $ \conn -> do+ (a, conn') <- m conn+ let (MollomMonad m') = k a+ m' conn'+++data MollomRequest = MollomRequest [(String, String)]++data MollomValue = MInt Int+ | MBool Bool+ | MDouble Double+ | MString String deriving (Show, Eq)++instance XmlRpcType MollomValue where+ toValue (MInt i) = toValue i+ toValue (MBool b) = toValue b+ toValue (MDouble d) = toValue d+ toValue (MString s) = toValue s++ fromValue (ValueInt i) = maybeToM "" (Just (MInt i))+ fromValue (ValueBool b) = maybeToM "" (Just (MBool b)) + fromValue (ValueDouble d) = maybeToM "" (Just (MDouble d))+ fromValue (ValueString s) = maybeToM "" (Just (MString s))+ + getType (MInt _) = TInt+ getType (MBool _) = TBool+ getType (MDouble _) = TDouble+ getType (MString _) = TString+++-- | make the actual XML-RPC call to the Mollom servers+service :: XmlRpcType a + => MollomConn -- ^connection to the Mollom service+ -> String -- ^remote function name+ -> MollomRequest -- ^request specific data + -> IO a+service conn function (MollomRequest fields) = do+ let publicKey = mcPublicKey conn+ privateKey = mcPrivateKey conn+ timeStamp = getMollomTime mollomTimeFormat+ nonce = getMollomNonce+ hash = authenticate publicKey privateKey timeStamp nonce+ requestStruct = [("public_key", publicKey), ("time", timeStamp), ("hash", hash), ("nonce", nonce)] ++ fields+ response <- remote (mollomFallbackServer ++ mollomApiVersion ++ "/") function requestStruct+ return response++-- | make the actual XML-RPC call to the Mollom server returning+-- the raw XML response, for debug purposes+service__ :: MollomConn -- ^connection to the Mollom service+ -> String -- ^remote function name+ -> MollomRequest -- ^request specific data+ -> IO String+service__ conn function (MollomRequest fields) = do+ let publicKey = mcPublicKey conn+ privateKey = mcPrivateKey conn+ timeStamp = getMollomTime mollomTimeFormat+ nonce = getMollomNonce+ hash = authenticate publicKey privateKey timeStamp nonce+ response <- post (mollomFallbackServer ++ mollomApiVersion ++ "/") (renderCall $ MethodCall function [toValue ([("public_key", publicKey), ("time", timeStamp), ("hash", hash), ("nonce", nonce)] ++ fields)] )+ return response+++-- | request a list of Mollom servers that can handle a site's calls.+getServerList :: MollomConn -- ^connection to the Mollom service+ -> IO [String]-- ^list of servers that can be used+getServerList conn = + service conn "mollom.getServerList" (MollomRequest [])+++-- | asks Mollom whether the specified message is legitimate.+checkContent :: MollomConn -- ^connection to the Mollom service+ -> [(String, String)] -- ^data+ -> IO [(String, MollomValue)] -- ^contains spam decision and session ID+checkContent conn ds = + service conn "mollom.checkContent" (MollomRequest ds) +++-- | tells Mollom that the specifieed message was spam or otherwise abusive.+sendFeedback :: MollomConn -- ^connection to the Mollom service+ -> String -- ^session ID+ -> String -- ^feedback: "spam", "profanity", "low-quality" or "unwanted"+ -> IO Bool -- ^always returns True+sendFeedback conn sessionID feedback = do + service conn "mollom.sendFeedback" (MollomRequest [("session_id", sessionID), ("feedback", feedback)])+++-- | requests Mollom to generate a image CAPTCHA.+getImageCaptcha :: MollomConn -- ^connection to the Mollom service+ -> Maybe String -- ^session ID+ -> Maybe String -- ^author IP address+ -> IO [(String, MollomValue)] -- ^session ID and CAPTCHA url+getImageCaptcha conn sessionID authorIP = do+ let ds = map (\(n, v) -> (n, fromJust v)) $ filter (isJust . snd) [("session_id", sessionID), ("author_ip", authorIP)]+ service conn "mollom.getImageCaptcha" (MollomRequest ds)+++-- | requests Mollom to generate an audio CAPTCHA+getAudioCaptcha :: MollomConn -- ^connection to the Mollom service+ -> Maybe String -- ^session ID+ -> Maybe String -- ^author IP address+ -> IO [(String, MollomValue)] -- ^session ID and CAPTCHA url+getAudioCaptcha conn sessionID authorIP = do+ let ds = map (\(n, v) -> (n, fromJust v)) $ filter (isJust . snd) [("session_id", sessionID), ("author_ip", authorIP)]+ service conn "mollom.getAudioCaptcha" (MollomRequest ds)+++-- | requests Mollom to verify the result of a CAPTCHA.+checkCaptcha :: MollomConn -- ^connection to the Mollom service+ -> String -- ^session ID associated with the CAPTCHA+ -> String -- ^solution to the CAPTCHA+ -> IO Bool -- ^True if correct, False if wrong+checkCaptcha conn sessionID solution = do+ let ds = [("session_id", sessionID), ("solution", solution)]+ service conn "mollom.checkCaptcha" (MollomRequest ds)+++-- | retrieves usage statistics from Mollom.+getStatistics :: MollomConn -- ^connection to the Mollom service+ -> String -- ^type of statistics demanded+ -- total_days — Number of days Mollom has been used.+ -- total_accepted — Total accepted posts.+ -- total_rejected — Total rejected spam posts.+ -- yesterday_accepted — Number of posts accepted yesterday.+ -- yesterday_rejected — Number of spam posts blocked yesterday.+ -- today_accepted — Number of posts accepted today.+ -- today_rejected — Number of spam posts rejected today.+ -> IO Int -- ^Value of requested statistic+getStatistics conn statType = do+ service conn "mollom.getStatistics" (MollomRequest [("type", statType)])+++-- | return a status value.+verifyKey :: MollomConn -- ^connection to the Mollom service+ -> IO Bool -- ^Always returns True+verifyKey conn = do+ service conn "mollom.verifyKey" (MollomRequest [])+++-- | analyze text and return its most likely language code.+detectLanguage :: MollomConn -- ^connection to the Mollom service+ -> String -- ^text to analyse+ -- -> IO [[DetectLanguageResponseStruct]] -- ^list of (language, confidence) tuples+ -> IO [[(String, MollomValue)]] -- ^list of (language, confidence) tuples+detectLanguage conn text = do+ service conn "mollom.detectLanguage" (MollomRequest [("text", text)]) +++-- | add text to your site's custom text blacklist.+addBlacklistText :: MollomConn -- ^connection to the Mollom service+ -> String -- ^text to blacklist+ -> String -- ^match used to search for the text, either "exact" or "contains"+ -> String -- ^reason: "spam", "profanity", "low-quality", or "unwanted"+ -> IO Bool -- ^always returns True+addBlacklistText conn text match reason = do+ let ds = [("text", text), ("match", match), ("reason", reason)]+ service conn "mollom.addBlacklistText" (MollomRequest ds)+++-- | remove text from your site's custom text blacklist.+removeBlacklistText :: MollomConn -- ^connection to the Mollom service+ -> String -- ^text to blacklist+ -> IO Bool -- ^always returns True+removeBlacklistText conn text = do+ let ds = [("text", text)]+ service conn "mollom.removeBlacklistText" (MollomRequest ds)+++-- | return the contents of your site's custom text blacklist.+listBlacklistText :: MollomConn -- ^connection to the Mollom service+ -- -> IO [[(String, MollomValue)]] -- ^List of the current blacklisted URLs for the website corresponding to the public and private keypair+ -> IO () -- ^List of the current blacklisted URLs for the website corresponding to the public and private keypair+listBlacklistText conn = do+ r <- service conn "mollom.listBlacklistText" (MollomRequest []) + p <- handleError fail (parseResponse r)+ putStrLn $ show p++-- | add a URL to your site's custom URL blacklist.+addBlacklistURL :: MollomConn -- ^connection to the Mollom service+ -> String -- ^URL to be added to custom URL blacklist for the website identified by the public and private keypair+ -> IO Bool -- ^always returns True+addBlacklistURL conn url = do+ let ds = [("url", url)]+ service conn "mollom.addBlacklistURL" (MollomRequest ds)+++-- | remove a URL from your site's custom URL blacklist.+removeBlacklistURL :: MollomConn -- ^connection to the Mollom service+ -> String -- ^URL to be removed from the custom URL blacklist for the website identified by the public and private keypair+ -> IO Bool -- ^always returns True+removeBlacklistURL conn url = do+ let ds = [("url", url)]+ service conn "mollom.removeBlacklistURL" (MollomRequest ds)+++-- | return the contents of your site's custom URL blacklist.+listBlacklistURL :: MollomConn -- ^connection to the Mollom service+ -> IO [[(String, MollomValue)]] -- ^List of the current blacklisted URLs for the website corresponding to the public and private keypair+listBlacklistURL conn = do+ service conn "mollom.listBlacklistURL" (MollomRequest [])++
+ src/Network/Mollom/Auth.hs view
@@ -0,0 +1,37 @@+-- | Takes care of the authentication on behalf of a Mollom client.+module Network.Mollom.Auth+ ( authenticate+ , getMollomTime+ , getMollomNonce+ ) where++import Codec.Binary.Base64(encode)+import Data.ByteString.Internal(c2w)+import Data.HMAC (hmac_sha1)+import Data.List (intersperse)+import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import System.IO.Unsafe (unsafePerformIO)+import System.Locale (defaultTimeLocale)++authenticate :: String -- ^public key+ -> String -- ^private key+ -> String -- ^timestamp+ -> String -- ^nonce+ -> String -- ^ resulting hash value, base64 encoded +authenticate publicKey privateKey timestamp nonce =+ let hash = hmac_sha1 (map c2w privateKey) $ map c2w . concat . (intersperse ":") $ [timestamp, nonce, privateKey]+ in encode hash +++getMollomTime :: String -- ^time format+ -> String -- ^current time in the specified format+getMollomTime format = + let time = unsafePerformIO $ getCurrentTime+ in formatTime defaultTimeLocale format time+++getMollomNonce :: String+getMollomNonce = "FIXME_NONCE"++