-- | Our HTTP client library, with better ergonomics for logging and so on (see
-- 'Request').
module Network.HTTP.Client.Transformable
  ( Request,
    mkRequestThrow,
    mkRequestEither,
    tryFromClientRequest,
    url,
    Network.HTTP.Client.Transformable.method,
    headers,
    host,
    body,
    port,
    path,
    queryParams,
    secure,
    timeout,
    getReqSize,
    getQueryStr,
    performRequest,
    Client.Response (..),
    Client.ResponseTimeout,
    Client.HttpException (..),
    Internal.HttpExceptionContent (..),
    Client.Manager,
    Client.responseTimeoutDefault,
    Client.responseTimeoutMicro,
    Client.newManager,
    module Types,
    module TLSClient,
  )
where

import Control.Exception.Safe (impureThrow)
import Control.Lens (Lens', lens, set, to, view, (^.), (^?), _Just)
import Control.Lens.Iso (strict)
import Control.Monad.Catch (MonadThrow, fromException)
import Data.Aeson qualified as J
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Lazy qualified as BL
import Data.CaseInsensitive qualified as CI
import Data.Function ((&))
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.Strict.Lens qualified as Strict (utf8)
import Network.HTTP.Client qualified as Client
import Network.HTTP.Client.Internal qualified as Internal
import Network.HTTP.Client.TLS as TLSClient
import Network.HTTP.Conduit qualified as NHS
import Network.HTTP.Simple qualified as NHS
import Network.HTTP.Types as Types
import Network.URI qualified as URI
import Prelude

-- | @Network.HTTP.Client@.'Client.Request' stores the request body in a sum
-- type which has a case containing IO along with some other unwieldy cases.
-- This makes it difficult to log our requests before and after transformation.
--
-- In our codebase we only ever use the Lazy ByteString case. So by
-- lifting the request body out of Network.HTTP.Client.Request, we
-- make it much easier to log our Requests.
--
-- When executing the request we simply insert the value at `rdBody`
-- into the Request.
--
-- When working with Transformable Requests you should always import
-- this module qualified and use the `mkRequest*` functions for
-- constructing requests. Modification of Request should be done using
-- the provided lens API.
--
-- NOTE: This module is meant to be imported qualified, e.g.
--
-- >  import qualified Network.HTTP.Client.Transformable as HTTP
--
-- ...or
--
-- >  import qualified Network.HTTP.Client.Transformable as Transformable
--
-- Use 'performRequest' to execute the request.
data Request = Request
  { Request -> Request
rdRequest :: Client.Request,
    Request -> Maybe ByteString
rdBody :: Maybe BL.ByteString
  }
  deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

-- XXX: This function makes internal usage of `Strict.utf8`/`TE.decodeUtf8`,
-- which throws an impure exception when the supplied `ByteString` cannot be
-- decoded into valid UTF8 text!
instance J.ToJSON Request where
  toJSON :: Request -> Value
toJSON req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest, Maybe ByteString
rdBody :: Maybe ByteString
rdBody :: Request -> Maybe ByteString
rdBody} =
    [Pair] -> Value
J.object
      [ Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Request
req Request -> Getting Text Request Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Request Text
Lens' Request Text
url),
        Key
"method" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Request
req Request -> Getting Text Request Text -> Text
forall s a. s -> Getting a s a -> a
^. (ByteString -> Const Text ByteString)
-> Request -> Const Text Request
Lens' Request ByteString
method ((ByteString -> Const Text ByteString)
 -> Request -> Const Text Request)
-> ((Text -> Const Text Text)
    -> ByteString -> Const Text ByteString)
-> Getting Text Request Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ByteString -> Const Text ByteString
Prism' ByteString Text
Strict.utf8),
        Key
