module TwoCaptcha.Internal.Types.Exception where

import Control.Exception (Exception)
import Data.Functor (($>))
import Data.Text (Text)
import Network.HTTP.Client (HttpException)
import Text.Parsec (ParseError, parse, try, (<|>))
import Text.Parsec.Char (string)
import Text.Parsec.String (Parser)

-- | Represents a possible exception when interacting with the 2captcha API.
data TwoCaptchaException
  = -- | An error documented on 2captcha's website.
    TwoCaptchaResponseException TwoCaptchaErrorCode
  | -- | A non-200 status code was thrown. This should only appear in rare cases.
    NetworkException HttpException
  | -- | An unknown error occured, likely due to a change in the 2captcha API.
    UnknownError Text
  | -- | Solving the captcha took too long. Try setting a higher timeout duration?
    SolvingTimeout
  deriving (Int -> TwoCaptchaException -> ShowS
[TwoCaptchaException] -> ShowS
TwoCaptchaException -> String
(Int -> TwoCaptchaException -> ShowS)
-> (TwoCaptchaException -> String)
-> ([TwoCaptchaException] -> ShowS)
-> Show TwoCaptchaException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwoCaptchaException] -> ShowS
$cshowList :: [TwoCaptchaException] -> ShowS
show :: TwoCaptchaException -> String
$cshow :: TwoCaptchaException -> String
showsPrec :: Int -> TwoCaptchaException -> ShowS
$cshowsPrec :: Int -> TwoCaptchaException -> ShowS
Show)

instance Exception TwoCaptchaException

