module TwoCaptcha.Internal.Types.FunCaptcha 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 FunCaptcha.
newtype FunCaptcha = MkFunCaptcha Captcha deriving (Int -> FunCaptcha -> ShowS
[FunCaptcha] -> ShowS
FunCaptcha -> String
(Int -> FunCaptcha -> ShowS)
-> (FunCaptcha -> String)
-> ([FunCaptcha] -> ShowS)
-> Show FunCaptcha
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunCaptcha] -> ShowS
$cshowList :: [FunCaptcha] -> ShowS
show :: FunCaptcha -> String
$cshow :: FunCaptcha -> String
showsPrec :: Int -> FunCaptcha -> ShowS
$cshowsPrec :: Int -> FunCaptcha -> ShowS
Show)

instance HasCommonCaptchaLenses FunCaptcha

instance HasCaptchaLenses FunCaptcha

instance HasPageURL FunCaptcha

instance HasProxy FunCaptcha

-- |
-- Parameters used to solve FunCaptcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'publicKey'
-- * 'TwoCaptcha.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'surl'
-- * 'customDataField'
-- * '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'
funCaptcha :: FunCaptcha
funCaptcha :: FunCaptcha
funCaptcha = Captcha -> FunCaptcha
MkFunCaptcha (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
"funcaptcha")

-- | Value of __pk__ or __data-pkey__ found on the FunCaptcha page.
publicKey :: Lens' FunCaptcha (Maybe Text)
publicKey :: (Maybe Text -> f (Maybe Text)) -> FunCaptcha -> f FunCaptcha
publicKey = Text -> Lens' FunCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"publickey"

-- | Value of __surl__ found on the FunCaptcha page.
surl :: Lens' FunCaptcha (Maybe Text)
surl :: (Maybe Text -> f (Maybe Text)) -> FunCaptcha -> f FunCaptcha
surl = Text -> Lens' FunCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"surl"

-- | Custom data to pass to FunCaptcha.
customDataField :: Text -> Lens' FunCaptcha (Maybe Text)
customDataField :: Text -> Lens' FunCaptcha (Maybe Text)
customDataField Text
field = Text -> Lens' FunCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens (Text
"data[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")