"headers" Key -> [(Text, Text)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Request
req Request
-> Getting [(Text, Text)] Request [(Text, Text)] -> [(Text, Text)]
forall s a. s -> Getting a s a -> a
^. ([Header] -> Const [(Text, Text)] [Header])
-> Request -> Const [(Text, Text)] Request
Lens' Request [Header]
headers (([Header] -> Const [(Text, Text)] [Header])
 -> Request -> Const [(Text, Text)] Request)
-> (([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
    -> [Header] -> Const [(Text, Text)] [Header])
-> Getting [(Text, Text)] Request [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
-> [Header] -> Const [(Text, Text)] [Header]
renderHeaders),
        Key
"body" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Maybe ByteString
rdBody Maybe ByteString
-> Getting (First Text) (Maybe ByteString) Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ByteString -> Const (First Text) ByteString)
-> Maybe ByteString -> Const (First Text) (Maybe ByteString)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ByteString -> Const (First Text) ByteString)
 -> Maybe ByteString -> Const (First Text) (Maybe ByteString))
-> ((Text -> Const (First Text) Text)
    -> ByteString -> Const (First Text) ByteString)
-> Getting (First Text) (Maybe ByteString) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First Text) ByteString)
-> ByteString -> Const (First Text) ByteString
forall lazy strict. Strict lazy strict => Iso' lazy strict
strict ((ByteString -> Const (First Text) ByteString)
 -> ByteString -> Const (First Text) ByteString)
-> ((Text -> Const (First Text) Text)
    -> ByteString -> Const (First Text) ByteString)
-> (Text -> Const (First Text) Text)
-> ByteString
-> Const (First Text) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ByteString -> Const (First Text) ByteString
Prism' ByteString Text
Strict.utf8),
        Key
"query_string" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Request
rdRequest Request -> Getting Text Request Text -> Text
forall s a. s -> Getting a s a -> a
^. (Request -> ByteString)
-> Optic' (->) (Const Text) Request ByteString
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Request -> ByteString
Client.queryString Optic' (->) (Const Text) Request ByteString
-> ((Text -> Const Text Text)
    -> ByteString -> Const Text ByteString)
-> Getting Text Request Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ByteString -> Const Text ByteString
Prism' ByteString Text
Strict.utf8),
        Key
"response_timeout" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Request
req Request -> Getting String Request String -> String
forall s a. s -> Getting a s a -> a
^. (ResponseTimeout -> Const String ResponseTimeout)
-> Request -> Const String Request
Lens' Request ResponseTimeout
timeout ((ResponseTimeout -> Const String ResponseTimeout)
 -> Request -> Const String Request)
-> ((String -> Const String String)
    -> ResponseTimeout -> Const String ResponseTimeout)
