{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

-- | Making HTTP requests using an API inspired by Elm's elm/http.
module Http
  ( -- * Handlers
    Handler,
    handler,

    -- * Requests
    get,
    post,
    request,
    Internal.Request (..),
    Internal.Error (..),

    -- * Header,
    Internal.Header,
    header,

    -- * Body
    Internal.Body,
    emptyBody,
    stringBody,
    jsonBody,
    bytesBody,

    -- * Expect
    Expect,
    expectJson,
    expectText,
    expectWhatever,

    -- * Use with external libraries
    withThirdParty,
    withThirdPartyIO,
  )
where

import qualified Conduit
import qualified Control.Exception.Safe as Exception
import Control.Monad.IO.Class (liftIO)
import qualified Data.Aeson as Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy
import qualified Data.Dynamic as Dynamic
import Data.String (fromString)
import qualified Data.Text.Encoding
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Encoding
import Http.Internal (Body, Expect, Handler)
import qualified Http.Internal as Internal
import qualified Log.HttpRequest as HttpRequest
import qualified Maybe
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.Internal as HTTP.Internal
import qualified Network.HTTP.Client.TLS as TLS
import qualified Network.HTTP.Types.Status as Status
import qualified Network.URI
import qualified Platform
import qualified Task
import Prelude (Either (Left, Right), IO, fromIntegral, pure, show)

-- | Create a 'Handler' for making HTTP requests.
handler :: Conduit.Acquire Handler
handler :: Acquire Handler
handler = do
  Handler
doAnything <- IO Handler -> Acquire Handler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Handler
Platform.doAnythingHandler
  Manager
manager <- Acquire Manager
forall (m :: * -> *). MonadIO m => m Manager
TLS.newTlsManager
  Handler -> Acquire Handler
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Handler -> Acquire Handler) -> Handler -> Acquire Handler
forall a b. (a -> b) -> a -> b
<| (forall expect.
 Typeable expect =>
 Request expect -> Task Error expect)
-> (forall a e. (Manager -> Task e a) -> Task e a)
-> (forall a. LogHandler -> (Manager -> IO a) -> IO a)
-> Handler
Internal.Handler
      (Handler -> Manager -> Request expect -> Task Error expect
forall expect.
Handler -> Manager -> Request expect -> Task Error expect
_request Handler
doAnything Manager
manager)
      (Manager -> (Manager -> Task e a) -> Task e a
forall e a. Manager -> (Manager -> Task e a) -> Task e a
_withThirdParty Manager
manager)
      (Manager -> LogHandler -> (Manager -> IO a) -> IO a
forall a. Manager -> LogHandler -> (Manager -> IO a) -> IO a
_withThirdPartyIO Manager
manager)

-- | Third party libraries that make HTTP requests often take a 'HTTP.Manager'.
-- This helper allows us to call such a library using a 'Handler'.
--
-- The benefit over using this over using a separate 'HTTP.Manager' for the
-- external library, is that 'withThirdParty' will ensure HTTP requests made
-- by the external library will get logged.
withThirdParty :: Handler -> (HTTP.Manager -> Task e a) -> Task e a
withThirdParty :: Handler -> (Manager -> Task e a) -> Task e a
withThirdParty Internal.Handler {handlerWithThirdParty :: Handler -> forall a e. (Manager -> Task e a) -> Task e a
Internal.handlerWithThirdParty = forall a e. (Manager -> Task e a) -> Task e a
wtp} Manager -> Task e a
library =
  (Manager -> Task e a) -> Task e a
forall a e. (Manager -> Task e a) -> Task e a
wtp Manager -> Task e a
library

_withThirdParty :: HTTP.Manager -> (HTTP.Manager -> Task e a) -> Task e a
_withThirdParty :: Manager -> (Manager -> Task e a) -> Task e a
_withThirdParty Manager
manager Manager -> Task e a
library = do
  Manager
requestManager <- Manager -> Task e Manager
forall e. Manager -> Task e Manager
prepareManagerForRequest Manager
manager
  Manager -> Task e a
library Manager
requestManager

