module TwoCaptcha.Internal.Types.KeyCaptcha where

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

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

instance HasCommonCaptchaLenses KeyCaptcha

instance HasCaptchaLenses KeyCaptcha

instance HasPageURL KeyCaptcha

-- |
-- Parameters used to solve a KeyCaptcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'userId'
-- * 'sessionId'
-- * 'webServerSign'
-- * 'webServerSign2'
-- * 'TwoCaptchal.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.headerACAO'
-- * 'TwoCaptcha.Internal.Types.Captcha.pingback'
-- * 'TwoCaptcha.Internal.Types.Captcha.softId'
keyCaptcha :: KeyCaptcha
keyCaptcha :: KeyCaptcha
keyCaptcha = Captcha -> KeyCaptcha
MkKeyCaptcha (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
"keycaptcha")

-- | Value of __s_s_c_user_id__ parameter you found on page.
userId :: Lens' KeyCaptcha (Maybe Text)
userId :: (Maybe Text -> f (Maybe Text)) -> KeyCaptcha -> f KeyCaptcha
userId = Text -> Lens' KeyCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"s_s_c_user_id"

-- | Value of __s_s_c_session_id__ parameter you found on page.
sessionId :: Lens' KeyCaptcha (Maybe Text)
sessionId :: (Maybe Text -> f (Maybe Text)) -> KeyCaptcha -> f KeyCaptcha
sessionId = Text -> Lens' KeyCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"s_s_c_session_id"

-- | Value of __s_s_c_web_server_sign__ parameter you found on page.
webServerSign :: Lens' KeyCaptcha (Maybe Text)
webServerSign :: (Maybe Text -> f (Maybe Text)) -> KeyCaptcha -> f KeyCaptcha
webServerSign = Text -> Lens' KeyCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"s_s_c_web_server_sign"

-- | Value of __s_s_c_web_server_sign2__ parameter you found on page.
webServerSign2 :: Lens' KeyCaptcha (Maybe Text)
webServerSign2 :: (Maybe Text -> f (Maybe Text)) -> KeyCaptcha -> f KeyCaptcha
webServerSign2 = Text -> Lens' KeyCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"s_s_c_web_server_sign2"