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

-- |
-- Module: Captcha.TwoCaptcha.Internal.Types.Image
-- 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.Image 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), ImageCaptcha)
import Captcha.TwoCaptcha.Internal (TwoCaptcha, defaultOptions)
import Control.Lens ((^.))
import Control.Monad.Cont (MonadIO)
import Control.Monad.Reader (MonadReader)
import Data.Text (Text)
import Network.Wreq (FormParam ((:=)))

instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest TwoCaptcha ImageCaptcha r m where
  request :: ImageCaptcha -> Text -> m (Response ByteString)
request ImageCaptcha
captcha = (Text -> [FormParam] -> m (Response ByteString))
-> [FormParam] -> Text -> m (Response ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Options -> Text -> [FormParam] -> m (Response ByteString)
forall r (m :: * -> *) a.
(HasCaptchaEnv r, MonadReader r m, MonadIO m, Postable a) =>
Options -> Text -> a -> m (Response ByteString)
post Options
defaultOptions) [FormParam]
payload
    where
      payload :: [FormParam]
payload =
        [ ByteString
"key" ByteString -> Text -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (ImageCaptcha
captcha ImageCaptcha -> Getting Text ImageCaptcha Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ImageCaptcha Text
forall s a. HasApiKey s a => Lens' s a
apiKey),
          ByteString
"method" ByteString -> Text -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (Text
"base64" :: Text),
          ByteString
"body" ByteString -> Text -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (ImageCaptcha
captcha ImageCaptcha -> Getting Text ImageCaptcha Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ImageCaptcha Text
forall s a. HasBody s a => Lens' s a
body)
        ]