module TwoCaptcha.Internal.Types.TikTokCaptcha where

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

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

instance HasCommonCaptchaLenses TikTokCaptcha

instance HasCaptchaLenses TikTokCaptcha

instance HasPageURL TikTokCaptcha

instance HasProxy TikTokCaptcha

instance HasCookies TikTokCaptcha

-- |
-- Parameters used to solve a TikTok captcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'TwoCaptcha.Internal.Types.Captcha.cookies'
-- * 'aid'
-- * 'host'
-- * 'TwoCaptcha.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.softId'
-- * 'TwoCaptcha.Internal.Types.Captcha.proxy'
-- * 'TwoCaptcha.Internal.Types.Captcha.proxyType'
tikTokCaptcha :: TikTokCaptcha
tikTokCaptcha :: TikTokCaptcha
tikTokCaptcha = Captcha -> TikTokCaptcha
MkTikTokCaptcha (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
"tiktok")

-- | The __aid__ parameter value found on the page.
aid :: Lens' TikTokCaptcha (Maybe Int)
aid :: (Maybe Int -> f (Maybe Int)) -> TikTokCaptcha -> f TikTokCaptcha
aid = Text -> Lens' TikTokCaptcha (Maybe Int)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"aid"

-- | The __host__ parameter value found on the page.
host :: Lens' TikTokCaptcha (Maybe Text)
host :: (Maybe Text -> f (Maybe Text)) -> TikTokCaptcha -> f TikTokCaptcha
host = Text -> Lens' TikTokCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"host"