{-# LANGUAGE FlexibleContexts #-}

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

import Captcha.Internal.Types (HasAddress (address), HasAuth (auth), HasCookies (cookies), HasPassword (password), HasPort (port), HasProtocol (protocol), HasProxy (proxy), HasUsername (username), Proxy)
import Control.Lens (preview, view, (^?), _Just)
import Data.ByteString.Builder (toLazyByteString)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Encoding (decodeUtf8)
import Web.Cookie (Cookies)
import qualified Web.Cookie as Cookie

-- | Render the cookies as a lazy text.
renderCookies :: HasCookies a Cookies => a -> Text
renderCookies :: a -> Text
renderCookies = Text -> Text
toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cookies -> Builder
Cookie.renderCookies (Cookies -> Builder) -> (a -> Cookies) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Cookies a Cookies -> a -> Cookies
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Cookies a Cookies
forall s a. HasCookies s a => Lens' s a
cookies

-- | Retrieve the proxy's type as, converted into 'Text'.
getProxyType :: HasProxy a (Maybe Proxy) => a -> Maybe Text
getProxyType :: a -> Maybe Text
getProxyType a
captcha = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text)
-> (ProxyProtocol -> String) -> ProxyProtocol -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProxyProtocol -> String
forall a. Show a => a -> String
show (ProxyProtocol -> Text) -> Maybe ProxyProtocol -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
captcha a
-> Getting (First ProxyProtocol) a ProxyProtocol
-> Maybe ProxyProtocol
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe Proxy -> Const (First ProxyProtocol) (Maybe Proxy))
-> a -> Const (First ProxyProtocol) a
forall s a. HasProxy s a => Lens' s a
proxy ((Maybe Proxy -> Const (First ProxyProtocol) (Maybe Proxy))
 -> a -> Const (First ProxyProtocol) a)
-> ((ProxyProtocol -> Const (First ProxyProtocol) ProxyProtocol)
    -> Maybe Proxy -> Const (First ProxyProtocol) (Maybe Proxy))
-> Getting (First ProxyProtocol) a ProxyProtocol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proxy -> Const (First ProxyProtocol) Proxy)
-> Maybe Proxy -> Const (First ProxyProtocol) (Maybe Proxy)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Proxy -> Const (First ProxyProtocol) Proxy)
 -> Maybe Proxy -> Const (First ProxyProtocol) (Maybe Proxy))
-> ((ProxyProtocol -> Const (First ProxyProtocol) ProxyProtocol)
    -> Proxy -> Const (First ProxyProtocol) Proxy)
-> (ProxyProtocol -> Const (First ProxyProtocol) ProxyProtocol)
-> Maybe Proxy
-> Const (First ProxyProtocol) (Maybe Proxy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProxyProtocol -> Const (First ProxyProtocol) ProxyProtocol)
-> Proxy -> Const (First ProxyProtocol) Proxy
forall s a. HasProtocol s a => Lens' s a
protocol

-- | Retrieve the proxy's host address.
getProxyAddress :: HasProxy a (Maybe Proxy) => a -> Maybe Text
getProxyAddress :: a -> Maybe Text
getProxyAddress = Getting (First Text) a Text -> a -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Text) a Text -> a -> Maybe Text)
-> Getting (First Text) a Text -> a -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> a -> Const (First Text) a
forall s a. HasProxy s a => Lens' s a
proxy ((Maybe Proxy -> Const (First Text) (Maybe Proxy))
 -> a -> Const (First Text) a)
-> ((Text -> Const (First Text) Text)
    -> Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> Getting (First Text) a Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proxy -> Const (First Text) Proxy)
-> Maybe Proxy -> Const (First Text) (Maybe Proxy)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Proxy -> Const (First Text) Proxy)
 -> Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> ((Text -> Const (First Text) Text)
    -> Proxy -> Const (First Text) Proxy)
-> (Text -> Const (First Text) Text)
-> Maybe Proxy
-> Const (First Text) (Maybe Proxy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Proxy -> Const (First Text) Proxy
forall s a. HasAddress s a => Lens' s a
address

-- | Retrieve the proxy's port.
getProxyPort :: HasProxy a (Maybe Proxy) => a -> Maybe Int
getProxyPort :: a -> Maybe Int
getProxyPort = Getting (First Int) a Int -> a -> Maybe Int
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Int) a Int -> a -> Maybe Int)
-> Getting (First Int) a Int -> a -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Maybe Proxy -> Const (First Int) (Maybe Proxy))
-> a -> Const (First Int) a
forall s a. HasProxy s a => Lens' s a
proxy ((Maybe Proxy -> Const (First Int) (Maybe Proxy))
 -> a -> Const (First Int) a)
