{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module: Captcha.Internal.Types
-- Copyright: (c) 2022 Edward Yang
-- License: MIT
--
-- This module is for internal-use and does not follow pvp versioning policies.
module Captcha.Internal.Types where

import Control.Lens.TH (makeFieldsNoPrefix)
import Data.Default (Default (def))
import Data.Text (Text)
import GHC.Generics (Generic)
import Time (Millisecond, Time)
import Web.Cookie (Cookies)

-- | 'Default' instance for 'Bool' is not defined by default.
instance Default Bool where
  def :: Bool
def = Bool
False

-- | Proxy protocol.
data ProxyProtocol = Http | Https | Socks4 | Socks5 deriving (Int -> ProxyProtocol -> ShowS
[ProxyProtocol] -> ShowS
ProxyProtocol -> String
(Int -> ProxyProtocol -> ShowS)
-> (ProxyProtocol -> String)
-> ([ProxyProtocol] -> ShowS)
-> Show ProxyProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyProtocol] -> ShowS
$cshowList :: [ProxyProtocol] -> ShowS
show :: ProxyProtocol -> String
$cshow :: ProxyProtocol -> String
showsPrec :: Int -> ProxyProtocol -> ShowS
$cshowsPrec :: Int -> ProxyProtocol -> ShowS
Show)

instance Default ProxyProtocol where
  def :: ProxyProtocol
def = ProxyProtocol
Http

-- | Proxy authentication.
data ProxyAuth = ProxyAuth
  { ProxyAuth -> Text
_username :: Text,
    ProxyAuth -> Text
_password :: Text
  }
  deriving ((forall x. ProxyAuth -> Rep ProxyAuth x)
-> (forall x. Rep ProxyAuth x -> ProxyAuth) -> Generic ProxyAuth
forall x. Rep ProxyAuth x -> ProxyAuth
forall x. ProxyAuth -> Rep ProxyAuth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProxyAuth x -> ProxyAuth
$cfrom :: forall x. ProxyAuth -> Rep ProxyAuth x
Generic, ProxyAuth
ProxyAuth -> Default ProxyAuth
forall a. a -> Default a
def :: ProxyAuth
$cdef :: ProxyAuth
Default, Int -> ProxyAuth -> ShowS
[ProxyAuth] -> ShowS
ProxyAuth -> String
(Int -> ProxyAuth -> ShowS)
-> (ProxyAuth -> String)
-> ([ProxyAuth] -> ShowS)
-> Show ProxyAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyAuth] -> ShowS
$cshowList :: [ProxyAuth] -> ShowS
show :: ProxyAuth -> String
$cshow :: ProxyAuth -> String
showsPrec :: Int -> ProxyAuth -> ShowS
$cshowsPrec :: Int -> ProxyAuth -> ShowS
Show)

makeFieldsNoPrefix ''ProxyAuth

-- | Proxy to be used when solving a captcha.
data Proxy = Proxy
  { -- | Proxy address.
    Proxy -> Text
_address :: Text,
    -- | Protocol of the proxy.
    Proxy -> ProxyProtocol
_protocol :: ProxyProtocol,
    -- | Proxy port.
    Proxy -> Int
_port :: Int,
    -- | Proxy authentication, if required.
    Proxy -> Maybe ProxyAuth
_auth :: Maybe ProxyAuth
  }
  deriving ((forall x. Proxy -> Rep Proxy x)
-> (forall x. Rep Proxy x -> Proxy) -> Generic Proxy
forall x. Rep Proxy x -> Proxy
forall x. Proxy -> Rep Proxy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Proxy x -> Proxy
$cfrom :: forall x. Proxy -> Rep Proxy x
Generic, Proxy
Proxy -> Default Proxy
forall a. a -> Default a
def :: Proxy
$cdef :: Proxy
Default, Int -> Proxy -> ShowS
[Proxy] -> ShowS
Proxy -> String
(Int -> Proxy -> ShowS)
-> (Proxy -> String) -> ([Proxy] -> ShowS) -> Show Proxy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Proxy] -> ShowS
$cshowList :: [Proxy] -> ShowS
show :: Proxy -> String
$cshow :: Proxy -> String
showsPrec :: Int -> Proxy -> ShowS
$cshowsPrec :: Int -> Proxy -> ShowS
Show)

makeFieldsNoPrefix ''Proxy

