yesod-recaptcha (empty) → 0.1

raw patch · 4 files changed

+304/−0 lines, 4 filesdep +basedep +bytestringdep +conduitsetup-changed

Dependencies added: base, bytestring, conduit, data-default, http-conduit, http-types, lifted-base, network, network-info, text, wai, yesod-auth, yesod-core, yesod-form

Files

LICENSE +30/−0
Setup.hs +2/−0
src/Yesod/ReCAPTCHA.hs +229/−0
yesod-recaptcha.cabal +43/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c)2012, Felipe Lessa++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 Felipe Lessa nor the names of other+      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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ src/Yesod/ReCAPTCHA.hs view

@@ -0,0 +1,229 @@+module Yesod.ReCAPTCHA+    ( YesodReCAPTCHA(..)+    , recaptchaAForm+    , recaptchaMForm+    , recaptchaOptions+    , RecaptchaOptions(..)+    ) where++import Control.Applicative+import Data.Typeable (Typeable)+import Yesod.Widget (whamlet)+import qualified Control.Exception.Lifted as E+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.Conduit as C+import qualified Data.Default as D+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TEE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Network.HTTP.Conduit as H+import qualified Network.HTTP.Types as HT+import qualified Network.Info as NI+import qualified Network.Socket as HS+import qualified Network.Wai as W+import qualified Yesod.Auth as YA+import qualified Yesod.Core as YC+import qualified Yesod.Form.Fields as YF+import qualified Yesod.Form.Functions as YF+import qualified Yesod.Form.Types as YF+++-- | Class used by @yesod-recaptcha@'s fields.  It should be+-- fairly easy to implement a barebones instance of this class+-- for you foundation data type:+--+-- > instance YesodReCAPTCHA MyType where+-- >   recaptchaPublicKey  = return "[your public key]"+-- >   recaptchaPrivateKey = return "[your private key]"+--+-- You may also write a more sophisticated instance.  For+-- example, you may get these values from your @settings.yml@+-- instead of hardcoding them. Or you may give different keys+-- depending on the request (maybe you're serving to two+-- different domains in the same application).+--+-- The 'YA.YesodAuth' superclass is used only for the HTTP+-- request.  Please fill a bug report if you think that this+-- @YesodReCAPTCHA@ may be useful without @YesodAuth@.+class YA.YesodAuth master => YesodReCAPTCHA master where+    recaptchaPublicKey  :: YC.GHandler sub master T.Text+    recaptchaPrivateKey :: YC.GHandler sub master T.Text+++-- | A reCAPTCHA field.  This 'YF.AForm' returns @()@ because+-- CAPTCHAs give no useful information besides having being typed+-- correctly or not.  When the user does not type the CAPTCHA+-- correctly, this 'YF.AForm' will automatically fail in the same+-- way as any other @yesod-form@ widget fails, so you may just+-- ignore the @()@ value.+recaptchaAForm :: YesodReCAPTCHA master => YF.AForm sub master ()+recaptchaAForm = YF.formToAForm recaptchaMForm+++-- | Same as 'recaptchaAForm', but instead of being an+-- 'YF.AForm', it's an 'YF.MForm'.+recaptchaMForm :: YesodReCAPTCHA master =>+                  YF.MForm sub master ( YF.FormResult ()+                                      , [YF.FieldView sub master] )+recaptchaMForm = do+  challengeField <- fakeField "recaptcha_challenge_field"+  responseField  <- fakeField "recaptcha_response_field"+  ret <- maybe (return Nothing)+               (YC.lift . fmap Just . uncurry check)+               ((,) <$> challengeField <*> responseField)+  let view = recaptchaWidget $ case ret of+                                 Just (Error err) -> Just err+                                 _                -> Nothing+      formRet = case ret of+                  Nothing        -> YF.FormMissing+                  Just Ok        -> YF.FormSuccess ()+                  Just (Error _) -> YF.FormFailure []+      formView = YF.FieldView+                   { YF.fvLabel    = ""+                   , YF.fvTooltip  = Nothing+                   , YF.fvId       = "recaptcha_challenge_field"+                   , YF.fvInput    = view+                   , YF.fvErrors   = Nothing+                   , YF.fvRequired = True+                   }+  return (formRet, [formView])+++-- | Widget with reCAPTCHA's HTML.+recaptchaWidget :: YesodReCAPTCHA master =>+                   Maybe T.Text -- ^ Error code, if any.+                -> YC.GWidget sub master ()+recaptchaWidget merr = do+  publicKey <- YC.lift recaptchaPublicKey+  isSecure  <- W.isSecure <$> YC.lift YC.waiRequest+  let proto | isSecure  = "https"+            | otherwise = "http" :: T.Text+      err = maybe "" (T.append "&error=") merr+  [whamlet|+    <script src="#{proto}://www.google.com/recaptcha/api/challenge?k=#{publicKey}#{err}">+    <noscript>+       <iframe src="#{proto}://www.google.com/recaptcha/api/noscript?k=#{publicKey}#{err}"+           height="300" width="500" frameborder="0">+       <br>+       <textarea name="recaptcha_challenge_field" rows="3" cols="40">+       <input type="hidden" name="recaptcha_response_field" value="manual_challenge">+  |]+++-- | Contact reCAPTCHA servers and find out if the user correctly+-- guessed the CAPTCHA.  Unfortunately, reCAPTCHA doesn't seem to+-- provide an HTTPS endpoint for this API even though we need to+-- send our private key.+check :: YesodReCAPTCHA master =>+         T.Text -- ^ @recaptcha_challenge_field@+      -> T.Text -- ^ @recaptcha_response_field@+      -> YC.GHandler sub master CheckRet+check "" _ = return $ Error "invalid-request-cookie"+check _ "" = return $ Error "incorrect-captcha-sol"+check challenge response = do+  manager    <- YA.authHttpManager <$> YC.getYesod+  privateKey <- recaptchaPrivateKey+  sockaddr   <- W.remoteHost <$> YC.waiRequest+  case sockaddr of+    HS.SockAddrUnix _ -> do+      $(YC.logError) $ "Yesod.ReCAPTCHA: Couldn't find out remote IP, \+                       \are you using a reverse proxy?  If yes, then \+                       \please file a bug report at \+                       \<https://github.com/meteficha/yesod-recaptcha>."+      fail "Could not find remote IP address for reCAPTCHA."+    _ -> do+      let remoteip = case sockaddr of+                       HS.SockAddrInet _ hostAddr ->+                         show $ NI.IPv4 hostAddr+                       HS.SockAddrInet6 _ _ (w1, w2, w3, w4) _ ->+                         show $ NI.IPv6 w1 w2 w3 w4+                       HS.SockAddrUnix _ -> error "ReCAPTCHA.check"+          req = H.def+                  { H.method      = HT.methodPost+                  , H.host        = "www.google.com"+                  , H.path        = "/recaptcha/api/verify"+                  , H.queryString = HT.renderSimpleQuery False query+                  }+          query = [ ("privatekey", TE.encodeUtf8 privateKey)+                  , ("remoteip",   B8.pack       remoteip)+                  , ("challenge",  TE.encodeUtf8 challenge)+                  , ("response",   TE.encodeUtf8 response)+                  ]+      eresp <- E.try $ C.runResourceT $ H.httpLbs req manager+      case (L8.lines . H.responseBody) <$> eresp of+        Right ("true":_)      -> return Ok+        Right ("false":why:_) -> return . Error . TL.toStrict $+                                 TLE.decodeUtf8With TEE.lenientDecode why+        Right other -> do+          $(YC.logError) $ T.concat [ "Yesod.ReCAPTCHA: could not parse "+                                    , T.pack (show other) ]+          return (Error "recaptcha-not-reachable")+        Left exc -> do+          $(YC.logError) $ T.concat [ "Yesod.ReCAPTCHA: could not contact server ("+                                    , T.pack (show (exc :: E.SomeException))+                                    , ")" ]+          return (Error "recaptcha-not-reachable")+++-- | See 'check'.+data CheckRet = Ok | Error T.Text+++-- | A fake field.  Just returns the value of a field.+fakeField :: (YC.RenderMessage master YF.FormMessage) =>+             T.Text -- ^ Field id.+          -> YF.MForm sub master (Maybe T.Text)+fakeField fid = YC.lift $ do mt1 <- YC.lookupGetParam fid+                             case mt1 of+                               Nothing -> YC.lookupPostParam fid+                               Just _  -> return mt1+++-- | Define the given 'RecaptchaOptions' for all forms declared+-- after this widget.  This widget may be used anywhere, on the+-- @<head>@ or on the @<body>@.+--+-- Note that this is /not/ required to use 'recaptchaAForm' or+-- 'recaptchaMForm'.+recaptchaOptions :: YC.Yesod master =>+                    RecaptchaOptions+                 -> YC.GWidget sub master ()+recaptchaOptions s | s == D.def = return ()+recaptchaOptions s =+  [whamlet|+    <script>+      var RecaptchaOptions = {+      $maybe t <- theme s+        theme : '#{t}',+      $maybe l <- lang s+        lang : '#{l}',+      x : 'x'+      };+    </script>+  |]+++-- | Options that may be given to reCAPTCHA.  In order to use+-- them on your site, use `recaptchaOptions` anywhere before the+-- form that contains the `recaptchaField`.+--+-- Note that there's an instance for 'D.Default', so you may use+-- 'D.def'.+data RecaptchaOptions =+  RecaptchaOptions {+      -- | Theme of the reCAPTCHA field.  Currently may be+      -- @\"red\"@, @\"white\"@, @\"blackglass\"@ or @\"clean\"@.+      -- A value of @Nothing@ uses the default.+      theme :: Maybe T.Text++      -- | Language.+    , lang :: Maybe T.Text+    }+  deriving (Eq, Ord, Show, Typeable)++-- | Allows you to use 'D.def' and get sane default values.+instance D.Default RecaptchaOptions where+    def = RecaptchaOptions Nothing Nothing

