{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}

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

import Control.Exception (Exception)
import Data.Foldable (find)
import Data.Text (Text)
import Network.HTTP.Client (HttpException)

-- | All possible errors when solving a captcha using 2Captcha.
data TwoCaptchaError
  = TwoCaptchaResponseError TwoCaptchaErrorCode
  | UnknownResponseError Text Text
  | UnknownError Text
  | NetworkError HttpException
  | TimeoutError
  deriving (Int -> TwoCaptchaError -> ShowS
[TwoCaptchaError] -> ShowS
TwoCaptchaError -> String
(Int -> TwoCaptchaError -> ShowS)
-> (TwoCaptchaError -> String)
-> ([TwoCaptchaError] -> ShowS)
-> Show TwoCaptchaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwoCaptchaError] -> ShowS
$cshowList :: [TwoCaptchaError] -> ShowS
show :: TwoCaptchaError -> String
$cshow :: TwoCaptchaError -> String
showsPrec :: Int -> TwoCaptchaError -> ShowS
$cshowsPrec :: Int -> TwoCaptchaError -> ShowS
Show, Show TwoCaptchaError
Typeable TwoCaptchaError
Typeable TwoCaptchaError
-> Show TwoCaptchaError
-> (TwoCaptchaError -> SomeException)
-> (SomeException -> Maybe TwoCaptchaError)
-> (TwoCaptchaError -> String)
-> Exception TwoCaptchaError
SomeException -> Maybe TwoCaptchaError
TwoCaptchaError -> String
TwoCaptchaError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: TwoCaptchaError -> String
$cdisplayException :: TwoCaptchaError -> String
fromException :: SomeException -> Maybe TwoCaptchaError
$cfromException :: SomeException -> Maybe TwoCaptchaError
toException :: TwoCaptchaError -> SomeException
$ctoException :: TwoCaptchaError -> SomeException
$cp2Exception :: Show TwoCaptchaError
$cp1Exception :: Typeable TwoCaptchaError
Exception)

-- | An error code returned by the TwoCaptcha 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
  | -- |
    -- 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 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, Eq TwoCaptchaErrorCode
Eq TwoCaptchaErrorCode
-> (TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Ordering)
-> (TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool)
-> (TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool)
-> (TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool)
-> (TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool)
-> (TwoCaptchaErrorCode
    -> TwoCaptchaErrorCode -> TwoCaptchaErrorCode)
-> (TwoCaptchaErrorCode
    -> TwoCaptchaErrorCode -> TwoCaptchaErrorCode)
-> Ord TwoCaptchaErrorCode
TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Ordering
TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> TwoCaptchaErrorCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> TwoCaptchaErrorCode
$cmin :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> TwoCaptchaErrorCode
max :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> TwoCaptchaErrorCode
$cmax :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> TwoCaptchaErrorCode
>= :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
$c>= :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
> :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
$c> :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
<= :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
$c<= :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
< :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
$c< :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Bool
compare :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Ordering
$ccompare :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> Ordering
$cp1Ord :: Eq TwoCaptchaErrorCode
Ord, Int -> TwoCaptchaErrorCode
TwoCaptchaErrorCode -> Int
TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
TwoCaptchaErrorCode -> TwoCaptchaErrorCode
TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
TwoCaptchaErrorCode
-> TwoCaptchaErrorCode
-> TwoCaptchaErrorCode
-> [TwoCaptchaErrorCode]
(TwoCaptchaErrorCode -> TwoCaptchaErrorCode)
-> (TwoCaptchaErrorCode -> TwoCaptchaErrorCode)
-> (Int -> TwoCaptchaErrorCode)
-> (TwoCaptchaErrorCode -> Int)
-> (TwoCaptchaErrorCode -> [TwoCaptchaErrorCode])
-> (TwoCaptchaErrorCode
    -> TwoCaptchaErrorCode -> [TwoCaptchaErrorCode])
-> (TwoCaptchaErrorCode
    -> TwoCaptchaErrorCode -> [TwoCaptchaErrorCode])
-> (TwoCaptchaErrorCode
    -> TwoCaptchaErrorCode
    -> TwoCaptchaErrorCode
    -> [TwoCaptchaErrorCode])
-> Enum TwoCaptchaErrorCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TwoCaptchaErrorCode
-> TwoCaptchaErrorCode
-> TwoCaptchaErrorCode
-> [TwoCaptchaErrorCode]
$cenumFromThenTo :: TwoCaptchaErrorCode
-> TwoCaptchaErrorCode
-> TwoCaptchaErrorCode
-> [TwoCaptchaErrorCode]
enumFromTo :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
$cenumFromTo :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
enumFromThen :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
$cenumFromThen :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
enumFrom :: TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
$cenumFrom :: TwoCaptchaErrorCode -> [TwoCaptchaErrorCode]
fromEnum :: TwoCaptchaErrorCode -> Int
$cfromEnum :: TwoCaptchaErrorCode -> Int
toEnum :: Int -> TwoCaptchaErrorCode
$ctoEnum :: Int -> TwoCaptchaErrorCode
pred :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode
$cpred :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode
succ :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode
$csucc :: TwoCaptchaErrorCode -> TwoCaptchaErrorCode
Enum, TwoCaptchaErrorCode
TwoCaptchaErrorCode
-> TwoCaptchaErrorCode -> Bounded TwoCaptchaErrorCode
forall a. a -> a -> Bounded a
maxBound :: TwoCaptchaErrorCode
$cmaxBound :: TwoCaptchaErrorCode
minBound :: TwoCaptchaErrorCode
$cminBound :: TwoCaptchaErrorCode
Bounded)