-- | Like `withThirdParty`, but runs in `IO`.
withThirdPartyIO :: Platform.LogHandler -> Handler -> (HTTP.Manager -> IO a) -> IO a
withThirdPartyIO :: LogHandler -> Handler -> (Manager -> IO a) -> IO a
withThirdPartyIO LogHandler
log Internal.Handler {handlerWithThirdPartyIO :: Handler -> forall a. LogHandler -> (Manager -> IO a) -> IO a
Internal.handlerWithThirdPartyIO = forall a. LogHandler -> (Manager -> IO a) -> IO a
wtp} Manager -> IO a
library =
  LogHandler -> (Manager -> IO a) -> IO a
forall a. LogHandler -> (Manager -> IO a) -> IO a
wtp LogHandler
log Manager -> IO a
library

_withThirdPartyIO :: HTTP.Manager -> Platform.LogHandler -> (HTTP.Manager -> IO a) -> IO a
_withThirdPartyIO :: Manager -> LogHandler -> (Manager -> IO a) -> IO a
_withThirdPartyIO Manager
manager LogHandler
log Manager -> IO a
library = do
  Manager
requestManager <- Manager -> Task Never Manager
forall e. Manager -> Task e Manager
prepareManagerForRequest Manager
manager Task Never Manager
-> (Task Never Manager -> IO Manager) -> IO Manager
forall a b. a -> (a -> b) -> b
|> LogHandler -> Task Never Manager -> IO Manager
forall a. LogHandler -> Task Never a -> IO a
Task.perform LogHandler
log
  Manager -> IO a
library Manager
requestManager

-- QUICKS

-- | Create a @GET@ request.
get :: Dynamic.Typeable a => Handler -> Text -> Expect a -> Task Error a
get :: Handler -> Text -> Expect a -> Task Error a
get Handler
handler' Text
url Expect a
expect =
  Handler -> Request a -> Task Error a
forall expect.
Typeable expect =>
Handler -> Request expect -> Task Error expect
request
    Handler
handler'
    Request :: forall a.
Text
-> [Header] -> Text -> Body -> Maybe Int -> Expect a -> Request a
Internal.Request
      { method :: Text
Internal.method = Text
"GET",
        headers :: [Header]
Internal.headers = [],
        url :: Text
Internal.url = Text
url,
        body :: Body
Internal.body = Body
emptyBody,
        timeout :: Maybe Int
Internal.timeout = Maybe Int
forall a. Maybe a
Nothing,
        expect :: Expect a
Internal.expect = Expect a
expect
      }

-- | Create a @POST@ request.
post :: Dynamic.Typeable a => Handler -> Text -> Body -> Expect a -> Task Error a
post :: Handler -> Text -> Body -> Expect a -> Task Error a
post Handler
handler' Text
url Body
body Expect a
expect =
  Handler -> Request a -> Task Error a
forall expect.
Typeable expect =>
Handler -> Request expect -> Task Error expect
request
    Handler
handler'
    Request :: forall a.
Text
-> [Header] -> Text -> Body -> Maybe Int -> Expect a -> Request a
Internal.Request
      { method :: Text
Internal.method = Text
"POST",
        headers :: [Header]
Internal.headers = [],
        url :: Text
Internal.url = Text
url,
        body :: Body
Internal.body = Body
body,
        timeout :: Maybe Int
Internal.timeout = Maybe Int
forall a. Maybe a
Nothing,
        expect :: Expect a
Internal.expect = Expect a
expect
      }

-- REQUEST

-- | Create a 'Header'.
header :: Text -> Text -> Internal.Header
header :: Text -> Text -> Header
header Text
key Text
val =
  Header -> Header
Internal.Header
    (String -> HeaderName
forall a. IsString a => String -> a
fromString (Text -> String
Text.toList Text
key), String -> ByteString
forall a. IsString a => String -> a
fromString (Text -> String
Text.toList Text
val))

-- | Create an empty body for your Request. This is useful for GET requests and
-- POST requests where you are not sending any data.
emptyBody :: Body
emptyBody :: Body
emptyBody =
  Body :: ByteString -> Maybe ByteString -> Body
Internal.Body
    { bodyContents :: ByteString
Internal.bodyContents = ByteString
"",
      bodyContentType :: Maybe ByteString
Internal.bodyContentType = Maybe ByteString
forall a. Maybe a
Nothing
    }

