module TwoCaptcha.Internal.Client where

import Control.Concurrent (threadDelay)
import Control.Lens ((&), (.~), (?~), (^.), (^?))
import Control.Monad.Catch (MonadCatch, MonadThrow (throwM), try)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson.Lens (key, _Integer, _String)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Text (Text, unpack)
import GHC.Base (Coercible, coerce)
import Network.Wreq (Response, responseBody)
import Network.Wreq.Session (Session, getWith, postWith)
import System.Clock (Clock (Monotonic), getTime, toNanoSecs)
import TwoCaptcha.Internal.Types.Captcha (Captcha, CaptchaId, CaptchaRes (CaptchaRes), HasCaptchaLenses, HasCommonCaptchaLenses (apiKey, headerACAO), PollingInterval, TimeoutDuration, captchaId, captchaRes, options, parts)
import TwoCaptcha.Internal.Types.Exception (TwoCaptchaErrorCode (CaptchaNotReady), TwoCaptchaException (NetworkException, SolvingTimeout, TwoCaptchaResponseException, UnknownError), readErrorCode)

-- | Runs the given http method and adapts errors to 'TwoCaptchaException'.
handle :: (MonadIO m, MonadCatch m) => IO (Response ByteString) -> m Text
handle :: IO (Response ByteString) -> m Text
handle IO (Response ByteString)
method =
  m (Response ByteString)
-> m (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Response ByteString)
method) m (Either HttpException (Response ByteString))
-> (Either HttpException (Response ByteString) -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- HttpException found due to non-200 status code. Rethrow as NetworkException.
    Left HttpException
exception -> TwoCaptchaException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TwoCaptchaException -> m Text) -> TwoCaptchaException -> m Text
forall a b. (a -> b) -> a -> b
$ HttpException -> TwoCaptchaException
NetworkException HttpException
exception
    Right Response ByteString
response -> do
      let statusRequest :: Maybe (Integer, Text)
statusRequest = do
            ByteString
body <- Response ByteString
response Response ByteString
-> Getting (First ByteString) (Response ByteString) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First ByteString) (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
            Integer
status <- ByteString
body ByteString
-> Getting (First Integer) ByteString Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' ByteString Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"status" ((Value -> Const (First Integer) Value)
 -> ByteString -> Const (First Integer) ByteString)
-> ((Integer -> Const (First Integer) Integer)
    -> Value -> Const (First Integer) Value)
-> Getting (First Integer) ByteString Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value
forall t. AsNumber t => Prism' t Integer
_Integer
            Text
request <- ByteString
body ByteString -> Getting (First Text) ByteString Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' ByteString Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"request" ((Value -> Const (First Text) Value)
 -> ByteString -> Const (First Text) ByteString)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) ByteString Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsPrimitive t => Prism' t Text
_String
            (Integer, Text) -> Maybe (Integer, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
status, Text
request)
      case Maybe (Integer, Text)
statusRequest of
        -- 'status' and 'request' fields are missing.
        Maybe (Integer, Text)
Nothing -> do
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Response ByteString -> IO ()
forall a. Show a => a -> IO ()
print Response ByteString
response
          TwoCaptchaException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TwoCaptchaException -> m Text) -> TwoCaptchaException -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> TwoCaptchaException
UnknownError Text
"The response is not the expected JSON. This is likely due to 2captcha changing their API."
        Just (Integer
status, Text
request) -> do
          -- 'status' 0 means an error was returned.
          if Integer
status Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
            then case String -> Either ParseError TwoCaptchaErrorCode
readErrorCode (Text -> String
unpack Text
request) of
              -- Parsing the error code failed even though an error was returned. This means the error code is not known yet.
              Left ParseError
_ -> TwoCaptchaException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TwoCaptchaException -> m Text) -> TwoCaptchaException -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> TwoCaptchaException
UnknownError (Text
"Invalid error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
request)
              -- Parsing the error code succeeded.
              Right TwoCaptchaErrorCode
errorCode -> TwoCaptchaException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TwoCaptchaException -> m Text) -> TwoCaptchaException -> m Text
forall a b. (a -> b) -> a -> b
$ TwoCaptchaErrorCode -> TwoCaptchaException
TwoCaptchaResponseException TwoCaptchaErrorCode
errorCode
            else -- No error was found.
              Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
request

-- | Encapsulates the __in.php__ and __res.php__ endpoints for the 2captcha API.
class TwoCaptchaClient m where
  -- | Submit a captcha to be solved by the 2captcha API. Returns a captcha id used for 'answer'.
  submit :: (Coercible Captcha a, HasCaptchaLenses a, HasCommonCaptchaLenses a) => Session -> a -> m CaptchaId

  -- | Attempt to retrieve the answer of a captcha previously submitted.
  answer :: Session -> CaptchaRes -> m Text

  -- | Submits a captcha and polls for the answer.
  solve :: (Coercible Captcha a, HasCaptchaLenses a, HasCommonCaptchaLenses a) => PollingInterval -> TimeoutDuration -> Session -> a -> m Text

instance (MonadIO m, MonadCatch m) => TwoCaptchaClient m where
  submit :: Session -> a -> m Text
