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

-- |
-- Module: Captcha.TwoCaptcha.Internal.Types.Text
-- 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.Text where

import Captcha.Internal.Monad (HasCaptchaEnv)
import Captcha.Internal.Monad.Class (CaptchaRequest (request))
import Captcha.Internal.Request (post)
import Captcha.Internal.Types (HasApiKey (apiKey), HasBody (body), TextCaptcha)
import Captcha.TwoCaptcha.Internal (TwoCaptcha, defaultOptions)
import Control.Lens ((&), (.~), (^.))
import Control.Monad.Cont (MonadIO)
import Control.Monad.Reader (MonadReader)
import Data.Aeson (object)
import Network.Wreq (param)

instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest TwoCaptcha TextCaptcha r m where
  request :: TextCaptcha -> Text -> m (Response ByteString)
request TextCaptcha
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
.~ [TextCaptcha
captcha TextCaptcha -> Getting Text TextCaptcha Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextCaptcha 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
"textcaptcha" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TextCaptcha
captcha TextCaptcha -> Getting Text TextCaptcha Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextCaptcha Text
forall s a. HasBody s a => Lens' s a
body]