feat(users/Profpatsch/whatcd-resolver): add status to http trace

Change-Id: Ic83a79c18129dd195e808d1c78758dbf0be8ff76
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11672
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2024-05-15 11:14:29 +02:00 committed by clbot
parent 44d8bf80f5
commit 3b8b47baba

View file

@ -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 =