-- | Parameters for solving a captcha with text within an image.
data ImageCaptcha = ImageCaptcha
  { -- | The captcha solver's API key.
    ImageCaptcha -> Text
_apiKey :: Text,
    -- | The interval to poll for the captcha's answer.
    ImageCaptcha -> Maybe (Time Millisecond)
_pollingInterval :: Maybe (Time Millisecond),
    -- | The duration to keep polling for the answer.
    ImageCaptcha -> Maybe (Time Millisecond)
_timeoutDuration :: Maybe (Time Millisecond),
    -- | The image, encoded in base-64.
    ImageCaptcha -> Text
_body :: Text
  }
  deriving ((forall x. ImageCaptcha -> Rep ImageCaptcha x)
-> (forall x. Rep ImageCaptcha x -> ImageCaptcha)
-> Generic ImageCaptcha
forall x. Rep ImageCaptcha x -> ImageCaptcha
forall x. ImageCaptcha -> Rep ImageCaptcha x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageCaptcha x -> ImageCaptcha
$cfrom :: forall x. ImageCaptcha -> Rep ImageCaptcha x
Generic, ImageCaptcha
ImageCaptcha -> Default ImageCaptcha
forall a. a -> Default a
def :: ImageCaptcha
$cdef :: ImageCaptcha
Default, Int -> ImageCaptcha -> ShowS
[ImageCaptcha] -> ShowS
ImageCaptcha -> String
(Int -> ImageCaptcha -> ShowS)
-> (ImageCaptcha -> String)
-> ([ImageCaptcha] -> ShowS)
-> Show ImageCaptcha
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageCaptcha] -> ShowS
$cshowList :: [ImageCaptcha] -> ShowS
show :: ImageCaptcha -> String
$cshow :: ImageCaptcha -> String
showsPrec :: Int -> ImageCaptcha -> ShowS
$cshowsPrec :: Int -> ImageCaptcha -> ShowS
Show)

makeFieldsNoPrefix ''ImageCaptcha

-- | Parameters for solving a text captcha.
data TextCaptcha = TextCaptcha
  { -- | The captcha solver's API key.
    TextCaptcha -> Text
_apiKey :: Text,
    -- | The interval to poll for the captcha's answer.
    TextCaptcha -> Maybe (Time Millisecond)
_pollingInterval :: Maybe (Time Millisecond),
    -- | The duration to keep polling for the answer.
    TextCaptcha -> Maybe (Time Millisecond)
_timeoutDuration :: Maybe (Time Millisecond),
    -- | The text captcha to solve.
    TextCaptcha -> Text
_body :: Text
  }
  deriving ((forall x. TextCaptcha -> Rep TextCaptcha x)
-> (forall x. Rep TextCaptcha x -> TextCaptcha)
-> Generic TextCaptcha
forall x. Rep TextCaptcha x -> TextCaptcha
forall x. TextCaptcha -> Rep TextCaptcha x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextCaptcha x -> TextCaptcha
$cfrom :: forall x. TextCaptcha -> Rep TextCaptcha x
Generic, TextCaptcha
TextCaptcha -> Default TextCaptcha
forall a. a -> Default a
def :: TextCaptcha
$cdef :: TextCaptcha
Default, 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)

makeFieldsNoPrefix ''TextCaptcha

-- | Parameters for solving Arkose Lab's FunCaptcha.
data FunCaptcha = FunCaptcha
  { -- | The captcha solver's API key.
    FunCaptcha -> Text
_apiKey :: Text,
    -- | The interval to poll for the captcha's answer.
    FunCaptcha -> Maybe (Time Millisecond)
_pollingInterval :: Maybe (Time Millisecond),
    -- | The duration to keep polling for the answer.
    FunCaptcha -> Maybe (Time Millisecond)
_timeoutDuration :: Maybe (Time Millisecond),
    -- | Url where the captcha is found.
    FunCaptcha -> Text
_captchaUrl :: Text,
    -- | FunCaptcha's __data-pkey__ value.
    FunCaptcha -> Text
_captchaKey :: Text,
    -- | FunCaptcha's __surl__ service url value.
    FunCaptcha -> Maybe Text
_serviceUrl :: Maybe Text,
    -- | User agent to be used when solving the captcha.
    FunCaptcha -> Maybe Text
_userAgent :: Maybe Text,
    -- | Proxy to be used when solving the captcha.
    FunCaptcha -> Maybe Proxy
_proxy :: Maybe Proxy,
    -- | Cookies to be used when solving the captcha.
    FunCaptcha -> Cookies
_cookies :: Cookies
  }
  deriving ((forall x. FunCaptcha -> Rep FunCaptcha x)
-> (forall x. Rep FunCaptcha x -> FunCaptcha) -> Generic FunCaptcha
forall x. Rep FunCaptcha x -> FunCaptcha
forall x. FunCaptcha -> Rep FunCaptcha x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunCaptcha x -> FunCaptcha
$cfrom :: forall x. FunCaptcha -> Rep FunCaptcha x
Generic, FunCaptcha
FunCaptcha -> Default FunCaptcha
forall a. a -> Default a
def :: FunCaptcha
$cdef :: FunCaptcha
Default, Int -> FunCaptcha -> ShowS
[FunCaptcha] -> ShowS
FunCaptcha -> String
(Int -> FunCaptcha -> ShowS)
-> (FunCaptcha -> String)
-> ([FunCaptcha] -> ShowS)
-> Show FunCaptcha
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunCaptcha] -> ShowS
$cshowList :: [FunCaptcha] -> ShowS
show :: FunCaptcha -> String
$cshow :: FunCaptcha -> String
showsPrec :: Int -> FunCaptcha -> ShowS
$cshowsPrec :: Int -> FunCaptcha -> ShowS
Show)

