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

instance HasCommonCaptchaLenses CapyCaptcha

instance HasCaptchaLenses CapyCaptcha

instance HasPageURL CapyCaptcha

instance HasProxy CapyCaptcha

-- |
-- Parameters used to solve a capy puzzle captcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'captchaKey'
-- * 'scriptDomain'
-- * 'TwoCaptcha.Internal.Types.Captcha.pageUrl'
--
-- Optional parameters:
--
-- * 'scriptDomain'
-- * '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'
capyCaptcha :: CapyCaptcha
capyCaptcha :: CapyCaptcha
capyCaptcha = Captcha -> CapyCaptcha
MkCapyCaptcha (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
"capy")

-- | Value of __captchakey__ parameter you found on page.
captchaKey :: Lens' CapyCaptcha (Maybe Text)
captchaKey :: (Maybe Text -> f (Maybe Text)) -> CapyCaptcha -> f CapyCaptcha
captchaKey = Text -> Lens' CapyCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"captchakey"

-- |
-- The domain part of the script URL found on page.
--
-- If not specified, defaults to: https://jp.api.capy.me/
scriptDomain :: Lens' CapyCaptcha (Maybe Text)
scriptDomain :: (Maybe Text -> f (Maybe Text)) -> CapyCaptcha -> f CapyCaptcha
scriptDomain = Text -> Lens' CapyCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"api_server"