module TwoCaptcha.Internal.Types.Captcha where

import Control.Lens (Getter, Lens', iso, lens, to, (%~), (&), (.~), (^.))
import Control.Lens.TH (makeLenses)
import Data.String (IsString)
import Data.Text (Text, pack, unpack)
import GHC.Base (Coercible, coerce)
import Network.Wreq (Options, Part, defaults, param, partFile, partText)

-- import Prelude hiding (lookup)

-- | The id of a captcha being solved.
type CaptchaId = Text

-- | Time in milliseconds in how often to request the answer.
type PollingInterval = Int

-- | Time in milliseconds on when to timeout if the request takes too long.
type TimeoutDuration = Integer

-- | Default captcha timeout duration (120 seconds).
captchaTimeout :: TimeoutDuration
captchaTimeout :: TimeoutDuration
captchaTimeout = TimeoutDuration
120000

-- | Default polling interval (10 seconds).
pollingInterval :: PollingInterval
pollingInterval :: PollingInterval
pollingInterval = PollingInterval
10000

-- | Represents the request information required to solve a captcha.
data Captcha = MkCaptcha
  { Captcha -> Options
_options :: Options,
    Captcha -> [(Text, Text)]
_partTexts :: [(Text, Text)],
    Captcha -> [(Text, FilePath)]
_partFiles :: [(Text, FilePath)]
  }
  deriving (PollingInterval -> Captcha -> ShowS
[Captcha] -> ShowS
Captcha -> FilePath
(PollingInterval -> Captcha -> ShowS)
-> (Captcha -> FilePath) -> ([Captcha] -> ShowS) -> Show Captcha
forall a.
(PollingInterval -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Captcha] -> ShowS
$cshowList :: [Captcha] -> ShowS
show :: Captcha -> FilePath
$cshow :: Captcha -> FilePath
showsPrec :: PollingInterval -> Captcha -> ShowS
$cshowsPrec :: PollingInterval -> Captcha -> ShowS
Show)

makeLenses ''Captcha

-- | Convert the captcha's multipart form parameters into a ['Part'].
parts :: Getter Captcha [Part]
parts :: ([Part] -> f [Part]) -> Captcha -> f Captcha
parts = (Captcha -> [Part]) -> ([Part] -> f [Part]) -> Captcha -> f Captcha
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\Captcha
captcha -> ((Text -> Text -> Part) -> (Text, Text) -> Part
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Part
partText ((Text, Text) -> Part) -> [(Text, Text)] -> [Part]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Captcha
captcha Captcha
-> Getting [(Text, Text)] Captcha [(Text, Text)] -> [(Text, Text)]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, Text)] Captcha [(Text, Text)]
Lens' Captcha [(Text, Text)]
partTexts) [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ ((Text -> FilePath -> Part) -> (Text, FilePath) -> Part
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> FilePath -> Part
partFile ((Text, FilePath) -> Part) -> [(Text, FilePath)] -> [Part]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Captcha
captcha Captcha
-> Getting [(Text, FilePath)] Captcha [(Text, FilePath)]
-> [(Text, FilePath)]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, FilePath)] Captcha [(Text, FilePath)]
Lens' Captcha [(Text, FilePath)]
partFiles))

instance HasCommonCaptchaLenses Captcha

instance HasCaptchaLenses Captcha

-- | Default parameters for solving a captcha. Internal use only.
defaultCaptcha :: Captcha
defaultCaptcha :: Captcha
defaultCaptcha = Options -> [(Text, Text)] -> [(Text, FilePath)] -> Captcha
MkCaptcha (Options
defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"json" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
"1"]) [] []

-- | Create a lens using the given field name for multipart forms.
mkPartLens :: (Coercible Captcha a, IsString s) => Lens' Captcha [(Text, s)] -> Text -> Lens' a (Maybe s)
mkPartLens :: Lens' Captcha [(Text, s)] -> Text -> Lens' a (Maybe s)
mkPartLens Lens' Captcha [(Text, s)]
partLens Text
field = (a -> Maybe s) -> (a -> Maybe s -> a) -> Lens' a (Maybe s)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens a -> Maybe s
forall a. Coercible a Captcha => a -> Maybe s
getter a -> Maybe s -> a
forall p. Coercible p Captcha => p -> Maybe s -> p
setter
  where
    getter :: a -> Maybe s