-- | Put some string in the body of your Request.
--
-- The first argument is a MIME type of the body. Some servers are strict about
-- this!
stringBody :: Text -> Text -> Body
stringBody :: Text -> Text -> Body
stringBody Text
mimeType Text
text =
  Body :: ByteString -> Maybe ByteString -> Body
Internal.Body
    { bodyContents :: ByteString
Internal.bodyContents = Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
text ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> ByteString -> ByteString
Data.ByteString.Lazy.fromStrict,
      bodyContentType :: Maybe ByteString
Internal.bodyContentType = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
mimeType)
    }

-- | Put some JSON value in the body of your Request. This will automatically
-- add the Content-Type: application/json header.
jsonBody :: Aeson.ToJSON body => body -> Body
jsonBody :: body -> Body
jsonBody body
json =
  Body :: ByteString -> Maybe ByteString -> Body
Internal.Body
    { bodyContents :: ByteString
Internal.bodyContents = body -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode body
json,
      bodyContentType :: Maybe ByteString
Internal.bodyContentType = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"application/json"
    }

-- | Put some Bytes in the body of your Request. This allows you to use
-- ByteString to have full control over the binary representation of the data
-- you are sending.
--
-- The first argument is a MIME type of the body. In other scenarios you may
-- want to use MIME types like image/png or image/jpeg instead.
bytesBody :: Text -> ByteString -> Body
bytesBody :: Text -> ByteString -> Body
bytesBody Text
mimeType ByteString
bytes =
  Body :: ByteString -> Maybe ByteString -> Body
Internal.Body
    { bodyContents :: ByteString
Internal.bodyContents = ByteString -> ByteString
Data.ByteString.Lazy.fromStrict ByteString
bytes,
      bodyContentType :: Maybe ByteString
Internal.bodyContentType = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
mimeType)
    }

-- | Create a custom request.
request ::
  Dynamic.Typeable expect =>
  Handler ->
  Internal.Request expect ->
  Task Error expect
request :: Handler -> Request expect -> Task Error expect
request Internal.Handler {forall expect.
Typeable expect =>
Request expect -> Task Error expect
handlerRequest :: Handler
-> forall expect.
   Typeable expect =>
   Request expect -> Task Error expect
handlerRequest :: forall expect.
Typeable expect =>
Request expect -> Task Error expect
Internal.handlerRequest} Request expect
settings = Request expect -> Task Error expect
forall expect.
Typeable expect =>
Request expect -> Task Error expect
handlerRequest Request expect
settings

_request :: Platform.DoAnythingHandler -> HTTP.Manager -> Internal.Request expect -> Task Error expect
_request :: Handler -> Manager -> Request expect -> Task Error expect
_request Handler
doAnythingHandler Manager
manager Request expect
settings = do
  Manager
requestManager <- Manager -> Task Error Manager
forall e. Manager -> Task e Manager
prepareManagerForRequest Manager
manager
  Handler -> IO (Result Error expect) -> Task Error expect
forall e a. Handler -> IO (Result e a) -> Task e a
Platform.doAnything Handler
doAnythingHandler (IO (Result Error expect) -> Task Error expect)
-> IO (Result Error expect) -> Task Error expect
forall a b. (a -> b) -> a -> b
<| do
    Either HttpException (Response ByteString)
