diff options
| -rw-r--r-- | users/Profpatsch/whatcd-resolver/src/Http.hs | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/users/Profpatsch/whatcd-resolver/src/Http.hs b/users/Profpatsch/whatcd-resolver/src/Http.hs index bc41ad75295c..487d55c21d88 100644 --- a/users/Profpatsch/whatcd-resolver/src/Http.hs +++ b/users/Profpatsch/whatcd-resolver/src/Http.hs @@ -23,6 +23,7 @@ import Json.Enc qualified as Enc import MyPrelude import Network.HTTP.Client import Network.HTTP.Simple +import Network.HTTP.Types.Status (Status (..)) import Optional import Prelude hiding (span) @@ -53,15 +54,23 @@ doRequestJson :: m (Response ByteString) doRequestJson opts val = inSpan' "HTTP Request (JSON)" $ \span -> do addAttribute span "request.xh" (requestToXhCommandLine opts val) - defaultRequest {secure = not (opts & optsUsePlainHttp)} - & setRequestHost (opts & optsHost) - & setRequestPort (opts & optsPort) - -- TODO: is this automatically escaped by the library? - & setRequestPath (opts & optsPath) - & setRequestHeaders (opts & optsHeaders) - & setRequestMethod opts.method - & setRequestBodyLBS (Enc.encToBytesUtf8Lazy val) - & httpBS + resp <- + defaultRequest {secure = not (opts & optsUsePlainHttp)} + & setRequestHost (opts & optsHost) + & setRequestPort (opts & optsPort) + -- TODO: is this automatically escaped by the library? + & setRequestPath (opts & optsPath) + & setRequestHeaders (opts & optsHeaders) + & setRequestMethod opts.method + & setRequestBodyLBS (Enc.encToBytesUtf8Lazy val) + & httpBS + let code = resp & getResponseStatus & (.statusCode) + let msg = resp & getResponseStatus & (.statusMessage) & bytesToTextUtf8Lenient + addAttribute + span + "request.response.status" + ([fmt|{code} {msg}|] :: Text) + pure resp optsHost :: RequestOptions -> ByteString optsHost opts = |