From 3b8b47baba3f195583838522d4ce1635d689be1c Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Wed, 15 May 2024 11:14:29 +0200 Subject: feat(users/Profpatsch/whatcd-resolver): add status to http trace Change-Id: Ic83a79c18129dd195e808d1c78758dbf0be8ff76 Reviewed-on: https://cl.tvl.fyi/c/depot/+/11672 Autosubmit: Profpatsch Tested-by: BuildkiteCI Reviewed-by: Profpatsch --- users/Profpatsch/whatcd-resolver/src/Http.hs | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) (limited to 'users/Profpatsch') diff --git a/users/Profpatsch/whatcd-resolver/src/Http.hs b/users/Profpatsch/whatcd-resolver/src/Http.hs index bc41ad7529..487d55c21d 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 = -- cgit 1.4.1