{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

import Captcha.Internal.Monad (HasCaptchaEnv)
import Captcha.Internal.Monad.Class (CaptchaRequest (request))
import Captcha.Internal.Request (post)
import Captcha.Internal.Types (HCaptcha, HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl), HasInvisible (invisible), HasRqData (rqData), HasUserAgent (userAgent))
import Captcha.TwoCaptcha.Internal (TwoCaptcha, defaultOptions, parseProxy, parseProxyType)
import Control.Lens ((&), (.~), (^.))
import Control.Monad.Cont (MonadIO)
import Control.Monad.Reader (MonadReader)
import Data.Aeson (object)
import Data.Maybe (maybeToList)
import Data.String.Conversions (cs)
import Network.Wreq (param)

instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest TwoCaptcha HCaptcha r m where
  request :: HCaptcha -> Text -> m (Response ByteString)
request HCaptcha
captcha = (Text -> Value -> m (Response ByteString))
-> Value -> Text -> m (Response ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Options -> Text -> Value -> m (Response ByteString)
forall r (m :: * -> *) a.
(HasCaptchaEnv r, MonadReader r m, MonadIO m, Postable a) =>
Options -> Text -> a -> m (Response ByteString)
post Options
options) ([Pair] -> Value
object [])
    where
      options :: Options
options =
        Options
defaultOptions
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"key" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [HCaptcha
captcha HCaptcha -> Getting Text HCaptcha Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text HCaptcha Text
forall s a. HasApiKey s a => Lens' s a
apiKey]
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"method" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
"hcaptcha"]
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"sitekey" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [HCaptcha
captcha HCaptcha -> Getting Text HCaptcha Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text HCaptcha Text
forall s a. HasCaptchaKey s a => Lens' s a
captchaKey]
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"pageurl" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [HCaptcha
captcha HCaptcha -> Getting Text HCaptcha Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text HCaptcha Text
forall s a. HasCaptchaUrl s a => Lens' s a
captchaUrl]
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"invisible" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Bool -> String) -> Bool -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show (Bool -> Text) -> Bool -> Text
forall a b. (a -> b) -> a -> b
$ HCaptcha
captcha HCaptcha -> Getting Bool HCaptcha Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool HCaptcha Bool
forall s a. HasInvisible s a => Lens' s a
invisible]
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"data" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (HCaptcha
captcha HCaptcha
-> Getting (Maybe Text) HCaptcha (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) HCaptcha (Maybe Text)
forall s a. HasRqData s a => Lens' s a
rqData)
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"userAgent" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (HCaptcha
captcha HCaptcha
-> Getting (Maybe Text) HCaptcha (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) HCaptcha (Maybe Text)
forall s a. HasUserAgent s a => Lens' s a
userAgent)
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"proxy" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HCaptcha -> [Text]
forall a. HasProxy a (Maybe Proxy) => a -> [Text]
parseProxy HCaptcha
captcha
          Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
param Text
"proxytype" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HCaptcha -> [Text]
forall a. HasProxy a (Maybe Proxy) => a -> [Text]
parseProxyType HCaptcha
captcha