submit Session
session a
captcha' = IO (Response ByteString) -> m Text
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IO (Response ByteString) -> m Text
handle (IO (Response ByteString) -> m Text)
-> IO (Response ByteString) -> m Text
forall a b. (a -> b) -> a -> b
$ Options -> Session -> String -> [Part] -> IO (Response ByteString)
forall a.
Postable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
postWith (Captcha
captcha Captcha -> Getting Options Captcha Options -> Options
forall s a. s -> Getting a s a -> a
^. Getting Options Captcha Options
Lens' Captcha Options
options) Session
session String
"https://2captcha.com/in.php" (Captcha
captcha Captcha -> Getting [Part] Captcha [Part] -> [Part]
forall s a. s -> Getting a s a -> a
^. Getting [Part] Captcha [Part]
Getter Captcha [Part]
parts)
    where
      captcha :: Captcha
captcha = a -> Captcha
coerce a
captcha'
  answer :: Session -> CaptchaRes -> m Text
answer Session
session (CaptchaRes Captcha
captchaRes) = IO (Response ByteString) -> m Text
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IO (Response ByteString) -> m Text
handle (IO (Response ByteString) -> m Text)
-> IO (Response ByteString) -> m Text
forall a b. (a -> b) -> a -> b
$ Options -> Session -> String -> IO (Response ByteString)
getWith (Captcha
captchaRes Captcha -> Getting Options Captcha Options -> Options
forall s a. s -> Getting a s a -> a
^. Getting Options Captcha Options
Lens' Captcha Options
options) Session
session String
"https://2captcha.com/res.php"
  solve :: PollingInterval -> Integer -> Session -> a -> m Text
solve PollingInterval
pollingInterval Integer
timeoutDuration Session
session a
captcha = do
    Text
captchaId' <- Session -> a -> m Text
forall (m :: * -> *) a.
(TwoCaptchaClient m, Coercible Captcha a, HasCaptchaLenses a,
 HasCommonCaptchaLenses a) =>
Session -> a -> m Text
submit Session
session a
captcha
    let captchaRes' :: CaptchaRes
captchaRes' =
          CaptchaRes
captchaRes
            CaptchaRes -> (CaptchaRes -> CaptchaRes) -> CaptchaRes
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> CaptchaRes -> Identity CaptchaRes
forall a. HasCommonCaptchaLenses a => Lens' a (Maybe Text)
apiKey ((Maybe Text -> Identity (Maybe Text))
 -> CaptchaRes -> Identity CaptchaRes)
-> Maybe Text -> CaptchaRes -> CaptchaRes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (a
captcha a -> Getting (Maybe Text) a (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) a (Maybe Text)
forall a. HasCommonCaptchaLenses a => Lens' a (Maybe Text)
apiKey)
            CaptchaRes -> (CaptchaRes -> CaptchaRes) -> CaptchaRes
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool))
-> CaptchaRes -> Identity CaptchaRes
forall a. HasCommonCaptchaLenses a => Lens' a (Maybe Bool)
headerACAO ((Maybe Bool -> Identity (Maybe Bool))
 -> CaptchaRes -> Identity CaptchaRes)
-> Maybe Bool -> CaptchaRes -> CaptchaRes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (a
captcha a -> Getting (Maybe Bool) a (Maybe Bool) -> Maybe Bool
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Bool) a (Maybe Bool)
forall a. HasCommonCaptchaLenses a => Lens' a (Maybe Bool)
headerACAO)
            CaptchaRes -> (CaptchaRes -> CaptchaRes) -> CaptchaRes
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> CaptchaRes -> Identity CaptchaRes
Lens' CaptchaRes (Maybe Text)
captchaId ((Maybe Text -> Identity (Maybe Text))
 -> CaptchaRes -> Identity CaptchaRes)
-> Text -> CaptchaRes -> CaptchaRes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
captchaId'
    let time :: m Integer
time = IO Integer -> m Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> m Integer) -> IO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ (\TimeSpec
t -> TimeSpec -> Integer
toNanoSecs TimeSpec
t Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000) (TimeSpec -> Integer) -> IO TimeSpec -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
getTime Clock
Monotonic
    Integer
startTime <- m Integer
time
    let pollAnswer :: Integer -> Integer -> m Text
pollAnswer Integer
previousTime Integer
currentTime =
          -- Elapsed time is past the timeout duration
          if Integer
currentTime Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
previousTime Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
timeoutDuration
            then TwoCaptchaException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TwoCaptchaException
SolvingTimeout
            else do
              IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PollingInterval -> IO ()
threadDelay (PollingInterval
pollingInterval PollingInterval -> PollingInterval -> PollingInterval
forall a. Num a => a -> a -> a
* PollingInterval
1000)
              -- Attempt to retrieve the answer. If it's not ready yet, retry.
              Either TwoCaptchaException Text
answerAttempt <- m Text -> m (Either TwoCaptchaException Text)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m Text -> m (Either TwoCaptchaException Text))
-> m Text -> m (Either TwoCaptchaException Text)
forall a b. (a -> b) -> a -> b
$ Session -> CaptchaRes -> m Text
forall (m :: * -> *).
TwoCaptchaClient m =>
Session -> CaptchaRes -> m Text
answer Session
session CaptchaRes
captchaRes'
              case Either TwoCaptchaException Text
answerAttempt of
                Left (TwoCaptchaResponseException TwoCaptchaErrorCode
CaptchaNotReady) -> do
                  Integer
updatedTime <- m Integer
time
                  Integer -> Integer -> m Text
pollAnswer Integer
currentTime Integer
updatedTime
                Left TwoCaptchaException
exception -> TwoCaptchaException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TwoCaptchaException
exception
                Right Text
answer -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
answer
    Integer -> Integer -> m Text
pollAnswer Integer
startTime Integer
startTime