-> Getting String Request String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String)
-> ResponseTimeout -> Const String ResponseTimeout
renderResponseTimeout)
      ]
    where
      renderHeaders :: ([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
-> [Header] -> Const [(Text, Text)] [Header]
renderHeaders = ([Header] -> [(Text, Text)])
-> ([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
-> [Header]
-> Const [(Text, Text)] [Header]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (([Header] -> [(Text, Text)])
 -> ([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
 -> [Header]
 -> Const [(Text, Text)] [Header])
-> ([Header] -> [(Text, Text)])
-> ([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
-> [Header]
-> Const [(Text, Text)] [Header]
forall a b. (a -> b) -> a -> b
$ (Header -> (Text, Text)) -> [Header] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(CI ByteString
keyBytes, ByteString
valBytes) ->
        let keyTxt :: Text
keyTxt = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (CI ByteString -> ByteString) -> CI ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString
forall s. CI s -> s
CI.original (CI ByteString -> Text) -> CI ByteString -> Text
forall a b. (a -> b) -> a -> b
$ CI ByteString
keyBytes
            valTxt :: Text
valTxt = ByteString -> Text
TE.decodeUtf8 ByteString
valBytes
         in (Text
keyTxt, Text
valTxt)

      renderResponseTimeout :: (String -> Const String String)
-> ResponseTimeout -> Const String ResponseTimeout
renderResponseTimeout = (ResponseTimeout -> String)
-> (String -> Const String String)
-> ResponseTimeout
-> Const String ResponseTimeout
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((ResponseTimeout -> String)
 -> (String -> Const String String)
 -> ResponseTimeout
 -> Const String ResponseTimeout)
-> (ResponseTimeout -> String)
-> (String -> Const String String)
-> ResponseTimeout
-> Const String ResponseTimeout
forall a b. (a -> b) -> a -> b
$ \case
        Internal.ResponseTimeoutMicro Int
i -> Int -> String
forall a. Show a => a -> String
show Int
i
        ResponseTimeout
Internal.ResponseTimeoutNone -> String
"None"
        ResponseTimeout
Internal.ResponseTimeoutDefault -> String
"default"

-- | Convert a URL into a Request value.
--
-- NOTE: This function will throw an error in 'MonadThrow' if the URL is
-- invalid.
mkRequestThrow :: MonadThrow m => Text -> m Request
mkRequestThrow :: Text -> m Request
mkRequestThrow Text
urlTxt = do
  Request
request <- String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseRequest (String -> m Request) -> String -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
urlTxt
  Request -> m Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> m Request) -> Request -> m Request
forall a b. (a -> b) -> a -> b
$ Request -> Maybe ByteString -> Request
Request Request
request Maybe ByteString
forall a. Maybe a
Nothing

-- | 'mkRequestThrow' with the 'MonadThrow' instance specialized to 'Either'.
--
-- NOTE: While this function makes use of 'impureThrow', it should be
-- impossible to trigger in practice.
--
-- 'mkRequestThrow' calls 'Client.parseRequest', which only ever throws
-- 'Client.HttpException' errors (which should be "caught" by the
-- 'fromException' cast).
mkRequestEither :: Text -> Either Client.HttpException Request
mkRequestEither :: Text -> Either HttpException Request
mkRequestEither Text
urlTxt =
  Text -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => Text -> m Request
mkRequestThrow Text
urlTxt Either SomeException Request
-> (Either SomeException Request -> Either HttpException Request)
-> Either HttpException Request
forall a b. a -> (a -> b) -> b
& (SomeException -> HttpException)
-> Either SomeException Request -> Either HttpException Request
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
    \SomeException
someExc -> case SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException @Client.HttpException SomeException
someExc of
      Just HttpException
httpExc -> HttpException
httpExc
      Maybe HttpException
Nothing -> SomeException -> HttpException
forall e a. Exception e => e -> a
impureThrow SomeException
someExc

-- | Creates a 'Request', converting it from a 'Client.Request'. This only
-- supports requests that use a Strict/Lazy ByteString as a request body
-- and will fail with all other body types.
--
-- NOTE: You should avoid creating 'Client.Request's and use the 'mk'
-- functions to create 'Request's. This is for if a framework hands you
-- a precreated 'Client.Request' and you don't have a choice.
tryFromClientRequest :: Client.Request -> Either Text Request
tryFromClientRequest :: Request -> Either Text Request
tryFromClientRequest Request
req = case Request -> RequestBody
Client.requestBody Request
req of
  Client.RequestBodyLBS ByteString
lbs -> Request -> Either Text Request
forall a b. b -> Either a b
Right (Request -> Either Text Request) -> Request -> Either Text Request
forall a b. (a -> b) -> a -> b
$ Request -> Maybe ByteString -> Request
Request Request
req (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
lbs)
  Client.RequestBodyBS ByteString
bs -> Request -> Either Text Request
forall a b. b -> Either a b
Right (Request -> Either Text Request) -> Request -> Either Text Request
forall a b. (a -> b) -> a -> b
$ Request -> Maybe ByteString -> Request
Request Request
req (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
bs)
  Client.RequestBodyBuilder Int64
_ Builder
_ -> Text -> Either Text Request
forall a b. a -> Either a b
Left Text
"Unsupported body: Builder"
  Client.RequestBodyStream Int64
_ GivesPopper ()
_ -> Text -> Either Text Request
forall a b. a -> Either a b
Left Text
"Unsupported body: Stream"
  Client.RequestBodyStreamChunked GivesPopper ()
_ -> Text -> Either Text Request
forall a b. a -> Either a b
Left Text
"Unsupported body: Stream Chunked"
  Client.RequestBodyIO IO RequestBody
_ -> Text -> Either Text Request
forall a b. a -> Either a b
Left Text
"Unsupported body: IO"

-- | Url is 'materialized view' into `Request` consisting of
-- concatenation of `host`, `port`, `queryParams`, and `path` in the
-- underlying request object, as well as a literal url field that
-- stores the textual representation that was supplied from metadata.
--
-- The reason why we store the textual URL in addition to the parsed
-- URL in the request is that the parsed URL loses syntactic information
-- such as "does http://foo.com end in a slash?" which is important
-- when a template user has expectations about the $url variable
-- matching the string that was configured in the action.
--
-- We use the literal field to `view` the value but we must
-- carefully set the subcomponents by hand during `set` operations. Be
-- careful modifying this lens and verify against the unit tests..
url :: Lens' Request Text
url :: (Text -> f Text) -> Request -> f Request
url = (Request -> Text)
-> (Request -> Text -> Request) -> Lens' Request Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> Text
getUrl Request -> Text -> Request
setUrl
  where
    getUrl :: Request -> Text
    getUrl :: Request -> Text
getUrl Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
URI.uriToString ShowS
forall a. a -> a
id (Request -> URI
Client.getUri Request
rdRequest) String
forall a. Monoid a => a
mempty

    setUrl :: Request -> Text -> Request
    setUrl :: Request -> Text -> Request
setUrl Request
req Text
url' = Request -> Maybe Request -> Request
forall a. a -> Maybe a -> a
fromMaybe Request
req (Maybe Request -> Request) -> Maybe Request -> Request
forall a b. (a -> b) -> a -> b
$ do
      URI
uri <- String -> Maybe URI
URI.parseURI (Text -> String
T.unpack Text
url')
      URI.URIAuth {String
uriUserInfo :: URIAuth -> String
uriRegName :: URIAuth -> String
uriPort :: URIAuth -> String
uriPort :: String
uriRegName :: String
uriUserInfo :: String
..} <- URI -> Maybe URIAuth
URI.uriAuthority URI
uri
      let host' :: ByteString
host' = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
uriUserInfo String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
uriRegName
          ssl :: Bool
ssl = URI -> String
URI.uriScheme URI
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"https:"
          port' :: Int
port' = case String
uriPort of
            Char
':' : String
newPort -> String -> Int
forall a. Read a => String -> a
read @Int String
newPort
            String
_ -> if Bool
ssl then Int
443 else Int
80
          queryString :: Query
queryString = QueryText -> Query
Types.queryTextToQuery (QueryText -> Query) -> QueryText -> Query
forall a b. (a -> b) -> a -> b
$ ByteString -> QueryText
Types.parseQueryText (ByteString -> QueryText) -> ByteString -> QueryText
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ URI -> String
URI.uriQuery URI
uri
          path' :: ByteString
path' = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ URI -> String
URI.uriPath URI
uri
      Request -> Maybe Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> Maybe Request) -> Request -> Maybe Request
forall a b. (a -> b) -> a -> b
$
        Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request ByteString ByteString
-> ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request ByteString ByteString
Lens' Request ByteString
host ByteString
host'
          Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request Bool Bool -> Bool -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request Bool Bool
Lens' Request Bool
secure Bool
ssl
          Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request Int Int -> Int -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request Int Int
Lens' Request Int
port Int
port'
          Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request Query Query -> Query -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request Query Query
Lens' Request Query
queryParams Query
queryString
          Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request ByteString ByteString
-> ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request ByteString ByteString
Lens' Request ByteString
path ByteString
path'

body :: Lens' Request (Maybe BL.ByteString)
body :: (Maybe ByteString -> f (Maybe ByteString)) -> Request -> f Request
body = (Request -> Maybe ByteString)
-> (Request -> Maybe ByteString -> Request)
-> Lens Request Request (Maybe ByteString) (Maybe ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> Maybe ByteString
rdBody Request -> Maybe ByteString -> Request
setBody
  where
    setBody :: Request -> Maybe BL.ByteString -> Request
    setBody :: Request -> Maybe ByteString -> Request
setBody Request
req Maybe ByteString
body' = Request
req {rdBody :: Maybe ByteString
rdBody = Maybe ByteString
body'}

headers :: Lens' Request [Types.Header]
headers :: ([Header] -> f [Header]) -> Request -> f Request
headers = (Request -> [Header])
-> (Request -> [Header] -> Request) -> Lens' Request [Header]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> [Header]
getHeaders Request -> [Header] -> Request
setHeaders
  where
    getHeaders :: Request -> [Types.Header]
    getHeaders :: Request -> [Header]
getHeaders Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> [Header]
Client.requestHeaders Request
rdRequest

    setHeaders :: Request -> [Types.Header] -> Request
    setHeaders :: Request -> [Header] -> Request
setHeaders req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} [Header]
headers' =
      Request
req {rdRequest :: Request
rdRequest = [Header] -> Request -> Request
NHS.setRequestHeaders [Header]
headers' Request
rdRequest}

host :: Lens' Request B.ByteString
host :: (ByteString -> f ByteString) -> Request -> f Request
host = (Request -> ByteString)
-> (Request -> ByteString -> Request) -> Lens' Request ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> ByteString
getHost Request -> ByteString -> Request
setHost
  where
    getHost :: Request -> B.ByteString
    getHost :: Request -> ByteString
getHost Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> ByteString
Client.host Request
rdRequest

    setHost :: Request -> B.ByteString -> Request
    setHost :: Request -> ByteString -> Request
setHost req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} ByteString
host' =
      Request
req {rdRequest :: Request
rdRequest = ByteString -> Request -> Request
NHS.setRequestHost ByteString
host' Request
rdRequest}

secure :: Lens' Request Bool
secure :: (Bool -> f Bool) -> Request -> f Request
secure = (Request -> Bool)
-> (Request -> Bool -> Request) -> Lens' Request Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> Bool
getSecure Request -> Bool -> Request
setSecure
  where
    getSecure :: Request -> Bool
    getSecure :: Request -> Bool
getSecure Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> Bool
Client.secure Request
rdRequest

    setSecure :: Request -> Bool -> Request
    setSecure :: Request -> Bool -> Request
setSecure req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} Bool
ssl =
      Request
req {rdRequest :: Request
rdRequest = Bool -> Request -> Request
NHS.setRequestSecure Bool
ssl Request
rdRequest}

method :: Lens' Request B.ByteString
method :: (ByteString -> f ByteString) -> Request -> f Request
method = (Request -> ByteString)
-> (Request -> ByteString -> Request) -> Lens' Request ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> ByteString
getMethod Request -> ByteString -> Request
setMethod
  where
    getMethod :: Request -> B.ByteString
    getMethod :: Request -> ByteString
getMethod Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> ByteString
Client.method Request
rdRequest

    setMethod :: Request -> B.ByteString -> Request
    setMethod :: Request -> ByteString -> Request
setMethod req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} ByteString
method' = Request
req {rdRequest :: Request
rdRequest = ByteString -> Request -> Request
NHS.setRequestMethod ByteString
method' Request
rdRequest}

path :: Lens' Request B.ByteString
path :: (ByteString -> f ByteString) -> Request -> f Request
path = (Request -> ByteString)
-> (Request -> ByteString -> Request) -> Lens' Request ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> ByteString
getPath Request -> ByteString -> Request
setPath
  where
    getPath :: Request -> B.ByteString
    getPath :: Request -> ByteString
getPath Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> ByteString
Client.path Request
rdRequest

    setPath :: Request -> B.ByteString -> Request
    setPath :: Request -> ByteString -> Request
setPath req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} ByteString
p =
      Request
req {rdRequest :: Request
rdRequest = Request
rdRequest {path :: ByteString
Client.path = ByteString
p}}

port :: Lens' Request Int
port :: (Int -> f Int) -> Request -> f Request
port = (Request -> Int)
-> (Request -> Int -> Request) -> Lens' Request Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> Int
getPort Request -> Int -> Request
setPort
  where
    getPort :: Request -> Int
    getPort :: Request -> Int
getPort Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> Int
Client.port Request
rdRequest

    setPort :: Request -> Int -> Request
    setPort :: Request -> Int -> Request
setPort req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} Int
i =
      Request
req {rdRequest :: Request
rdRequest = Int -> Request -> Request
NHS.setRequestPort Int
i Request
rdRequest}

getQueryStr :: Request -> ByteString
getQueryStr :: Request -> ByteString
getQueryStr = Bool -> Query -> ByteString
Types.renderQuery Bool
True (Query -> ByteString)
-> (Request -> Query) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Query Request Query -> Request -> Query
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Query Request Query
Lens' Request Query
queryParams

queryParams :: Lens' Request NHS.Query
queryParams :: (Query -> f Query) -> Request -> f Request
queryParams = (Request -> Query)
-> (Request -> Query -> Request) -> Lens' Request Query
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> Query
getQueryParams Request -> Query -> Request
setQueryParams
  where
    getQueryParams :: Request -> NHS.Query
    getQueryParams :: Request -> Query
getQueryParams Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> Query
NHS.getRequestQueryString Request
rdRequest

    setQueryParams :: Request -> NHS.Query -> Request
    setQueryParams :: Request -> Query -> Request
setQueryParams req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} Query
params = Request
req {rdRequest :: Request
rdRequest = Query -> Request -> Request
NHS.setQueryString Query
params Request
rdRequest}

timeout :: Lens' Request Client.ResponseTimeout
timeout :: (ResponseTimeout -> f ResponseTimeout) -> Request -> f Request
timeout = (Request -> ResponseTimeout)
-> (Request -> ResponseTimeout -> Request)
-> Lens' Request ResponseTimeout
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> ResponseTimeout
getTimeout Request -> ResponseTimeout -> Request
setTimeout
  where
    getTimeout :: Request -> Client.ResponseTimeout
    getTimeout :: Request -> ResponseTimeout
getTimeout Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} = Request -> ResponseTimeout
Client.responseTimeout Request
rdRequest

    setTimeout :: Request -> Client.ResponseTimeout -> Request
    setTimeout :: Request -> ResponseTimeout -> Request
setTimeout req :: Request
req@Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest} ResponseTimeout
timeout' =
      let updatedReq :: Request
