module TwoCaptcha.Internal.Types.RotateCaptcha where

import Control.Lens (Lens', (&), (?~))
import TwoCaptcha.Internal.Types.Captcha (Captcha, HasCaptchaLenses (method), HasCommonCaptchaLenses, HasLocalImage, defaultCaptcha, mkParamLens')

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

instance HasCommonCaptchaLenses RotateCaptcha

instance HasCaptchaLenses RotateCaptcha

instance HasLocalImage RotateCaptcha

-- |
-- Parameters used to solve a rotate captcha.
--
-- Required parameters:
--
-- * 'TwoCaptcha.Internal.Types.Captcha.apiKey'
-- * 'TwoCaptcha.Internal.Types.Captcha.file'*
-- * 'TwoCaptcha.Internal.Types.Captcha.body'*
--
-- Optional parameters:
--
-- * 'angle'
-- * 'TwoCaptcha.Internal.Types.Captcha.headerACAO'
-- * 'TwoCaptcha.Internal.Types.Captcha.pingback'
-- * 'TwoCaptcha.Internal.Types.Captcha.softId'
--
-- Starred required parameter rules:
--
-- * __file__ is only required if your captcha is sent as a file.
-- * __body__ is only required if your captcha is sent in base64 format.
rotateCaptcha :: RotateCaptcha
rotateCaptcha :: RotateCaptcha
rotateCaptcha = Captcha -> RotateCaptcha
MkRotateCaptcha (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
"rotatecaptcha")

-- | Angle for one rotation step in degrees. Defaults to 40 degrees if not specified.
angle :: Lens' RotateCaptcha (Maybe Int)
angle :: (Maybe Int -> f (Maybe Int)) -> RotateCaptcha -> f RotateCaptcha
angle = Text -> Lens' RotateCaptcha (Maybe Int)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"angle"