+ yesod-recaptcha.cabal view

@@ -0,0 +1,43 @@+Name:                yesod-recaptcha+Version:             0.1+Synopsis:            Dead simple support for reCAPTCHA on Yesod applications.+Homepage:            https://github.com/meteficha/yesod-recaptcha+License:             BSD3+License-file:        LICENSE+Author:              Felipe Lessa+Maintainer:          felipe.lessa@gmail.com+Category:            Web+Build-type:          Simple+Cabal-version:       >=1.8+-- Copyright:+-- Extra-source-files:++Description:+  This package provides support for reCAPTCHA+  (<http://www.google.com/recaptcha>) on Yesod applications.++Source-repository head+  type:     git+  location: git://github.com/meteficha/yesod-recaptcha.git++Library+  Hs-source-dirs: src+  GHC-options: -Wall+  Exposed-modules: Yesod.ReCAPTCHA+  Extensions: DeriveDataTypeable FlexibleContexts TemplateHaskell+              QuasiQuotes OverloadedStrings+  Build-depends:+      base           == 4.*+    , bytestring+    , text+    , data-default   == 0.3.*+    , lifted-base    == 0.1.*+    , yesod-core     == 0.10.*+    , yesod-auth     == 0.8.*+    , yesod-form     == 0.4.*+    , wai+    , network+    , network-info   == 0.2.*+    , http-conduit   == 1.2.*+    , http-types+    , conduit        >= 0.1   && < 0.3