getter a
a = Text -> [(Text, s)] -> Maybe s
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
field (a -> Captcha
coerce a
a Captcha -> Getting [(Text, s)] Captcha [(Text, s)] -> [(Text, s)]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, s)] Captcha [(Text, s)]
Lens' Captcha [(Text, s)]
partLens)
    setter :: p -> Maybe s -> p
setter p
a (Just s
value) = Captcha -> p
coerce (Captcha -> p) -> Captcha -> p
forall a b. (a -> b) -> a -> b
$ p -> Captcha
coerce p
a Captcha -> (Captcha -> Captcha) -> Captcha
forall a b. a -> (a -> b) -> b
& ([(Text, s)] -> Identity [(Text, s)])
-> Captcha -> Identity Captcha
Lens' Captcha [(Text, s)]
partLens (([(Text, s)] -> Identity [(Text, s)])
 -> Captcha -> Identity Captcha)
-> ([(Text, s)] -> [(Text, s)]) -> Captcha -> Captcha
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Text
field, s
value) (Text, s) -> [(Text, s)] -> [(Text, s)]
forall a. a -> [a] -> [a]
:)
    setter p
a Maybe s
Nothing = p
a

-- | Create a lens using the given field name for multipart form texts.
mkPartTextLens :: Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkPartTextLens :: Text -> Lens' a (Maybe Text)
mkPartTextLens = Lens' Captcha [(Text, Text)] -> Text -> Lens' a (Maybe Text)
forall a s.
(Coercible Captcha a, IsString s) =>
Lens' Captcha [(Text, s)] -> Text -> Lens' a (Maybe s)
mkPartLens Lens' Captcha [(Text, Text)]
partTexts

-- | Create a lens using the given field name for multipart form files.
mkPartFileLens :: Coercible Captcha a => Text -> Lens' a (Maybe FilePath)
mkPartFileLens :: Text -> Lens' a (Maybe FilePath)
mkPartFileLens = Lens' Captcha [(Text, FilePath)]
-> Text -> Lens' a (Maybe FilePath)
forall a s.
(Coercible Captcha a, IsString s) =>
Lens' Captcha [(Text, s)] -> Text -> Lens' a (Maybe s)
mkPartLens Lens' Captcha [(Text, FilePath)]
partFiles

-- | Creates a lens using the given field name for query parameters.
mkParamLens :: Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens :: Text -> Lens' a (Maybe Text)
mkParamLens Text
field = (a -> Maybe Text) -> (a -> Maybe Text -> a) -> Lens' a (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens a -> Maybe Text
forall p. Coercible p Captcha => p -> Maybe Text
getter a -> Maybe Text -> a
forall p. Coercible p Captcha => p -> Maybe Text -> p
setter
  where
    getter :: p -> Maybe Text
getter p
a =
      let value :: [Text]
