module TwoCaptcha.Internal.Types.TextCaptcha where

import Control.Lens (Lens')
import Data.Text (Text)
import TwoCaptcha.Internal.Types.Captcha (Captcha, HasCaptchaLenses, HasCommonCaptchaLenses, HasLanguage, defaultCaptcha, mkParamLens)

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

instance HasCommonCaptchaLenses TextCaptcha

instance HasCaptchaLenses TextCaptcha

instance HasLanguage TextCaptcha

-- |
-- Parameters for solving a text captcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'textContent'
--
-- Optional parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.language'
-- * 'TwoCaptcha.Internal.Types.Captcha.languageCode'
-- * 'TwoCaptcha.Internal.Types.Captcha.headerACAO'
-- * 'TwoCaptcha.Internal.Types.Captcha.pingback'
-- * 'TwoCaptcha.Internal.Types.Captcha.softId'
textCaptcha :: TextCaptcha
textCaptcha :: TextCaptcha
textCaptcha = Captcha -> TextCaptcha
MkTextCaptcha Captcha
defaultCaptcha

-- | The text captcha's content.
textContent :: Lens' TextCaptcha (Maybe Text)
textContent :: (Maybe Text -> f (Maybe Text)) -> TextCaptcha -> f TextCaptcha
textContent = Text -> Lens' TextCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"textcaptcha"