-- | Possible errors when using the 2captcha API.
data TwoCaptchaErrorCode
  = -- | The api key you provided is invalid. Please ensure it is 32 characters long.
    WrongUserKey
  | -- | The key you've provided does not exist.
    KeyDoesNotExist
  | -- | You don't have funds in your account.
    ZeroBalance
  | -- | The __pageurl__ parameter is missing in your request.
    PageUrlMissing
  | -- |
    -- You can receive this error in two cases:
    --
    -- 1. __If you solve token-based captchas (reCAPTCHA, hCaptcha, ArkoseLabs FunCaptcha, GeeTest, etc):__
    -- the queue of your captchas that are not distributed to workers is too long.
    -- Queue limit changes dynamically and depends on total amount of captchas awaiting solution and usually it’s between 50 and 100 captchas.
    --
    -- 2. __If you solve Normal Captcha:__ your maximum rate for normal captchas is lower than current rate on the server.
    -- You can change your maximum rate in <https://2captcha.com/setting your account's settings.>
    NoSlotAvailable
  | -- | Image size is less than 100 bytes.
    ZeroCaptchaFileSize
  | -- | Image size is more than 100 kB.
    TooBigCaptchaFileSize
  | -- | Image file has unsupported extension. Accepted extensions: jpg, jpeg, gif, png.
    WrongFileExtension
  | -- | Server can't recognize image file type.
    ImageTypeNotSupported
  | -- |
    -- Server can't get file data from your POST-request.
    -- That happens if your POST-request is malformed or base64 data is not a valid base64 image.
    UploadFailure
  | -- | The request is sent from the IP that is not on the list of your allowed IPs.
    IpNotAllowed
  | -- | Your IP address is banned due to many frequent attempts to access the server using wrong authorization keys.
    IpBanned
  | -- |
    -- You can get this error code when sending reCAPTCHA V2. This happens if your request contains invalid pair of googlekey and pageurl.
    -- The common reason for that is that reCAPTCHA is loaded inside an iframe hosted on another domain/subdomain.
    BadTokenOrPageUrl
  | -- | You can get this error code when sending reCAPTCHA V2. That means that sitekey value provided in your request is incorrect: it's blank or malformed.
    GoogleKeyInvalid
  | -- | The __googlekey__ parameter is missing in your request.
    GoogleKeyMissing
  | -- |
    -- You've sent an image that is marked in 2captcha's database as unrecognizable.
    -- Usually that happens if the website where you found the captcha stopped sending you captchas and started to send a "deny access" image.
    CaptchaImageBlocked
  | -- | You are sending too many unrecognizable images.
    TooManyBadImages
  | -- |
    -- You made more than 60 requests to in.php within 3 seconds.
    -- Your account is banned for 10 seconds. Ban will be lifted automatically.
    RateLimited
  | -- |
    -- You received the error 'NoSlotAvailable' 120 times in one minute because your current bid is lower than current bid on the server.
    --
    -- Blocking time: 10 minutes.
    Error1001
  | -- |
    -- You received the error 'ZeroBalance' 120 times in one minute because your balance is zero.
    --
    -- Blocking time: 5 minutes.
    Error1002
  | -- |
    -- You received the error 'NoSlotAvailable' because you are uploading many captchas and server has a long queue of your captchas that are not distributed to workers.
    -- You received three times more errors than amount of captchas you sent (but not less than 120 errors). Increase the timeout if you see this error.
    --
    -- Blocking time: 30 seconds.
    Error1003
  | -- | Your IP address is blocked because there were 5 requests with incorrect API key from your IP.
    Error1004
  | -- |
    -- You are making too many requests to res.php to get answers.
    --
    --
    -- 2captcha uses the following rule to block your account: R > C * 20 + 1200
    --
    -- Where:
    --
    -- * R - the amount of your requests
    --
    -- * C - the amount of captchas you've uploaded
    --
    -- That means that you don't have to make more than 20 requests to res.php per each captcha.
    -- Please remember that balance request sent to res.php also counts!
    --
    -- To get your answer faster without a risk to be blocked you can use <https://2captcha.com/2captcha-api#pingback pingback> feature and 2captcha will send you the answer when your captcha is solved.
    --
    -- Blocking time: 10 minutes.
    Error1005
  | -- |
    -- The error code is returned if some required parameters are missing in your request or the values have incorrect format.
    -- For example if you submit <https://2captcha.com/2captcha-api#grid Grid images> but your request is missing an instruction for workers.
    --
    -- Blocking time: 5 minutes.
    BadParameters
  | -- | You can get this error code when sending a captcha via proxy server which is marked as BAD by the 2captcha API.
    BadProxy
  | -- | Your captcha is not solved yet.
    CaptchaNotReady
  | -- |
    -- 2captcha was unable to solve your captcha - three of their workers were unable solve it or they didn't get an answer within 90 seconds (300 seconds for reCAPTCHA V2).
    --
    -- You will not be charged for that request.
    CaptchaUnsolvable
  | -- | You've provided captcha ID in wrong format. The ID can contain numbers only.
    WrongIdFormat
  | -- | You provided an invalid captcha id.
    WrongCaptchaId
  | -- | Error is returned when 100% accuracy feature is enabled. The error means that max numbers of tries is reached but min number of matches not found.
    BadDuplicates
  | -- |
    -- Error is returned to your <https://2captcha.com/2captcha-api#complain report> request if you already complained lots of correctly solved captchas (more than 40%).
    -- Or if more than 15 minutes passed after you submitted the captcha.
    ReportNotRecorded
  | -- | Error is returned to your <https://2captcha.com/2captcha-api#complain report request> if you are trying to report the same captcha more than once.
    DuplicateReport
  | -- |
    -- You can receive this error code when registering a <https://2captcha.com/2captcha-api#pingback pingback (callback)> IP or domain.
    --
    -- This happens if your request is coming from an IP address that doesn't match the IP address of your pingback IP or domain.
    InvalidPingbackIp
  | -- |
    -- You can receive this error code when sending <https://2captcha.com/2captcha-api#solving_geetest GeeTest>.
    -- This error means the __challenge__ value you provided is expired.
    TokenExpired
  | -- | Action parameter is missing or no value is provided for __action__ parameter.
    EmptyAction
  | -- |
    -- You can get this error code if we were unable to load a captcha through your proxy server.
    -- The proxy will be marked as BAD by our API and we will not accept requests with the proxy during 10 minutes.
    -- You will recieve ERROR_BAD_PROXY code from in.php API endpoint in such case.
    ProxyConnectionFailed
  deriving (Int -> TwoCaptchaErrorCode -> ShowS
[TwoCaptchaErrorCode] -> ShowS
TwoCaptchaErrorCode -> String
(Int -> TwoCaptchaErrorCode -> ShowS)
-> (TwoCaptchaErrorCode -> String)
-> ([TwoCaptchaErrorCode] -> ShowS)
-> Show TwoCaptchaErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwoCaptchaErrorCode] -> ShowS
$cshowList :: [TwoCaptchaErrorCode] -> ShowS
show :: TwoCaptchaErrorCode -> String
$cshow :: TwoCaptchaErrorCode -> String
showsPrec :: Int -> TwoCaptchaErrorCode -> ShowS
$cshowsPrec :: Int -> TwoCaptchaErrorCode -> ShowS
Show, TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
(TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool)
-> (TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool)
-> Eq TwoCaptchaErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
$c/= :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
== :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
$c== :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
Eq)