value = p -> Captcha
coerce p
a Captcha -> Getting [Text] Captcha [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. (Options -> Const [Text] Options)
-> Captcha -> Const [Text] Captcha
Lens' Captcha Options
options ((Options -> Const [Text] Options)
 -> Captcha -> Const [Text] Captcha)
-> (([Text] -> Const [Text] [Text])
    -> Options -> Const [Text] Options)
-> Getting [Text] Captcha [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Lens' Options [Text]
param Text
field
       in if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
value then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
value
    setter :: p -> Maybe Text -> p
setter p
a (Just Text
value) = Captcha -> p
coerce (Captcha -> p) -> Captcha -> p
forall a b. (a -> b) -> a -> b
$ p -> Captcha
coerce p
a Captcha -> (Captcha -> Captcha) -> Captcha
forall a b. a -> (a -> b) -> b
& (Options -> Identity Options) -> Captcha -> Identity Captcha
Lens' Captcha Options
options ((Options -> Identity Options) -> Captcha -> Identity Captcha)
-> (Options -> Options) -> Captcha -> Captcha
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
field (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
value])
    setter p
a Maybe Text
Nothing = p
a

-- |
-- Create a lens using the given field name for type __b__ with a 'Show' and 'Read' instance.
--
-- GOTCHA: Bool values translate to 'True' or 'False'. Use 'mkLensBool' instead for bool lenses.
mkParamLens' :: (Coercible Captcha a, Show b, Read b) => Text -> Lens' a (Maybe b)
mkParamLens' :: Text -> Lens' a (Maybe b)
mkParamLens' Text
field = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
field ((Maybe Text -> f (Maybe Text)) -> a -> f a)
-> ((Maybe b -> f (Maybe b)) -> Maybe Text -> f (Maybe Text))
-> (Maybe b -> f (Maybe b))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Maybe b)
-> (Maybe b -> Maybe Text)
-> Iso (Maybe Text) (Maybe Text) (Maybe b) (Maybe b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (FilePath -> b
forall a. Read a => FilePath -> a
read (FilePath -> b) -> (Text -> FilePath) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> b) -> Maybe Text -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (FilePath -> Text
pack (FilePath -> Text) -> (b -> FilePath) -> b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> FilePath
forall a. Show a => a -> FilePath
show (b -> Text) -> Maybe b -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- |
-- Create a lens using the given field name for bools.
--
-- The boolean values become:
--
-- * 'True' - 1
-- * 'False' - 0
mkParamLensBool :: Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool :: Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
field = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
field ((Maybe Text -> f (Maybe Text)) -> a -> f a)
-> ((Maybe Bool -> f (Maybe Bool)) -> Maybe Text -> f (Maybe Text))
-> (Maybe Bool -> f (Maybe Bool))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Maybe Bool)
-> (Maybe Bool -> Maybe Text)
-> Iso (Maybe Text) (Maybe Text) (Maybe Bool) (Maybe Bool)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Text -> Bool
textToBool (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Bool -> Text
forall p. IsString p => Bool -> p
boolToText (Bool -> Text) -> Maybe Bool -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  where
    textToBool :: Text -> Bool
textToBool Text
"0" = Bool
False
    textToBool Text
"1" = Bool
True
    textToBool Text
number = FilePath -> Bool
forall a. HasCallStack => FilePath -> a
error (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
unpack Text
number FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" is not a valid bool value. This should never occur, please don't manipulate the options manually."
    boolToText :: Bool -> p
boolToText Bool
False = p
"0"
    boolToText Bool
True = p
"1"

-- | Lenses for constructing options for 'TwoCaptcha.Internal.Client.submit'.
class Coercible Captcha a => HasCaptchaLenses a where
  -- | Software developer id. Developers who integrate their software with 2captcha earn 10% of the user's spendings.
  softId :: Lens' a (Maybe Int)
  softId = Text -> Lens' a (Maybe PollingInterval)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"soft_id"

  -- | URL for <https://2captcha.com/2captcha-api#pingback pingback> (callback) response that will be sent the answer to when the captcha is solved.
  pingback :: Lens' a (Maybe Text)
  pingback = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"pingback"

  -- | Type of captcha to solve.
  method :: Lens' a (Maybe Text)
  method = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"method"

-- | Lenses for constructing options for 'TwoCaptcha.Internal.Client.submit' and 'TwoCaptcha.Internal.Client.answer'.
class Coercible Captcha a => HasCommonCaptchaLenses a where
  -- | Your 2captcha API <https://2captcha.com/2captcha-api#solving_captchas key>.
  apiKey :: Lens' a (Maybe Text)
  apiKey = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"key"

  -- |
  -- If True, 'TwoCaptcha.Internal.Client.submit' will include the __Access-Control-Allow-Origin:*__ header in the response.
  -- Used for cross-domain AJAX requests in web applications.
  headerACAO :: Lens' a (Maybe Bool)
  headerACAO = Text -> Lens' a (Maybe Bool)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Bool)
mkParamLensBool Text
"header_acao"

-- | Parameters used to retrieve the 'TwpCaptcha.Internal.Client.answer' of a solved captcha.
newtype CaptchaRes = CaptchaRes Captcha deriving (PollingInterval -> CaptchaRes -> ShowS
[CaptchaRes] -> ShowS
CaptchaRes -> FilePath
(PollingInterval -> CaptchaRes -> ShowS)
-> (CaptchaRes -> FilePath)
-> ([CaptchaRes] -> ShowS)
-> Show CaptchaRes
forall a.
(PollingInterval -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CaptchaRes] -> ShowS
$cshowList :: [CaptchaRes] -> ShowS
show :: CaptchaRes -> FilePath
$cshow :: CaptchaRes -> FilePath
showsPrec :: PollingInterval -> CaptchaRes -> ShowS
$cshowsPrec :: PollingInterval -> CaptchaRes -> ShowS
Show)

instance HasCommonCaptchaLenses CaptchaRes

-- |
-- Parameters for retrieving a captcha's answer.
--
-- Required parameters:
--
-- * 'apiKey'
-- * 'captchaId'
--
-- Optional parameters:
--
-- * 'headerACAO'
captchaRes :: CaptchaRes
captchaRes :: CaptchaRes
captchaRes = Captcha -> CaptchaRes
CaptchaRes (Captcha
defaultCaptcha Captcha -> (Captcha -> Captcha) -> Captcha
forall a b. a -> (a -> b) -> b
& (Options -> Identity Options) -> Captcha -> Identity Captcha
Lens' Captcha Options
options ((Options -> Identity Options) -> Captcha -> Identity Captcha)
-> (Options -> Options) -> Captcha -> Captcha
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"action" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
"get"]))

-- | The captcha id returned from 'TwoCaptcha.Internal.Client.submit'.
captchaId :: Lens' CaptchaRes (Maybe Text)
captchaId :: (Maybe Text -> f (Maybe Text)) -> CaptchaRes -> f CaptchaRes
captchaId = Text -> Lens' CaptchaRes (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"id"

class Coercible Captcha a => HasPageURL a where
  -- | Full URL of the page where the captcha is found.
  pageUrl :: Lens' a (Maybe Text)
  pageUrl = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"pageurl"

class Coercible Captcha a => HasProxy a where
  -- |
  -- Proxy to be sent to the worker who solves the captcha. You can read more about proxies <https://2captcha.com/2captcha-api#proxies here>.
  --
  -- Format must be in __login:password@123.123.123.123:3128__ .
  proxy :: Lens' a (Maybe Text)
  proxy = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"proxy"

  -- | Type of your proxy: __HTTP__, __HTTPS__, __SOCKS4__, __SOCKS5__.
  proxyType :: Lens' a (Maybe Text)
  proxyType = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"proxytype"

class Coercible Captcha a => HasLocalImage a where
  -- | File path of a captcha image.
  file :: Lens' a (Maybe FilePath)
  file = Text -> Lens' a (Maybe FilePath)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe FilePath)
mkPartFileLens Text
"file"

  -- | Base-64 encoded image.
  body :: Lens' a (Maybe Text)
  body = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkPartTextLens Text
"body"

  -- | Text which is shown to the worker to help solve a captcha.
  textInstructions :: Lens' a (Maybe Text)
  textInstructions = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"textInstructions"

  -- | Image file path with instructions on solving a captcha.
  imgInstructions :: Lens' a (Maybe FilePath)
  imgInstructions = Text -> Lens' a (Maybe FilePath)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe FilePath)
mkPartFileLens Text
"imgInstructions"

class Coercible Captcha a => HasLanguage a where
  -- |
  -- The captcha's language:
  --
  -- 0. Not specified.
  -- 1. Cyrillic captcha.
  -- 2. Latin captcha.
  language :: Lens' a (Maybe Int)
  language = Text -> Lens' a (Maybe PollingInterval)
forall a b.
(Coercible Captcha a, Show b, Read b) =>
Text -> Lens' a (Maybe b)
mkParamLens' Text
"language"

  -- | The captcha's language code. Click <https://2captcha.com/2captcha-api#language here> for a list of supported languages.
  languageCode :: Lens' a (Maybe Text)
  languageCode = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"lang"

class Coercible Captcha a => HasUserAgent a where
  -- | User agent that will be used by the worker when solving the captcha.
  userAgent :: Lens' a (Maybe Text)
  userAgent = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"userAgent"

class Coercible Captcha a => HasCookies a where
  -- |
  -- Cookies that will be used by the worker solving the captcha. The used cookies will also be included in the response.
  --
  -- Format: __KEY1:Value1;KEY2:Value2;__
  cookies :: Lens' a (Maybe Text)
  cookies = Text -> Lens' a (Maybe Text)
forall a. Coercible Captcha a => Text -> Lens' a (Maybe Text)
mkParamLens Text
"cookies"