yesod-recaptcha 1.1.0.4 → 1.4
raw patch · 2 files changed
Files
- src/Yesod/ReCAPTCHA.hs +54/−56
- yesod-recaptcha.cabal +7/−7
src/Yesod/ReCAPTCHA.hs view
@@ -8,11 +8,11 @@ import Control.Applicative import Data.Typeable (Typeable)-import Yesod.Widget (whamlet)+import Yesod.Core (whamlet) import qualified Control.Exception.Lifted as E+import qualified Control.Monad.Trans.Resource as R 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@@ -51,11 +51,11 @@ -- -- /Minimum complete definition:/ 'recaptchaPublicKey' and -- 'recaptchaPrivateKey'.-class YA.YesodAuth master => YesodReCAPTCHA master where+class YA.YesodAuth site => YesodReCAPTCHA site where -- | Your reCAPTCHA public key.- recaptchaPublicKey :: YC.GHandler sub master T.Text+ recaptchaPublicKey :: YC.HandlerT site IO T.Text -- | Your reCAPTCHA private key.- recaptchaPrivateKey :: YC.GHandler sub master T.Text+ recaptchaPrivateKey :: YC.HandlerT site IO T.Text -- | A backdoor to the reCAPTCHA mechanism. While doing -- automated tests you may need to fill a form that is -- protected by a CAPTCHA. The whole point of using a@@ -83,7 +83,7 @@ -- -- By default, this function returns @Nothing@, which -- completely disables the backdoor.- insecureRecaptchaBackdoor :: YC.GHandler sub master (Maybe T.Text)+ insecureRecaptchaBackdoor :: YC.HandlerT site IO (Maybe T.Text) insecureRecaptchaBackdoor = return Nothing @@ -93,15 +93,16 @@ -- 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 :: YesodReCAPTCHA site => YF.AForm (YC.HandlerT site IO) () 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 :: YesodReCAPTCHA site =>+ YF.MForm (YC.HandlerT site IO)+ ( YF.FormResult ()+ , [YF.FieldView site] ) recaptchaMForm = do challengeField <- fakeField "recaptcha_challenge_field" responseField <- fakeField "recaptcha_response_field"@@ -127,12 +128,12 @@ -- | Widget with reCAPTCHA's HTML.-recaptchaWidget :: YesodReCAPTCHA master =>+recaptchaWidget :: YesodReCAPTCHA site => Maybe T.Text -- ^ Error code, if any.- -> YC.GWidget sub master ()+ -> YC.WidgetT site IO () recaptchaWidget merr = do- publicKey <- YC.lift recaptchaPublicKey- isSecure <- W.isSecure <$> YC.lift YC.waiRequest+ publicKey <- YC.handlerToWidget recaptchaPublicKey+ isSecure <- W.isSecure <$> YC.waiRequest let proto | isSecure = "https" | otherwise = "http" :: T.Text err = maybe "" (T.append "&error=") merr@@ -151,10 +152,10 @@ -- 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 =>+check :: YesodReCAPTCHA site => T.Text -- ^ @recaptcha_challenge_field@ -> T.Text -- ^ @recaptcha_response_field@- -> YC.GHandler sub master CheckRet+ -> YC.HandlerT site IO CheckRet check "" _ = return $ Error "invalid-request-cookie" check _ "" = return $ Error "incorrect-captcha-sol" check challenge response = do@@ -165,45 +166,42 @@ 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, \+ remoteip <- case sockaddr of+ HS.SockAddrInet _ hostAddr ->+ return . show $ NI.IPv4 hostAddr+ HS.SockAddrInet6 _ _ (w1, w2, w3, w4) _ ->+ return . show $ NI.IPv6 w1 w2 w3 w4+ _ -> 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")+ fail "Could not find remote IP address for reCAPTCHA."+ let req = D.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 $ R.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'.@@ -211,9 +209,9 @@ -- | A fake field. Just returns the value of a field.-fakeField :: (YC.RenderMessage master YF.FormMessage) =>+fakeField :: (YC.RenderMessage site YF.FormMessage) => T.Text -- ^ Field id.- -> YF.MForm sub master (Maybe T.Text)+ -> YF.MForm (YC.HandlerT site IO) (Maybe T.Text) fakeField fid = YC.lift $ do mt1 <- YC.lookupGetParam fid case mt1 of Nothing -> YC.lookupPostParam fid@@ -226,9 +224,9 @@ -- -- Note that this is /not/ required to use 'recaptchaAForm' or -- 'recaptchaMForm'.-recaptchaOptions :: YC.Yesod master =>+recaptchaOptions :: YC.Yesod site => RecaptchaOptions- -> YC.GWidget sub master ()+ -> YC.WidgetT site IO () recaptchaOptions s | s == D.def = return () recaptchaOptions s = [whamlet|
yesod-recaptcha.cabal view
@@ -1,7 +1,7 @@ Name: yesod-recaptcha-Version: 1.1.0.4+Version: 1.4 Synopsis: Dead simple support for reCAPTCHA on Yesod applications.-Homepage: https://github.com/meteficha/yesod-recaptcha+Homepage: https://github.com/prowdsponsor/yesod-recaptcha License: BSD3 License-file: LICENSE Author: Felipe Lessa@@ -18,7 +18,7 @@ Source-repository head type: git- location: git://github.com/meteficha/yesod-recaptcha.git+ location: git://github.com/prowdsponsor/yesod-recaptcha.git Library Hs-source-dirs: src@@ -32,12 +32,12 @@ , text , data-default , lifted-base >= 0.1- , yesod-core == 1.1.*- , yesod-auth == 1.1.*- , yesod-form >= 1.1 && < 1.3+ , yesod-core >= 1.2 && < 1.5+ , yesod-auth >= 1.2 && < 1.5+ , yesod-form >= 1.3 && < 1.5 , wai , network , network-info == 0.2.* , http-conduit >= 1.5 , http-types- , conduit >= 0.5 && < 1.1+ , resourcet