-- | The raw error code provided by 2captcha.
errorCode :: TwoCaptchaErrorCode -> String
errorCode :: TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
WrongUserKey = String
"ERROR_WRONG_USER_KEY"
errorCode TwoCaptchaErrorCode
KeyDoesNotExist = String
"ERROR_KEY_DOES_NOT_EXIST"
errorCode TwoCaptchaErrorCode
ZeroBalance = String
"ERROR_ZERO_BALANCE"
errorCode TwoCaptchaErrorCode
PageUrlMissing = String
"ERROR_PAGEURL"
errorCode TwoCaptchaErrorCode
NoSlotAvailable = String
"ERROR_NO_SLOT_AVAILABLE"
errorCode TwoCaptchaErrorCode
ZeroCaptchaFileSize = String
"ERROR_ZERO_CAPTCHA_FILESIZE"
errorCode TwoCaptchaErrorCode
TooBigCaptchaFileSize = String
"ERROR_TOO_BIG_CAPTCHA_FILESIZE"
errorCode TwoCaptchaErrorCode
WrongFileExtension = String
"ERROR_WRONG_FILE_EXTENSION"
errorCode TwoCaptchaErrorCode
ImageTypeNotSupported = String
"ERROR_IMAGE_TYPE_NOT_SUPPORTED"
errorCode TwoCaptchaErrorCode
UploadFailure = String
"ERROR_UPLOAD"
errorCode TwoCaptchaErrorCode
IpNotAllowed = String
"ERROR_IP_NOT_ALLOWED"
errorCode TwoCaptchaErrorCode
IpBanned = String
"IP_BANNED"
errorCode TwoCaptchaErrorCode
BadTokenOrPageUrl = String
"ERROR_BAD_TOKEN_OR_PAGEURL"
errorCode TwoCaptchaErrorCode
GoogleKeyInvalid = String
"ERROR_GOOGLEKEY"
errorCode TwoCaptchaErrorCode
GoogleKeyMissing = String
"ERROR_WRONG_GOOGLEKEY"
errorCode TwoCaptchaErrorCode
CaptchaImageBlocked = String
"ERROR_CAPTCHAIMAGE_BLOCKED"
errorCode TwoCaptchaErrorCode
TooManyBadImages = String
"TOO_MANY_BAD_IMAGES"
errorCode TwoCaptchaErrorCode
RateLimited = String
"MAX_USER_TURN"
errorCode TwoCaptchaErrorCode
Error1001 = String
"ERROR: 1001"
errorCode TwoCaptchaErrorCode
Error1002 = String
"ERROR: 1002"
errorCode TwoCaptchaErrorCode
Error1003 = String
"ERROR: 1003"
errorCode TwoCaptchaErrorCode
Error1004 = String
"ERROR: 1004"
errorCode TwoCaptchaErrorCode
Error1005 = String
"ERROR: 1005"
errorCode TwoCaptchaErrorCode
BadParameters = String
"ERROR_BAD_PARAMETERS"
errorCode TwoCaptchaErrorCode
BadProxy = String
"ERROR_BAD_PROXY"
errorCode TwoCaptchaErrorCode
CaptchaNotReady = String
"CAPCHA_NOT_READY"
errorCode TwoCaptchaErrorCode
CaptchaUnsolvable = String
"ERROR_CAPTCHA_UNSOLVABLE"
errorCode TwoCaptchaErrorCode
WrongIdFormat = String
"ERROR_WRONG_ID_FORMAT"
errorCode TwoCaptchaErrorCode
WrongCaptchaId = String
"ERROR_WRONG_CAPTCHA_ID"
errorCode TwoCaptchaErrorCode
BadDuplicates = String
"ERROR_BAD_DUPLICATES"
errorCode TwoCaptchaErrorCode
ReportNotRecorded = String
"ERROR_REPORT_NOT_RECORDED"
errorCode TwoCaptchaErrorCode
DuplicateReport = String
"ERROR_DUPLICATE_REPORT"
errorCode TwoCaptchaErrorCode
InvalidPingbackIp = String
"ERROR_IP_ADDRES"
errorCode TwoCaptchaErrorCode
TokenExpired = String
"ERROR_TOKEN_EXPIRED"
errorCode TwoCaptchaErrorCode
EmptyAction = String
"ERROR_EMPTY_ACTION"
errorCode TwoCaptchaErrorCode
ProxyConnectionFailed = String
"ERROR_PROXY_CONNECTION_FAILED"

