yesod-recaptcha2 0.3.0 → 1.0.0
raw patch · 2 files changed
+85/−92 lines, 2 files
Files
- src/Yesod/ReCaptcha2.hs +81/−89
- yesod-recaptcha2.cabal +4/−3
src/Yesod/ReCaptcha2.hs view
@@ -5,46 +5,44 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TupleSections #-} module Yesod.ReCaptcha2- ( YesodReCaptcha(..)- -- * ReCaptcha V2- , reCaptcha- , mReCaptcha- -- * Invisible ReCaptcha- -- $invisibleReCaptcha- , reCaptchaInvisible- , mReCaptchaInvisible- , reCaptchaInvisibleForm- ) where+ ( YesodReCaptcha(..)+ -- * ReCaptcha V2+ , reCaptcha+ , mReCaptcha+ -- * Invisible ReCaptcha+ -- $invisibleReCaptcha+ , reCaptchaInvisible+ , mReCaptchaInvisible+ , reCaptchaInvisibleForm+ )+where import ClassyPrelude import Data.Aeson import Network.HTTP.Simple import Yesod.Auth import Yesod.Core-import Yesod.Core.Handler-import Yesod.Core.Types-import Yesod.Core.Widget import Yesod.Form.Functions import Yesod.Form.Types -- | default key is testing. you should impl reCaptchaSiteKey and reCaptchaSecretKey class YesodAuth site => YesodReCaptcha site where- reCaptchaSiteKey :: HandlerFor site Text- reCaptchaSiteKey = pure "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"- reCaptchaSecretKey :: HandlerFor site Text- reCaptchaSecretKey = pure "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe"- -- | with specific language from- -- <https://developers.google.com/recaptcha/docs/language>- --- -- > reCaptchaLanguage = pure (Just "ru")- reCaptchaLanguage :: HandlerFor site (Maybe Text)- reCaptchaLanguage = pure Nothing+ reCaptchaSiteKey :: HandlerFor site Text+ reCaptchaSiteKey = pure "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"+ reCaptchaSecretKey :: HandlerFor site Text+ reCaptchaSecretKey = pure "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe"+ -- | with specific language from+ -- <https://developers.google.com/recaptcha/docs/language>+ --+ -- > reCaptchaLanguage = pure (Just "ru")+ reCaptchaLanguage :: HandlerFor site (Maybe Text)+ reCaptchaLanguage = pure Nothing newtype SiteverifyResponse- = SiteverifyResponse- { success :: Bool- }- deriving (Eq, Ord, Read, Show, Generic, FromJSON, ToJSON)+ = SiteverifyResponse+ { success :: Bool+ }+ deriving (Eq, Ord, Read, Show, Generic, FromJSON, ToJSON) -- | for Applicative style form reCaptcha :: YesodReCaptcha site => AForm (HandlerFor site) ()@@ -52,48 +50,43 @@ -- | for Monadic style form mReCaptcha- :: YesodReCaptcha site =>- MForm (HandlerFor site) (FormResult (), [FieldView site])+ :: YesodReCaptcha site+ => MForm (HandlerFor site) (FormResult (), [FieldView site]) mReCaptcha = do- result <- lift formResult- return (result, [fieldViewSite])- where formResult = do- postParam <- lookupPostParam "g-recaptcha-response"- case postParam of- Nothing -> return FormMissing- Just response -> do- secret <- reCaptchaSecretKey- SiteverifyResponse{success} <- liftIO $ do- req <-- parseRequest- "POST https://www.google.com/recaptcha/api/siteverify"- res <- httpJSON $- setRequestBodyURLEncoded- [ ("secret", encodeUtf8 secret)- , ("response", encodeUtf8 response)- ]- req- return $ getResponseBody res- return $ if success- then FormSuccess ()- else FormFailure ["reCaptcha error"]- fieldViewSite = FieldView- { fvLabel = mempty- , fvTooltip = Nothing- , fvId = ""- , fvInput = do- mReCaptchaLanguage <- handlerToWidget reCaptchaLanguage- case mReCaptchaLanguage of- Nothing ->- addScriptRemote "https://www.google.com/recaptcha/api.js"- Just hl ->- addScriptRemote $- "https://www.google.com/recaptcha/api.js?hl=" <> hl- siteKey <- handlerToWidget reCaptchaSiteKey- [whamlet|<div .g-recaptcha data-sitekey=#{siteKey}>|]- , fvErrors = Nothing- , fvRequired = True- }+ result <- lift formResult+ return (result, [fieldViewSite])+ where+ formResult = do+ postParam <- lookupPostParam "g-recaptcha-response"+ case postParam of+ Nothing -> return FormMissing+ Just response -> do+ secret <- reCaptchaSecretKey+ SiteverifyResponse { success } <- liftIO $ do+ req <- parseRequest+ "POST https://www.google.com/recaptcha/api/siteverify"+ res <- httpJSON $ setRequestBodyURLEncoded+ [("secret", encodeUtf8 secret), ("response", encodeUtf8 response)]+ req+ return $ getResponseBody res+ return $ if success+ then FormSuccess ()+ else FormFailure ["reCaptcha error"]+ fieldViewSite = FieldView+ { fvLabel = mempty+ , fvTooltip = Nothing+ , fvId = ""+ , fvInput = do+ mReCaptchaLanguage <- handlerToWidget reCaptchaLanguage+ case mReCaptchaLanguage of+ Nothing -> addScriptRemote "https://www.google.com/recaptcha/api.js"+ Just hl ->+ addScriptRemote $ "https://www.google.com/recaptcha/api.js?hl=" <> hl+ siteKey <- handlerToWidget reCaptchaSiteKey+ [whamlet|<div .g-recaptcha data-sitekey=#{siteKey}>|]+ , fvErrors = Nothing+ , fvRequired = True+ } -- $invisibleReCaptcha --@@ -120,7 +113,7 @@ -- | check for Applicative style form reCaptchaInvisible :: YesodReCaptcha site => AForm (HandlerFor site) ()-reCaptchaInvisible = formToAForm ((,[]) <$> mReCaptchaInvisible)+reCaptchaInvisible = formToAForm ((, []) <$> mReCaptchaInvisible) -- | check for Monadic style form mReCaptchaInvisible@@ -129,30 +122,29 @@ -- | generate all required parts (except the check) for a Invisible ReCaptcha reCaptchaInvisibleForm- :: YesodReCaptcha site- => Maybe Text -- ^ The id of the form, a new will be created when 'Nothing' is passed- -> Maybe Text+ :: YesodReCaptcha site+ => Maybe Text -- ^ The id of the form, a new will be created when 'Nothing' is passed+ -> Maybe Text -- ^ The javascript to call after a successful captcha, -- it has to submit the form, a simple one will be generated when 'Nothing' is passed- -> HandlerFor site (Text, WidgetFor site (), [(Text, Text)])+ -> HandlerFor site (Text, WidgetFor site (), [(Text, Text)]) reCaptchaInvisibleForm mIdent mScript = do- mReCaptchaLanguage <- reCaptchaLanguage- siteKey <- reCaptchaSiteKey- identForm <- maybe newIdent return mIdent- scriptName <- maybe (("reCaptchaOnSubmit_" <>) <$> newIdent) return mScript- let- widget = do+ mReCaptchaLanguage <- reCaptchaLanguage+ siteKey <- reCaptchaSiteKey+ identForm <- maybe newIdent return mIdent+ scriptName <- maybe (("reCaptchaOnSubmit_" <>) <$> newIdent) return mScript+ let widget = do case mReCaptchaLanguage of- Nothing ->- addScriptRemote "https://www.google.com/recaptcha/api.js"+ Nothing -> addScriptRemote "https://www.google.com/recaptcha/api.js" Just hl ->- addScriptRemote $ "https://www.google.com/recaptcha/api.js?hl=" <> hl- when (isNothing mScript) $- toWidgetHead [hamlet|+ addScriptRemote+ $ "https://www.google.com/recaptcha/api.js?hl="+ <> hl+ when (isNothing mScript) $ toWidgetHead [hamlet| <script>function #{scriptName}(token) { document.getElementById("#{identForm}").submit(); } |]- return- ( identForm- , widget- , [("data-sitekey", siteKey), ("data-callback", scriptName)]- )+ return+ ( identForm+ , widget+ , [("data-sitekey", siteKey), ("data-callback", scriptName)]+ )
yesod-recaptcha2.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 2b3e3fe3c6054faefe316aba4920104bb8025b052b3857c3ff5444752b269ae7+-- hash: 0cafa0f7133c8a452ecf0b1ed89843c8196dc8e6fef8abd2bfc61258a823a83c name: yesod-recaptcha2-version: 0.3.0+version: 1.0.0 synopsis: yesod recaptcha2 description: recaptcha2 for yesod-form category: Web@@ -29,6 +29,7 @@ library hs-source-dirs: src+ ghc-options: -Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-exported-signatures -Wmissing-home-modules -Wredundant-constraints -Wcompat build-depends: aeson , base >=4.7 && <5