diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2008 John MacFarlane +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +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. + +Neither the name of John MacFarlane nor the names of this software's +contributors may be used to endorse or promote products derived from +this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"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 COPYRIGHT OWNER OR +CONTRIBUTORS 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. diff --git a/Network/Captcha/ReCaptcha.hs b/Network/Captcha/ReCaptcha.hs new file mode 100644 --- /dev/null +++ b/Network/Captcha/ReCaptcha.hs @@ -0,0 +1,92 @@ +{- +Copyright (c) 2008 John MacFarlane +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +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. + +Neither the name of John MacFarlane nor the names of this software's +contributors may be used to endorse or promote products derived from +this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"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 COPYRIGHT OWNER OR +CONTRIBUTORS 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. +-} + +module Network.Captcha.ReCaptcha + ( captchaFields + , validateCaptcha + ) +where +import Text.XHtml +import Network.Browser +import Network.HTTP +import Network.URI + +-- | Returns HTML element to be inserted in the form for which a CAPTCHA is wanted. +captchaFields :: String -- ^ reCAPTCHA public key + -> Maybe String -- ^ @Nothing@ or @Just@ an error message returned by previous validate attempt + -> Html +captchaFields recaptchaPublicKey mbErrorMsg = + (script ! [src (captchaURL "challenge"), thetype "text/javascript"] << noHtml) +++ + noscript << [ iframe ! [src (captchaURL "noscript"), height "300", width "500", frameborder 0] << noHtml + , br + , textarea ! [name "recaptcha_challenge_field", rows "3", cols "40"] << noHtml + , input ! [thetype "hidden", name "recaptcha_response_field", value "manual_challenge"] + ] + where captchaURL s = "http://api.recaptcha.net/" ++ s ++ "?k=" ++ recaptchaPublicKey ++ + case mbErrorMsg of + Just e -> "?error=" ++ e + Nothing -> "" + +-- | Verify a CAPTCHA. +validateCaptcha :: String -- ^ reCAPTCHA private key + -> String -- ^ IP address of the user who solved the CAPTCHA + -> String -- ^ value of the recaptcha_challenge_field + -> String -- ^ value of the recaptcha_response_field + -> IO (Either String ()) -- ^ @Left@ error message, or @Right ()@ for success +validateCaptcha recaptchaPrivateKey ipaddress challenge response = do + let verifyURIString = "http://api-verify.recaptcha.net/verify" + let verifyURI = case parseURI verifyURIString of + Just uri -> uri + Nothing -> error $ "Could not parse URI: " ++ verifyURIString + let contents = urlEncodeVars [("privatekey", recaptchaPrivateKey), + ("remoteip", ipaddress), + ("challenge", challenge), + ("response", response)] + let req = Request { rqURI = verifyURI, + rqMethod = POST, + rqHeaders = [ Header HdrContentType "application/x-www-form-urlencoded", + Header HdrContentLength (show $ length contents) ], + rqBody = contents } + (_, resp) <- browse (request req) + if rspCode resp == (2,0,0) + then do + let respLines = lines $ rspBody resp + if null respLines + then return $ Left "response-body-empty" + else if head respLines == "true" + then return $ Right () + else if length respLines >= 2 + then return $ Left $ respLines !! 1 + else return $ Left "no-error-message" + else return $ Left "response-code-not-200" + + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/recaptcha.cabal b/recaptcha.cabal new file mode 100644 --- /dev/null +++ b/recaptcha.cabal @@ -0,0 +1,25 @@ +Name: recaptcha +Version: 0.1 +Cabal-Version: >= 1.2 +Build-Type: Custom +License: BSD3 +License-File: LICENSE +Copyright: (c) 2008 John MacFarlane +Author: John MacFarlane +Maintainer: John MacFarlane +Stability: alpha +Category: Network +Tested-With: GHC +Homepage: http://github.com/jgm/recaptcha/tree/master +Synopsis: Functions for using the reCAPTCHA service in web applications. +Description: reCAPTCHA (http://recaptcha.net/) is a service that provides + captchas for preventing automated spam in web applications. + recaptcha-hs provides functions for using reCAPTCHA in Haskell + web applications. +Library + Build-Depends: base, HTTP >= 3001.1.4, xhtml >= 3000.0, network >= 2.2.0.1 + Hs-Source-Dirs: . + Exposed-Modules: Network.Captcha.ReCaptcha + Ghc-Options: -Wall -threaded + Ghc-Prof-Options: -auto-all +