response <-
      IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Exception.try (IO (Response ByteString)
 -> IO (Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
<| do
        Request
basicRequest <-
          String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseUrlThrow (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
<| Text -> String
Text.toList (Request expect -> Text
forall a. Request a -> Text
Internal.url Request expect
settings)
        let finalRequest :: Request
finalRequest =
              Request
basicRequest
                { method :: ByteString
HTTP.method = Text -> ByteString
Data.Text.Encoding.encodeUtf8 (Request expect -> Text
forall a. Request a -> Text
Internal.method Request expect
settings),
                  requestHeaders :: RequestHeaders
HTTP.requestHeaders = case Body -> Maybe ByteString
Internal.bodyContentType (Request expect -> Body
forall a. Request a -> Body
Internal.body Request expect
settings) of
                    Maybe ByteString
Nothing ->
                      Request expect -> [Header]
forall a. Request a -> [Header]
Internal.headers Request expect
settings
                        [Header] -> ([Header] -> RequestHeaders) -> RequestHeaders
forall a b. a -> (a -> b) -> b
|> (Header -> Header) -> [Header] -> RequestHeaders
forall a b. (a -> b) -> List a -> List b
List.map Header -> Header
Internal.unHeader
                    Just ByteString
mimeType ->
                      (HeaderName
"content-type", ByteString
mimeType) Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:
                      (Header -> Header) -> [Header] -> RequestHeaders
forall a b. (a -> b) -> List a -> List b
List.map Header -> Header
Internal.unHeader (Request expect -> [Header]
forall a. Request a -> [Header]
Internal.headers Request expect
settings),
                  requestBody :: RequestBody
HTTP.requestBody = ByteString -> RequestBody
HTTP.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
<| Body -> ByteString
Internal.bodyContents (Request expect -> Body
forall a. Request a -> Body
Internal.body Request expect
settings),
                  responseTimeout :: ResponseTimeout
HTTP.responseTimeout =
                    Request expect -> Maybe Int
forall a. Request a -> Maybe Int
Internal.timeout Request expect
settings
                      Maybe Int -> (Maybe Int -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
Maybe.withDefault (Int
30 Int -> Int -> Int
forall number. Num number => number -> number -> number
* Int
1000)
                      Int -> (Int -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> Int -> Int -> Int
forall number. Num number => number -> number -> number
(*) Int
1000
                      Int -> (Int -> Int) -> Int
forall a b. a -> (a -> b) -> b
|> Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                      Int -> (Int -> ResponseTimeout) -> ResponseTimeout
forall a b. a -> (a -> b) -> b
|> Int -> ResponseTimeout
HTTP.responseTimeoutMicro
                }
        Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
finalRequest Manager
requestManager
    Result Error expect -> IO (Result Error expect)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Error expect -> IO (Result Error expect))
-> Result Error expect -> IO (Result Error expect)
forall a b. (a -> b) -> a -> b
<| case Either HttpException (Response ByteString)
response of
      Right Response ByteString
okResponse ->
        case Expect expect -> ByteString -> Result Text expect
forall a. Expect a -> ByteString -> Result Text a
decode (Request expect -> Expect expect
forall a. Request a -> Expect a
Internal.expect Request expect
settings) (Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
okResponse) of
          Ok expect
decodedBody ->
            expect -> Result Error expect
forall error value. value -> Result error value
Ok expect
decodedBody
          Err Text
message ->
            Error -> Result Error expect
forall error value. error -> Result error value
Err (Text -> Error
Internal.BadBody Text
message)
      Left (HTTP.HttpExceptionRequest Request
_ HttpExceptionContent
content) ->
        case HttpExceptionContent
content of
          HTTP.StatusCodeException Response ()
res ByteString
_ ->
            let statusCode :: Response body -> Int
statusCode = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Status -> Int) -> Status -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Status -> Int
Status.statusCode (Status -> Int)
-> (Response body -> Status) -> Response body -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Response body -> Status
forall body. Response body -> Status
HTTP.responseStatus
             in Error -> Result Error expect
forall error value. error -> Result error value
Err (Int -> Error
Internal.BadStatus (Response () -> Int
forall body. Response body -> Int
statusCode Response ()
res))
          HttpExceptionContent
HTTP.ResponseTimeout ->
            Error -> Result Error expect
forall error value. error -> Result error value
Err Error
Internal.Timeout
          HttpExceptionContent
HTTP.ConnectionTimeout ->
            Error -> Result Error expect
forall error value. error -> Result error value
Err (Text -> Error
Internal.NetworkError Text
"ConnectionTimeout")
          HTTP.ConnectionFailure SomeException
err ->
            Error -> Result Error expect
forall error value. error -> Result error value
Err (Text -> Error
Internal.NetworkError (String -> Text
Text.fromList (SomeException -> String
forall e. Exception e => e -> String
Exception.displayException SomeException
err)))
          HttpExceptionContent
err ->
            Error -> Result Error expect
forall error value. error -> Result error value
Err (Text -> Error
Internal.NetworkError (String -> Text
Text.fromList (HttpExceptionContent -> String
forall a. Show a => a -> String
show HttpExceptionContent
err)))
      Left (HTTP.InvalidUrlException String
_ String
message) ->
        Error -> Result Error expect
forall error value. error -> Result error value
Err (Text -> Error
Internal.BadUrl (String -> Text
Text.fromList String
message))

decode :: Expect a -> Data.ByteString.Lazy.ByteString -> Result Text a
decode :: Expect a -> ByteString -> Result Text a
decode Expect a
Internal.ExpectJson ByteString
bytes =
  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
bytes of
    Left String
err -> Text -> Result Text a
forall error value. error -> Result error value
Err (String -> Text
Text.fromList String
err)
    Right a
x -> a -> Result Text a
forall error value. value -> Result error value
Ok a
x
decode Expect a
Internal.ExpectText ByteString
bytes = (Text -> Result Text Text
forall error value. value -> Result error value
Ok (Text -> Result Text Text)
-> (Text -> Text) -> Text -> Result Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Text -> Text
Data.Text.Lazy.toStrict (Text -> Result Text Text)
-> (ByteString -> Text) -> ByteString -> Result Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< ByteString -> Text
Data.Text.Lazy.Encoding.decodeUtf8) ByteString
bytes
decode Expect a
Internal.ExpectWhatever ByteString
_ = () -> Result Text ()
forall error value. value -> Result error value
Ok ()

-- |
-- Expect the response body to be JSON.
expectJson :: Aeson.FromJSON a => Expect a
expectJson :: Expect a
expectJson = Expect a
forall a. FromJSON a => Expect a
Internal.ExpectJson

-- |
-- Expect the response body to be a `Text`.
expectText :: Expect Text
expectText :: Expect Text
expectText = Expect Text
Internal.ExpectText

-- |
-- Expect the response body to be whatever. It does not matter. Ignore it!
expectWhatever :: Expect ()
expectWhatever :: Expect ()
expectWhatever = Expect ()
Internal.ExpectWhatever

-- |
type Error = Internal.Error

-- Our Task type carries around some context values which should influence in
-- minor ways the logic of sending a request. In this function we modify a
-- manager to apply these modifications (see the comments below for the exact
-- nature of the modifications).
--
-- We're changing settings on the manager that originally get set during the
-- creation of the manager. We cannot set these settings once during creation
-- because they will be different for each outgoing request, and for performance
-- reasons we're encouraged to reuse a manager as much as possible. Modifying a
-- manager in this way does require use of the `Network.HTTP.Client.Internal`
-- module, which on account of being an internal module increases the risk of
-- this code breaking in future versions of the `http-client` package. There's
-- an outstanding PR for motivating these Manager modification functions are
-- moved to the stable API: https://github.com/snoyberg/http-client/issues/426
prepareManagerForRequest :: HTTP.Manager -> Task e HTTP.Manager
prepareManagerForRequest :: Manager -> Task e Manager
prepareManagerForRequest Manager
manager = do
  LogHandler
log <- Task e LogHandler
forall e. Task e LogHandler
Platform.logHandler
  Text
requestId <- Task e Text
forall e. Task e Text
Platform.requestId
  Manager -> Task e Manager
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Manager
manager
      { -- To be able to correlate events and logs belonging to a single
        -- original user request we pass around a request ID on HTTP requests
        -- between services. Below we add this request ID to all outgoing HTTP
        -- requests.
        mModifyRequest :: Request -> IO Request
HTTP.Internal.mModifyRequest = \Request
req ->
          Manager -> Request -> IO Request
HTTP.Internal.mModifyRequest Manager
manager Request
req
            IO Request -> (IO Request -> IO Request) -> IO Request
forall a b. a -> (a -> b) -> b
|> (Request -> IO Request) -> IO Request -> IO Request
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
andThen (Text -> Request -> IO Request
modifyRequest Text
requestId),
        -- We trace outgoing HTTP requests. This comes down to measuring how
        -- long they take and passing that information to some dashboard. This
        -- dashboard can then draw nice graphs showing how the time responding
        -- to a request it divided between different activities, such as sending
        -- HTTP requests. We can use the `mWrapException` for this purpose,
        -- although in our case we're not wrapping because of exceptions.
        mWrapException :: forall a. Request -> IO a -> IO a
HTTP.Internal.mWrapException = \Request
req IO a
io ->
          Manager -> Request -> IO a -> IO a
Manager -> forall a. Request -> IO a -> IO a
HTTP.Internal.mWrapException Manager
manager Request
req IO a
io
            IO a -> (IO a -> IO a) -> IO a
forall a b. a -> (a -> b) -> b
|> LogHandler -> Request -> IO a -> IO a
forall a. LogHandler -> Request -> IO a -> IO a
wrapException LogHandler
log Request
req
      }
  where
    modifyRequest :: Text -> HTTP.Request -> IO HTTP.Request
    modifyRequest :: Text -> Request -> IO Request
modifyRequest Text
requestId Request
req =
      case Text
requestId of
        Text
"" -> Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
req
        Text
_ ->
          Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            Request
req
              { requestHeaders :: RequestHeaders
HTTP.requestHeaders =
                  (HeaderName
"x-request-id", Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
requestId) Header -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:
                  Request -> RequestHeaders
HTTP.requestHeaders Request
req
              }
    wrapException :: forall a. Platform.LogHandler -> HTTP.Request -> IO a -> IO a
    wrapException :: LogHandler -> Request -> IO a -> IO a
wrapException LogHandler
log Request
req IO a
io =
      let uri :: URI
uri = Request -> URI
HTTP.getUri Request
req
          host :: Text
host =
            URI -> String
Network.URI.uriScheme URI
uri
              String -> String -> String
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ ( URI -> Maybe URIAuth
Network.URI.uriAuthority URI
uri
                     Maybe URIAuth
-> (Maybe URIAuth -> String -> String) -> String -> String
forall a b. a -> (a -> b) -> b
|> (String -> String) -> Maybe URIAuth -> String -> String
Network.URI.uriAuthToString (\String
_ -> String
"*****")
                     (String -> String) -> ((String -> String) -> String) -> String
forall a b. a -> (a -> b) -> b
|> (\String -> String
showS -> String -> String
showS String
"")
                 )
              String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
          method :: Text
method =
            Request -> ByteString
HTTP.method Request
req
              ByteString -> (ByteString -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> ByteString -> Text
Data.Text.Encoding.decodeUtf8
          spanDetails :: Outgoing
spanDetails =
            Details -> Outgoing
HttpRequest.Outgoing
              Details
HttpRequest.emptyDetails
                { host :: Maybe Text
HttpRequest.host = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
host,
                  path :: Maybe Text
HttpRequest.path =
                    URI -> String
Network.URI.uriPath URI
uri
                      String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
                      Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Text
forall a. a -> Maybe a
Just,
                  queryString :: Maybe Text
HttpRequest.queryString =
                    URI -> String
Network.URI.uriQuery URI
uri
                      String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList
                      Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Text
forall a. a -> Maybe a
Just,
                  method :: Maybe Text
HttpRequest.method = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
method
                }
          uriStr :: Text
uriStr =
            Request -> URI
HTTP.getUri Request
req
              URI -> (URI -> String -> String) -> String -> String
forall a b. a -> (a -> b) -> b
|> (String -> String) -> URI -> String -> String
Network.URI.uriToString (\String
_ -> String
"*****")
              (String -> String) -> ((String -> String) -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> (\String -> String
showS -> String -> Text
Text.fromList (String -> String
showS String
""))
       in LogHandler -> Text -> (LogHandler -> IO a) -> IO a
forall a.
HasCallStack =>
LogHandler -> Text -> (LogHandler -> IO a) -> IO a
Platform.tracingSpanIO
            LogHandler
log
            Text
"Outoing HTTP Request"
            ( \LogHandler
log' ->
                IO a -> IO () -> IO a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
Exception.finally
                  IO a
io
                  ( do
                      LogHandler -> Outgoing -> IO ()
LogHandler -> forall d. TracingSpanDetails d => d -> IO ()
Platform.setTracingSpanDetailsIO LogHandler
log' Outgoing
spanDetails
                      LogHandler -> Text -> IO ()
Platform.setTracingSpanSummaryIO
                        LogHandler
log'
                        (Text
method Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
" " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
uriStr)
                  )
            )