module TwoCaptcha.Internal.Types.GeeTestCaptcha where

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

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

instance HasCommonCaptchaLenses GeeTestCaptcha

instance HasCaptchaLenses GeeTestCaptcha

instance HasPageURL GeeTestCaptcha

instance HasProxy GeeTestCaptcha

-- |
-- Parameters used to solve a GeeTest captcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'gt'
-- * 'challenge'
-- * 'TwoCaptcha.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'apiServer'
-- * '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'
geeTestCaptcha :: GeeTestCaptcha
geeTestCaptcha :: GeeTestCaptcha
geeTestCaptcha = Captcha -> GeeTestCaptcha
MkGeeTestCaptcha (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
"geetest")

-- | Value of __gt__ parameter you found on target website.
gt :: Lens' GeeTestCaptcha (Maybe Text)
gt :: (Maybe Text -> f (Maybe Text))
-> GeeTestCaptcha -> f GeeTestCaptcha
gt = Text -> Lens' GeeTestCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"gt"

-- | Value of __challenge__ parameter you found on target website.
challenge :: Lens' GeeTestCaptcha (Maybe Text)
challenge :: (Maybe Text -> f (Maybe Text))
-> GeeTestCaptcha -> f GeeTestCaptcha
challenge = Text -> Lens' GeeTestCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"challenge"

-- | Value of __api_server__ parameter you found on target website.
apiServer :: Lens' GeeTestCaptcha (Maybe Text)
apiServer :: (Maybe Text -> f (Maybe Text))
-> GeeTestCaptcha -> f GeeTestCaptcha
apiServer = Text -> Lens' GeeTestCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"api_server"