-- | Textual representation of a 'TwoCaptchaErrorCode'
errorCode :: TwoCaptchaErrorCode -> Text
errorCode :: TwoCaptchaErrorCode -> Text
errorCode = \case
  TwoCaptchaErrorCode
WrongUserKey -> Text
"ERROR_WRONG_USER_KEY"
  TwoCaptchaErrorCode
KeyDoesNotExist -> Text
"ERROR_KEY_DOES_NOT_EXIST"
  TwoCaptchaErrorCode
ZeroBalance -> Text
"ERROR_ZERO_BALANCE"
  TwoCaptchaErrorCode
PageUrlMissing -> Text
"ERROR_PAGEURL"
  TwoCaptchaErrorCode
NoSlotAvailable -> Text
"ERROR_NO_SLOT_AVAILABLE"
  TwoCaptchaErrorCode
ZeroCaptchaFileSize -> Text
"ERROR_ZERO_CAPTCHA_FILESIZE"
  TwoCaptchaErrorCode
TooBigCaptchaFileSize -> Text
"ERROR_TOO_BIG_CAPTCHA_FILESIZE"
  TwoCaptchaErrorCode
WrongFileExtension -> Text
"ERROR_WRONG_FILE_EXTENSION"
  TwoCaptchaErrorCode
ImageTypeNotSupported -> Text
"ERROR_IMAGE_TYPE_NOT_SUPPORTED"
  TwoCaptchaErrorCode
UploadFailure -> Text
"ERROR_UPLOAD"
  TwoCaptchaErrorCode
IpNotAllowed -> Text
"ERROR_IP_NOT_ALLOWED"
  TwoCaptchaErrorCode
IpBanned -> Text
"IP_BANNED"
  TwoCaptchaErrorCode
BadTokenOrPageUrl -> Text
"ERROR_BAD_TOKEN_OR_PAGEURL"
  TwoCaptchaErrorCode
GoogleKeyInvalid -> Text
"ERROR_GOOGLEKEY"
  TwoCaptchaErrorCode
GoogleKeyMissing -> Text
"ERROR_WRONG_GOOGLEKEY"
  TwoCaptchaErrorCode
CaptchaImageBlocked -> Text
"ERROR_CAPTCHAIMAGE_BLOCKED"
  TwoCaptchaErrorCode
TooManyBadImages -> Text
"TOO_MANY_BAD_IMAGES"
  TwoCaptchaErrorCode
RateLimited -> Text
"MAX_USER_TURN"
  TwoCaptchaErrorCode
BadParameters -> Text
"ERROR_BAD_PARAMETERS"
  TwoCaptchaErrorCode
BadProxy -> Text
"ERROR_BAD_PROXY"
  TwoCaptchaErrorCode
CaptchaNotReady -> Text
"CAPCHA_NOT_READY"
  TwoCaptchaErrorCode
CaptchaUnsolvable -> Text
"ERROR_CAPTCHA_UNSOLVABLE"
  TwoCaptchaErrorCode
WrongIdFormat -> Text
"ERROR_WRONG_ID_FORMAT"
  TwoCaptchaErrorCode
WrongCaptchaId -> Text
"ERROR_WRONG_CAPTCHA_ID"
  TwoCaptchaErrorCode
BadDuplicates -> Text
"ERROR_BAD_DUPLICATES"
  TwoCaptchaErrorCode
ReportNotRecorded -> Text
"ERROR_REPORT_NOT_RECORDED"
  TwoCaptchaErrorCode
DuplicateReport -> Text
"ERROR_DUPLICATE_REPORT"
  TwoCaptchaErrorCode
TokenExpired -> Text
"ERROR_TOKEN_EXPIRED"
  TwoCaptchaErrorCode
EmptyAction -> Text
"ERROR_EMPTY_ACTION"
  TwoCaptchaErrorCode
ProxyConnectionFailed -> Text
"ERROR_PROXY_CONNECTION_FAILED"

-- | Parse an error code into its equivalent 'TwoCaptchaErrorCode'.
parseError :: Text -> Maybe TwoCaptchaErrorCode
parseError :: Text -> Maybe TwoCaptchaErrorCode
parseError Text
code = (TwoCaptchaErrorCode -> Bool)
-> [TwoCaptchaErrorCode] -> Maybe TwoCaptchaErrorCode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
code) (Text -> Bool)
-> (TwoCaptchaErrorCode -> Text) -> TwoCaptchaErrorCode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TwoCaptchaErrorCode -> Text
errorCode) [TwoCaptchaErrorCode
forall a. Bounded a => a
minBound .. TwoCaptchaErrorCode
forall a. Bounded a => a
maxBound]