makeFieldsNoPrefix ''FunCaptcha

-- | Parameters for solving Google's reCAPTCHA v2.
data ReCaptchaV2 = ReCaptchaV2
  { -- | The captcha solver's API key.
    ReCaptchaV2 -> Text
_apiKey :: Text,
    -- | The interval to poll for the captcha's answer.
    ReCaptchaV2 -> Maybe (Time Millisecond)
_pollingInterval :: Maybe (Time Millisecond),
    -- | The duration to keep polling for the answer.
    ReCaptchaV2 -> Maybe (Time Millisecond)
_timeoutDuration :: Maybe (Time Millisecond),
    -- | Url where the captcha is found.
    ReCaptchaV2 -> Text
_captchaUrl :: Text,
    -- | reCAPTCHA v2's __data-sitekey__ value.
    ReCaptchaV2 -> Text
_captchaKey :: Text,
    -- | reCAPTCHA's v2's __data-s__ value.
    ReCaptchaV2 -> Maybe Text
_dataS :: Maybe Text,
    -- | Is the reCAPTCHA an __invisible__ or __normal__ captcha?
    ReCaptchaV2 -> Bool
_invisible :: Bool,
    -- | User agent to be used when solving the captcha.
    ReCaptchaV2 -> Maybe Text
_userAgent :: Maybe Text,
    -- | Proxy to be used when solving the captcha.
    ReCaptchaV2 -> Maybe Proxy
_proxy :: Maybe Proxy,
    -- | Cookies to be used when solving the captcha.
    ReCaptchaV2 -> Cookies
_cookies :: Cookies
  }
  deriving ((forall x. ReCaptchaV2 -> Rep ReCaptchaV2 x)
-> (forall x. Rep ReCaptchaV2 x -> ReCaptchaV2)
-> Generic ReCaptchaV2
forall x. Rep ReCaptchaV2 x -> ReCaptchaV2
forall x. ReCaptchaV2 -> Rep ReCaptchaV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReCaptchaV2 x -> ReCaptchaV2
$cfrom :: forall x. ReCaptchaV2 -> Rep ReCaptchaV2 x
Generic, ReCaptchaV2
ReCaptchaV2 -> Default ReCaptchaV2
forall a. a -> Default a
def :: ReCaptchaV2
$cdef :: ReCaptchaV2
Default, Int -> ReCaptchaV2 -> ShowS
[ReCaptchaV2] -> ShowS
ReCaptchaV2 -> String
(Int -> ReCaptchaV2 -> ShowS)
-> (ReCaptchaV2 -> String)
-> ([ReCaptchaV2] -> ShowS)
-> Show ReCaptchaV2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReCaptchaV2] -> ShowS
$cshowList :: [ReCaptchaV2] -> ShowS
show :: ReCaptchaV2 -> String
$cshow :: ReCaptchaV2 -> String
showsPrec :: Int -> ReCaptchaV2 -> ShowS
$cshowsPrec :: Int -> ReCaptchaV2 -> ShowS
Show)

makeFieldsNoPrefix ''ReCaptchaV2

