maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

refactor(users/Profpatsch/whatcd-resolver): continue http

Browse source 
Ideally there’d be a better generic abstraction of doing basic http
calls (with tracing) in the future, but for now just reexport.

Change-Id: Id7548739ea62e9172f2773f8db79fe726096b7f1
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12136
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2024-08-04 11:14:06 +02:00
parent 8908fd18ca
commit 37b2c2ce78
3 changed files with 7 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -5,11 +5,15 @@ module Http
RequestOptions (..), RequestOptions (..),
mkRequestOptions, mkRequestOptions,
httpJson, httpJson,
Http.httpBS,
Http.Request,
Http.setRequestMethod, Http.setRequestMethod,
Http.setQueryString,
Http.setRequestBodyLBS, Http.setRequestBodyLBS,
Http.setRequestHeader, Http.setRequestHeader,
Http.getResponseStatus, Http.getResponseStatus,
Http.getResponseHeader, Http.getResponseHeader,
Http.getResponseHeaders,
Http.getResponseBody, Http.getResponseBody,
) )
where where

1
users/Profpatsch/whatcd-resolver/src/JsonLd.hs
View file

@ -16,7 +16,6 @@ import IHP.HSX.QQ (hsx)
import Json qualified import Json qualified
import Label import Label
import MyPrelude import MyPrelude
import Network.HTTP.Client.Conduit qualified as Http
import Network.HTTP.Types.URI qualified as Url import Network.HTTP.Types.URI qualified as Url
import Network.URI (URI) import Network.URI (URI)
import Optional import Optional

8
users/Profpatsch/whatcd-resolver/src/Redacted.hs
View file

@ -19,8 +19,6 @@ import Http qualified
import Json qualified import Json qualified
import Label import Label
import MyPrelude import MyPrelude
import Network.HTTP.Client.Conduit qualified as Http
import Network.HTTP.Simple qualified as Http
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai.Parse qualified as Wai import Network.Wai.Parse qualified as Wai
import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan') import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
@ -503,17 +501,17 @@ httpTorrent span req =
>>= assertM >>= assertM
span span
( \resp -> do ( \resp -> do
let statusCode = resp & Http.responseStatus & (.statusCode) let statusCode = resp & Http.getResponseStatus & (.statusCode)
contentType = contentType =
resp resp
& Http.responseHeaders & Http.getResponseHeaders
& List.lookup "content-type" & List.lookup "content-type"
<&> Wai.parseContentType <&> Wai.parseContentType
<&> (\(ct, _mimeAttributes) -> ct) <&> (\(ct, _mimeAttributes) -> ct)
if if
| statusCode == 200, | statusCode == 200,
Just "application/x-bittorrent" <- contentType -> Just "application/x-bittorrent" <- contentType ->
Right $ (resp & Http.responseBody) Right $ (resp & Http.getResponseBody)
| statusCode == 200, | statusCode == 200,
Just otherType <- contentType -> Just otherType <- contentType ->
Left [fmt|Redacted returned a non-torrent body, with content-type "{otherType}"|] Left [fmt|Redacted returned a non-torrent body, with content-type "{otherType}"|]