module TwoCaptcha.Internal.Types.NormalCaptcha where

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

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

instance HasCommonCaptchaLenses NormalCaptcha

instance HasCaptchaLenses NormalCaptcha

instance HasLocalImage NormalCaptcha

instance HasLanguage NormalCaptcha

-- |
-- Parameters for solving a normal captcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'TwoCaptcha.Internal.Types.Captcha.method'
-- * 'TwoCaptcha.Internal.Types.Captcha.file'*
-- * 'TwoCaptcha.Internal.Types.Captcha.body'*
--
-- Optional parameters:
--
-- * 'phrase'
-- * 'caseSensitive'
-- * 'format'
-- * 'calc'
-- * 'minLength'
-- * 'maxLength'
-- * 'TwoCaptcha.Internal.Types.Captcha.language'
-- * 'TwoCaptcha.Internal.Types.Captcha.languageCode'
-- * 'TwoCaptcha.Internal.Types.Captcha.textInstructions'
-- * 'TwoCaptcha.Internal.Types.Captcha.imgInstructions'
-- * 'TwoCaptcha.Internal.Types.Captcha.headerACAO'
-- * 'TwoCaptcha.Internal.Types.Captcha.pingback'
-- * 'TwoCaptcha.Internal.Types.Captcha.softId'
--
-- Possible 'TwoCaptcha.Internal.Types.Captcha.method' values:
--
-- * __post__ - defines that you're sending an image with multipart form
-- * __base64__  - defines that you're sending a base64 encoded image
--
-- Starred required parameter rules:
--
-- * __file__ is only required if __captcha = "post"__
-- * __body__ is only required if __captcha = "base64"__
normalCaptcha :: NormalCaptcha
normalCaptcha :: NormalCaptcha
normalCaptcha = Captcha -> NormalCaptcha
MkNormalCaptcha Captcha
defaultCaptcha

-- |
-- Defines if the captcha is a phrase.
--
-- * True - Captcha contains two or more words.
-- * False - Captcha contains one word.
phrase :: Lens' NormalCaptcha (Maybe Bool)
phrase :: (Maybe Bool -> f (Maybe Bool)) -> NormalCaptcha -> f NormalCaptcha
phrase = Text -> Lens' NormalCaptcha (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"phrase"

-- | Defines if the captcha is case sensitive.
caseSensitive :: Lens' NormalCaptcha (Maybe Bool)
caseSensitive :: (Maybe Bool -> f (Maybe Bool)) -> NormalCaptcha -> f NormalCaptcha
caseSensitive = Text -> Lens' NormalCaptcha (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"regsense"

-- |
-- The captcha's format:
--
-- 0. Not specified.
-- 1. Captcha contains only numbers.
-- 2. Captcha contains only letters.
-- 3. Captcha contains only numbers OR only letters.
-- 4. Captcha contains both numbers AND letters.
format :: Lens' NormalCaptcha (Maybe Int)
format :: (Maybe Int -> f (Maybe Int)) -> NormalCaptcha -> f NormalCaptcha
format = Text -> Lens' NormalCaptcha (Maybe Int)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"numeric"

-- | Define if the captcha requires calculation (e.g. 1 + 1 = ?).
calc :: Lens' NormalCaptcha (Maybe Bool)
calc :: (Maybe Bool -> f (Maybe Bool)) -> NormalCaptcha -> f NormalCaptcha
calc = Text -> Lens' NormalCaptcha (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"calc"

-- | The minimum number of symbols in the captcha (up to 20).
minLength :: Lens' NormalCaptcha (Maybe Int)
minLength :: (Maybe Int -> f (Maybe Int)) -> NormalCaptcha -> f NormalCaptcha
minLength = Text -> Lens' NormalCaptcha (Maybe Int)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"min_len"

-- | The maximum numbers of symbols in the captcha (up to 20).
maxLength :: Lens' NormalCaptcha (Maybe Int)
maxLength :: (Maybe Int -> f (Maybe Int)) -> NormalCaptcha -> f NormalCaptcha
maxLength = Text -> Lens' NormalCaptcha (Maybe Int)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"max_len"