module TwoCaptcha.Internal.Types.GridCaptcha where

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

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

instance HasCommonCaptchaLenses GridCaptcha

instance HasCaptchaLenses GridCaptcha

instance HasLocalImage GridCaptcha

instance HasLanguage GridCaptcha

-- |
-- Parameters for solving a grid captcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'TwoCaptcha.Internal.Types.Captcha.method'
-- * 'reCAPTCHAImage'
-- * 'TwoCaptcha.Internal.Types.Captcha.file'*
-- * 'TwoCaptcha.Internal.Types.Captcha.body'*
--
-- Optional parameters:
--
-- * 'canvas'
-- * 'TwoCaptcha.Internal.Types.Captcha.textInstructions'
-- * 'TwoCaptcha.Internal.Types.Captcha.imgInstructions'
-- * 'reCAPTCHAImage'
-- * 'rows'
-- * 'columns'
-- * 'previousId'
-- * 'cannotAnswer'
-- * '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'
--
-- 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"__
gridCaptcha :: GridCaptcha
gridCaptcha :: GridCaptcha
gridCaptcha = Captcha -> GridCaptcha
MkGridCaptcha Captcha
defaultCaptcha

-- | Defines that you're sending a reCAPTCHA as an image.
reCAPTCHAImage :: Lens' GridCaptcha (Maybe Bool)
reCAPTCHAImage :: (Maybe Bool -> f (Maybe Bool)) -> GridCaptcha -> f GridCaptcha
reCAPTCHAImage = Text -> Lens' GridCaptcha (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"recaptcha"

-- | Defines that you want to use a <https://2captcha.com/2captcha-api#canvas canvas> method.
canvas :: Lens' GridCaptcha (Maybe Bool)
canvas :: (Maybe Bool -> f (Maybe Bool)) -> GridCaptcha -> f GridCaptcha
canvas = Text -> Lens' GridCaptcha (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"canvas"

-- | Number of rows in reCAPTCHA grid.
rows :: Lens' GridCaptcha (Maybe Int)
rows :: (Maybe Int -> f (Maybe Int)) -> GridCaptcha -> f GridCaptcha
rows = Text -> Lens' GridCaptcha (Maybe Int)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"recaptcharows"

-- | Number of columns in reCAPTCHA grid.
columns :: Lens' GridCaptcha (Maybe Int)
columns :: (Maybe Int -> f (Maybe Int)) -> GridCaptcha -> f GridCaptcha
columns = Text -> Lens' GridCaptcha (Maybe Int)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"recaptchacols"

-- | Id of your previous request with the same captcha challenge.
previousId :: Lens' GridCaptcha (Maybe Text)
previousId :: (Maybe Text -> f (Maybe Text)) -> GridCaptcha -> f GridCaptcha
previousId = Text -> Lens' GridCaptcha (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"previousID"

-- | Defines if the captcha can potentially have no images, or possibly cannot be answered.
cannotAnswer :: Lens' GridCaptcha (Maybe Bool)
cannotAnswer :: (Maybe Bool -> f (Maybe Bool)) -> GridCaptcha -> f GridCaptcha
cannotAnswer = Text -> Lens' GridCaptcha (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"can_no_answer"