-> ((Int -> Const (First Int) Int)
    -> Maybe Proxy -> Const (First Int) (Maybe Proxy))
-> Getting (First Int) a Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proxy -> Const (First Int) Proxy)
-> Maybe Proxy -> Const (First Int) (Maybe Proxy)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Proxy -> Const (First Int) Proxy)
 -> Maybe Proxy -> Const (First Int) (Maybe Proxy))
-> ((Int -> Const (First Int) Int)
    -> Proxy -> Const (First Int) Proxy)
-> (Int -> Const (First Int) Int)
-> Maybe Proxy
-> Const (First Int) (Maybe Proxy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int) -> Proxy -> Const (First Int) Proxy
forall s a. HasPort s a => Lens' s a
port

-- | Retrieve the proxy's authentication username.
getProxyUsername :: HasProxy a (Maybe Proxy) => a -> Maybe Text
getProxyUsername :: a -> Maybe Text
getProxyUsername = Getting (First Text) a Text -> a -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Text) a Text -> a -> Maybe Text)
-> Getting (First Text) a Text -> a -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> a -> Const (First Text) a
forall s a. HasProxy s a => Lens' s a
proxy ((Maybe Proxy -> Const (First Text) (Maybe Proxy))
 -> a -> Const (First Text) a)
-> ((Text -> Const (First Text) Text)
    -> Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> Getting (First Text) a Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proxy -> Const (First Text) Proxy)
-> Maybe Proxy -> Const (First Text) (Maybe Proxy)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Proxy -> Const (First Text) Proxy)
 -> Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> ((Text -> Const (First Text) Text)
    -> Proxy -> Const (First Text) Proxy)
-> (Text -> Const (First Text) Text)
-> Maybe Proxy
-> Const (First Text) (Maybe Proxy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
-> Proxy -> Const (First Text) Proxy
forall s a. HasAuth s a => Lens' s a
auth ((Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
 -> Proxy -> Const (First Text) Proxy)
-> ((Text -> Const (First Text) Text)
    -> Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
-> (Text -> Const (First Text) Text)
-> Proxy
-> Const (First Text) Proxy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProxyAuth -> Const (First Text) ProxyAuth)
-> Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProxyAuth -> Const (First Text) ProxyAuth)
 -> Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
-> ((Text -> Const (First Text) Text)
    -> ProxyAuth -> Const (First Text) ProxyAuth)
-> (Text -> Const (First Text) Text)
-> Maybe ProxyAuth
-> Const (First Text) (Maybe ProxyAuth)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ProxyAuth -> Const (First Text) ProxyAuth
forall s a. HasUsername s a => Lens' s a
username

-- | Retrieve the proxy's authentication password.
getProxyPassword :: HasProxy a (Maybe Proxy) => a -> Maybe Text
getProxyPassword :: a -> Maybe Text
getProxyPassword = Getting (First Text) a Text -> a -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Text) a Text -> a -> Maybe Text)
-> Getting (First Text) a Text -> a -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> a -> Const (First Text) a
forall s a. HasProxy s a => Lens' s a
proxy ((Maybe Proxy -> Const (First Text) (Maybe Proxy))
 -> a -> Const (First Text) a)
-> ((Text -> Const (First Text) Text)
    -> Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> Getting (First Text) a Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proxy -> Const (First Text) Proxy)
-> Maybe Proxy -> Const (First Text) (Maybe Proxy)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Proxy -> Const (First Text) Proxy)
 -> Maybe Proxy -> Const (First Text) (Maybe Proxy))
-> ((Text -> Const (First Text) Text)
    -> Proxy -> Const (First Text) Proxy)
-> (Text -> Const (First Text) Text)
-> Maybe Proxy
-> Const (First Text) (Maybe Proxy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
-> Proxy -> Const (First Text) Proxy
forall s a. HasAuth s a => Lens' s a
auth ((Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
 -> Proxy -> Const (First Text) Proxy)
-> ((Text -> Const (First Text) Text)
    -> Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
-> (Text -> Const (First Text) Text)
-> Proxy
-> Const (First Text) Proxy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProxyAuth -> Const (First Text) ProxyAuth)
-> Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ProxyAuth -> Const (First Text) ProxyAuth)
 -> Maybe ProxyAuth -> Const (First Text) (Maybe ProxyAuth))
-> ((Text -> Const (First Text) Text)
    -> ProxyAuth -> Const (First Text) ProxyAuth)
-> (Text -> Const (First Text) Text)
-> Maybe ProxyAuth
-> Const (First Text) (Maybe ProxyAuth)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ProxyAuth -> Const (First Text) ProxyAuth
forall s a. HasPassword s a => Lens' s a
password