mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
1 changed files with 18 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
users/Profpatsch/whatcd-resolver/src/Http.hs
View file

@ -23,6 +23,7 @@ import Json.Enc qualified as Enc
import MyPrelude import MyPrelude
import Network.HTTP.Client import Network.HTTP.Client
import Network.HTTP.Simple import Network.HTTP.Simple
import Network.HTTP.Types.Status (Status (..))
import Optional import Optional
import Prelude hiding (span) import Prelude hiding (span)
@ -53,15 +54,23 @@ doRequestJson ::
m (Response ByteString) m (Response ByteString)
doRequestJson opts val = inSpan' "HTTP Request (JSON)" $ \span -> do doRequestJson opts val = inSpan' "HTTP Request (JSON)" $ \span -> do
addAttribute span "request.xh" (requestToXhCommandLine opts val) addAttribute span "request.xh" (requestToXhCommandLine opts val)
defaultRequest {secure = not (opts & optsUsePlainHttp)} resp <-
& setRequestHost (opts & optsHost) defaultRequest {secure = not (opts & optsUsePlainHttp)}
& setRequestPort (opts & optsPort) & setRequestHost (opts & optsHost)
-- TODO: is this automatically escaped by the library? & setRequestPort (opts & optsPort)
& setRequestPath (opts & optsPath) -- TODO: is this automatically escaped by the library?
& setRequestHeaders (opts & optsHeaders) & setRequestPath (opts & optsPath)
& setRequestMethod opts.method & setRequestHeaders (opts & optsHeaders)
& setRequestBodyLBS (Enc.encToBytesUtf8Lazy val) & setRequestMethod opts.method
& httpBS & 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 :: RequestOptions -> ByteString
optsHost opts = optsHost opts =