module TwoCaptcha.Internal.Types.HCaptcha where

import Control.Lens (Lens', (&), (?~))
import Data.Text (Text)
import TwoCaptcha.Internal.Types.Captcha (Captcha, HasCaptchaLenses (method), HasCommonCaptchaLenses, HasPageURL, HasProxy, defaultCaptcha, mkParamLens, mkParamLensBool)

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

instance HasCommonCaptchaLenses HCaptcha

instance HasCaptchaLenses HCaptcha

instance HasPageURL HCaptcha

instance HasProxy HCaptcha

-- |
-- Parameters used to solve hCaptcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'sitekey'
-- * 'TwoCaptcha.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'hInvisible'
-- * 'customData'
-- * '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'
hCaptcha :: HCaptcha
hCaptcha :: HCaptcha
hCaptcha = Captcha -> HCaptcha
MkHCaptcha (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
"hcaptcha")

-- | Value of __data-sitekey__ parameter on target website.
siteKey :: Lens' HCaptcha (Maybe Text)
siteKey :: (Maybe Text -> f (Maybe Text)) -> HCaptcha -> f HCaptcha
siteKey = Text -> Lens' HCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"sitekey"

-- | Defines if the captcha is invisible. Invisible hCaptchas are currently a rare case.
hInvisible :: Lens' HCaptcha (Maybe Bool)
hInvisible :: (Maybe Bool -> f (Maybe Bool)) -> HCaptcha -> f HCaptcha
hInvisible = Text -> Lens' HCaptcha (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"invisible"

-- |
-- Custom data that is used in some implementations of hCaptcha, mostly with invisible captchas.
-- In most cases, you see it as __rqdata__ inside network requests.
--
-- __IMPORTANT__: you MUST provide 'userAgent' if you submit with 'customData'.
-- The value should match the User-Agent you use when interacting with target website.
customData :: Lens' HCaptcha (Maybe Text)
customData :: (Maybe Text -> f (Maybe Text)) -> HCaptcha -> f HCaptcha
customData = Text -> Lens' HCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"data"