-- | Parameters for solving Google's reCAPTCHA v3.
data ReCaptchaV3 = ReCaptchaV3
  { -- | The captcha solver's API key.
    ReCaptchaV3 -> Text
_apiKey :: Text,
    -- | The interval to poll for the captcha's answer.
    ReCaptchaV3 -> Maybe (Time Millisecond)
_pollingInterval :: Maybe (Time Millisecond),
    -- | The duration to keep polling for the answer.
    ReCaptchaV3 -> Maybe (Time Millisecond)
_timeoutDuration :: Maybe (Time Millisecond),
    -- | Url where the captcha is found.
    ReCaptchaV3 -> Text
_captchaUrl :: Text,
    -- | reCAPTCHA v3's __sitekey__ value.
    ReCaptchaV3 -> Text
_captchaKey :: Text,
    -- | reCAPTCHA v3's minimum score.
    ReCaptchaV3 -> Double
_minScore :: Double,
    -- | reCAPTCHA v3's __action__ value.
    ReCaptchaV3 -> Maybe Text
_action :: Maybe Text,
    -- | User agent to be used when solving the captcha.
    ReCaptchaV3 -> Maybe Text
_userAgent :: Maybe Text,
    -- | Proxy to be used when solving the captcha.
    ReCaptchaV3 -> Maybe Proxy
_proxy :: Maybe Proxy,
    -- | Cookies to be used when solving the captcha.
    ReCaptchaV3 -> Cookies
_cookies :: Cookies
  }
  deriving ((forall x. ReCaptchaV3 -> Rep ReCaptchaV3 x)
-> (forall x. Rep ReCaptchaV3 x -> ReCaptchaV3)
-> Generic ReCaptchaV3
forall x. Rep ReCaptchaV3 x -> ReCaptchaV3
forall x. ReCaptchaV3 -> Rep ReCaptchaV3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReCaptchaV3 x -> ReCaptchaV3
$cfrom :: forall x. ReCaptchaV3 -> Rep ReCaptchaV3 x
Generic, ReCaptchaV3
ReCaptchaV3 -> Default ReCaptchaV3
forall a. a -> Default a
def :: ReCaptchaV3
$cdef :: ReCaptchaV3
Default, Int -> ReCaptchaV3 -> ShowS
[ReCaptchaV3] -> ShowS
ReCaptchaV3 -> String
(Int -> ReCaptchaV3 -> ShowS)
-> (ReCaptchaV3 -> String)
-> ([ReCaptchaV3] -> ShowS)
-> Show ReCaptchaV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReCaptchaV3] -> ShowS
$cshowList :: [ReCaptchaV3] -> ShowS
show :: ReCaptchaV3 -> String
$cshow :: ReCaptchaV3 -> String
showsPrec :: Int -> ReCaptchaV3 -> ShowS
$cshowsPrec :: Int -> ReCaptchaV3 -> ShowS
Show)

makeFieldsNoPrefix ''ReCaptchaV3

-- | Parameters for solving hCaptcha.
data HCaptcha = HCaptcha
  { -- | The captcha solver's API key.
    HCaptcha -> Text
_apiKey :: Text,
    -- | The interval to poll for the captcha's answer.
    HCaptcha -> Maybe (Time Millisecond)
_pollingInterval :: Maybe (Time Millisecond),
    -- | The duration to keep polling for the answer.
    HCaptcha -> Maybe (Time Millisecond)
_timeoutDuration :: Maybe (Time Millisecond),
    -- | Url where the captcha is found.
    HCaptcha -> Text
_captchaUrl :: Text,
    -- | hCaptcha's __data-sitekey__ value.
    HCaptcha -> Text
_captchaKey :: Text,
    -- | Is the hCaptcha an __invisible__ or __normal__ captcha?
    HCaptcha -> Bool
_invisible :: Bool,
    -- |
    -- Custom data used in some implementations of hCaptcha.
    -- Note: You must provide a matching user agent if this is used.
    HCaptcha -> Maybe Text
_rqData :: Maybe Text,
    -- | User agent to be used when solving the captcha. Required when using 'rqData'.
    HCaptcha -> Maybe Text
_userAgent :: Maybe Text,
    -- | Proxy to be used when solving the captcha.
    HCaptcha -> Maybe Proxy
_proxy :: Maybe Proxy,
    -- | Cookies to be used when solving the captcha.
    HCaptcha -> Cookies
_cookies :: Cookies
  }
  deriving (Int -> HCaptcha -> ShowS
[HCaptcha] -> ShowS
HCaptcha -> String
(Int -> HCaptcha -> ShowS)
-> (HCaptcha -> String) -> ([HCaptcha] -> ShowS) -> Show HCaptcha
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HCaptcha] -> ShowS
$cshowList :: [HCaptcha] -> ShowS
show :: HCaptcha -> String
$cshow :: HCaptcha -> String
showsPrec :: Int -> HCaptcha -> ShowS
$cshowsPrec :: Int -> HCaptcha -> ShowS
Show, (forall x. HCaptcha -> Rep HCaptcha x)
-> (forall x. Rep HCaptcha x -> HCaptcha) -> Generic HCaptcha
forall x. Rep HCaptcha x -> HCaptcha
forall x. HCaptcha -> Rep HCaptcha x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HCaptcha x -> HCaptcha
$cfrom :: forall x. HCaptcha -> Rep HCaptcha x
Generic, HCaptcha
HCaptcha -> Default HCaptcha
forall a. a -> Default a
def :: HCaptcha
$cdef :: HCaptcha
Default)

makeFieldsNoPrefix ''HCaptcha