updatedReq = Request
rdRequest {responseTimeout :: ResponseTimeout
Client.responseTimeout = ResponseTimeout
timeout'}
       in Request
req {rdRequest :: Request
rdRequest = Request
updatedReq}

getReqSize :: Request -> Int64
getReqSize :: Request -> Int64
getReqSize Request {Maybe ByteString
rdBody :: Maybe ByteString
rdBody :: Request -> Maybe ByteString
rdBody} = Int64 -> (ByteString -> Int64) -> Maybe ByteString -> Int64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int64
0 ByteString -> Int64
BL.length Maybe ByteString
rdBody

toRequest :: Request -> Client.Request
toRequest :: Request -> Request
toRequest Request {Request
rdRequest :: Request
rdRequest :: Request -> Request
rdRequest, Maybe ByteString
rdBody :: Maybe ByteString
rdBody :: Request -> Maybe ByteString
rdBody} = case Maybe ByteString
rdBody of
  Maybe ByteString
Nothing -> Request
rdRequest
  Just ByteString
body' -> RequestBody -> Request -> Request
NHS.setRequestBody (ByteString -> RequestBody
Client.RequestBodyLBS ByteString
body') Request
rdRequest

-- | NOTE: for now, please always wrap this in @tracedHttpRequest@ to make sure
-- a trace is logged.
performRequest :: Request -> Client.Manager -> IO (Client.Response BL.ByteString)
performRequest :: Request -> Manager -> IO (Response ByteString)
performRequest Request
req Manager
manager = Request -> Manager -> IO (Response ByteString)
Client.httpLbs (Request -> Request
toRequest Request
req) Manager
manager