module TwoCaptcha.Internal.Types.ReCaptcha where

import Control.Lens (Lens', (%~), (&), (.~), (?~))
import Data.Text (Text)
import GHC.Base (Coercible)
import Network.Wreq.Lens (param)
import TwoCaptcha.Internal.Types.Captcha (Captcha, HasCaptchaLenses (method), HasCommonCaptchaLenses, HasCookies, HasPageURL, HasProxy, HasUserAgent, TimeoutDuration, defaultCaptcha, mkParamLens, mkParamLens', mkParamLensBool, options)

-- | Default parameters for solving a recaptcha. Internal use only.
defaultReCAPTCHA :: Captcha
defaultReCAPTCHA :: Captcha
defaultReCAPTCHA = Captcha
defaultCaptcha Captcha -> (Captcha -> Captcha) -> Captcha
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> Captcha -> Identity Captcha
forall a. HasCaptchaLenses a => Lens' a (Maybe Text)
method ((Maybe Text -> Identity (Maybe Text))
 -> Captcha -> Identity Captcha)
-> Text -> Captcha -> Captcha
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"userrecaptcha"

-- | Lenses for constructing ReCaptcha options.
class Coercible Captcha a => HasReCaptchaLenses a where
  -- | Defines if your ReCaptcha is enterprise.
  enterprise :: Lens' a (Maybe Bool)
  enterprise = Text -> Lens' a (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"enterprise"

  -- |
  -- If using 'ReCaptchaV2', this is the value of __k__ or __data-sitekey__ found on the captcha page.
  --
  -- If using 'ReCaptchaV3', this is the value of __sitekey__ found on the captcha page.
  googleKey :: Lens' a (Maybe Text)
  googleKey = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"googlekey"

  -- | Domain used to load the captcha: __google.com__ or __recaptcha.net__.
  domain :: Lens' a (Maybe Text)
  domain = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"domain"

-- | Parameters used to solve reCAPTCHA V2.
newtype ReCaptchaV2 = MkReCaptchaV2 Captcha deriving (Int -> ReCaptchaV2 -> ShowS
[ReCaptchaV2] -> ShowS
ReCaptchaV2 -> String
(Int -> ReCaptchaV2 -> ShowS)
-> (ReCaptchaV2 -> String)
-> ([ReCaptchaV2] -> ShowS)
-> Show ReCaptchaV2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReCaptchaV2] -> ShowS
$cshowList :: [ReCaptchaV2] -> ShowS
show :: ReCaptchaV2 -> String
$cshow :: ReCaptchaV2 -> String
showsPrec :: Int -> ReCaptchaV2 -> ShowS
$cshowsPrec :: Int -> ReCaptchaV2 -> ShowS
Show)

instance HasCommonCaptchaLenses ReCaptchaV2

instance HasCaptchaLenses ReCaptchaV2

instance HasReCaptchaLenses ReCaptchaV2

instance HasPageURL ReCaptchaV2

instance HasProxy ReCaptchaV2

instance HasUserAgent ReCaptchaV2

instance HasCookies ReCaptchaV2

-- |
-- Parameters used to solve reCAPTCHA V2.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'googleKey'
-- * 'TwoCaptcha.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'enterprise'
-- * 'domain'
-- * 'invisible'
-- * 'dataS'
-- * 'TwoCaptcha.Internal.Types.Captcha.cookies'
-- * 'TwoCaptcha.Internal.Types.Captcha.userAgent'
-- * 'TwoCaptcha.Internal.Types.Captcha.headerACAO'
-- * 'TwoCaptcha.Internal.Types.Captcha.pingback'
-- * 'TwoCaptcha.Internal.Types.Captcha.softId'
-- * 'TwoCaptcha.Internal.Types.Captcha.proxy'
-- * 'TwoCaptcha.Internal.Types.Captcha.proxyType'
reCAPTCHAV2 :: ReCaptchaV2
reCAPTCHAV2 :: ReCaptchaV2
reCAPTCHAV2 = Captcha -> ReCaptchaV2
MkReCaptchaV2 Captcha
defaultReCAPTCHA

-- | Defines if the reCAPTCHA v2 is invisible.
invisible :: Lens' ReCaptchaV2 (Maybe Bool)
invisible :: (Maybe Bool -> f (Maybe Bool)) -> ReCaptchaV2 -> f ReCaptchaV2
invisible = Text -> Lens' ReCaptchaV2 (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"invisible"

-- | Value of the __data-s__ parameter found on the reCAPTCHA page. Currently applicable for google services.
dataS :: Lens' ReCaptchaV2 (Maybe Text)
dataS :: (Maybe Text -> f (Maybe Text)) -> ReCaptchaV2 -> f ReCaptchaV2
dataS = Text -> Lens' ReCaptchaV2 (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"data-s"

-- | Parameters used to solve reCAPTCHA V3.
newtype ReCaptchaV3 = MkReCaptchaV3 Captcha deriving (Int -> ReCaptchaV3 -> ShowS
[ReCaptchaV3] -> ShowS
ReCaptchaV3 -> String
(Int -> ReCaptchaV3 -> ShowS)
-> (ReCaptchaV3 -> String)
-> ([ReCaptchaV3] -> ShowS)
-> Show ReCaptchaV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReCaptchaV3] -> ShowS
$cshowList :: [ReCaptchaV3] -> ShowS
show :: ReCaptchaV3 -> String
$cshow :: ReCaptchaV3 -> String
showsPrec :: Int -> ReCaptchaV3 -> ShowS
$cshowsPrec :: Int -> ReCaptchaV3 -> ShowS
Show)

instance HasCommonCaptchaLenses ReCaptchaV3

instance HasCaptchaLenses ReCaptchaV3

instance HasReCaptchaLenses ReCaptchaV3

instance HasPageURL ReCaptchaV3

-- |
-- Parameters used to solve reCAPTCHA V3.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'googleKey'
-- * 'TwoCaptcha.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'enterprise'
-- * 'domain'
-- * 'minScore'
-- * 'TwoCaptcha.Internal.Types.Captcha.headerACAO'
-- * 'TwoCaptcha.Internal.Types.Captcha.pingback'
-- * 'TwoCaptcha.Internal.Types.Captcha.softId'
-- * 'TwoCaptcha.Internal.Types.Captcha.proxy'
-- * 'TwoCaptcha.Internal.Types.Captcha.proxyType'
reCAPTCHAV3 :: ReCaptchaV3
reCAPTCHAV3 :: ReCaptchaV3
reCAPTCHAV3 = Captcha -> ReCaptchaV3
MkReCaptchaV3 (Captcha
defaultReCAPTCHA Captcha -> (Captcha -> Captcha) -> Captcha
forall a b. a -> (a -> b) -> b
& (Options -> Identity Options) -> Captcha -> Identity Captcha
Lens' Captcha Options
options ((Options -> Identity Options) -> Captcha -> Identity Captcha)
-> (Options -> Options) -> Captcha -> Captcha
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"version" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
"v3"]))

-- | The score needed for resolution. Currently it's almost impossible to get a token with a score higher than 0.3
minScore :: Lens' ReCaptchaV3 (Maybe Double)
minScore :: (Maybe Double -> f (Maybe Double)) -> ReCaptchaV3 -> f ReCaptchaV3
minScore = Text -> Lens' ReCaptchaV3 (Maybe Double)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"min_score"

-- | Default reCAPTCHA timeout duration (600 seconds).
reCAPTCHATimeout :: TimeoutDuration
reCAPTCHATimeout :: TimeoutDuration
reCAPTCHATimeout = TimeoutDuration
600000