-- | Parser instance for parsing an error code to a 'TwoCaptchaErrorCode'.
errorParser :: Parser TwoCaptchaErrorCode
errorParser :: Parser TwoCaptchaErrorCode
errorParser =
  Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
WrongUserKey) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
WrongUserKey)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
KeyDoesNotExist) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
KeyDoesNotExist)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
ZeroBalance) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
ZeroBalance)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
PageUrlMissing) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
PageUrlMissing)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
NoSlotAvailable) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
NoSlotAvailable)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
ZeroCaptchaFileSize) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
ZeroCaptchaFileSize)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
TooBigCaptchaFileSize) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
TooBigCaptchaFileSize)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
WrongFileExtension) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
WrongFileExtension)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
ImageTypeNotSupported) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
ImageTypeNotSupported)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
UploadFailure) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
UploadFailure)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
IpNotAllowed) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
IpNotAllowed)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
IpBanned) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
IpBanned)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
BadTokenOrPageUrl) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
BadTokenOrPageUrl)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
GoogleKeyInvalid) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
GoogleKeyInvalid)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
GoogleKeyMissing) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
GoogleKeyMissing)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
CaptchaImageBlocked) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
CaptchaImageBlocked)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
TooManyBadImages) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
TooManyBadImages)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
RateLimited) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
RateLimited)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
Error1001) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
Error1001)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
Error1002) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
Error1002)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
Error1003) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
Error1003)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
Error1004) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
Error1004)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
Error1005) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
Error1005)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
BadParameters) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
BadParameters)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
BadProxy) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
BadProxy)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
CaptchaNotReady) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
CaptchaNotReady)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
CaptchaUnsolvable) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
CaptchaUnsolvable)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
WrongIdFormat) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
WrongIdFormat)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
WrongCaptchaId) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
WrongCaptchaId)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
BadDuplicates) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
BadDuplicates)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
ReportNotRecorded) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
ReportNotRecorded)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
DuplicateReport) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
DuplicateReport)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
InvalidPingbackIp) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
InvalidPingbackIp)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
TokenExpired) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
TokenExpired Parser TwoCaptchaErrorCode
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
TokenExpired Parser TwoCaptchaErrorCode
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
TokenExpired Parser TwoCaptchaErrorCode
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
TokenExpired)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
EmptyAction) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
EmptyAction)
    Parser TwoCaptchaErrorCode
-> Parser TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (TwoCaptchaErrorCode -> String
errorCode TwoCaptchaErrorCode
ProxyConnectionFailed) ParsecT String () Identity String
-> TwoCaptchaErrorCode -> Parser TwoCaptchaErrorCode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TwoCaptchaErrorCode
ProxyConnectionFailed

-- | Read an error code as its corresponding 'TwoCaptchaErrorCode'.
readErrorCode :: String -> Either ParseError TwoCaptchaErrorCode
readErrorCode :: String -> Either ParseError TwoCaptchaErrorCode
readErrorCode = Parser TwoCaptchaErrorCode
-> String -> String -> Either ParseError TwoCaptchaErrorCode
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser TwoCaptchaErrorCode
errorParser String
""