diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2022, NoRedInk +Copyright (c) 2026, NoRedInk All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/nri-http.cabal b/nri-http.cabal --- a/nri-http.cabal +++ b/nri-http.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.5. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: nri-http -version: 0.3.0.0 +version: 0.7.0.1 synopsis: Make Elm style HTTP requests description: Please see the README at . category: Web @@ -13,14 +13,14 @@ bug-reports: https://github.com/NoRedInk/haskell-libraries/issues author: NoRedInk maintainer: haskell-open-source@noredink.com -copyright: 2022 NoRedInk Corp. +copyright: 2026 NoRedInk Corp. license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md LICENSE - test/golden-results/expected-http-span + test/golden-results-9.8/expected-http-span source-repository head type: git @@ -54,9 +54,9 @@ NumericUnderscores ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -fplugin=NriPrelude.Plugin build-depends: - aeson >=1.4.6.0 && <2.1 - , base >=4.12.0.0 && <4.17 - , bytestring >=0.10.8.2 && <0.12 + aeson >=2.0 && <2.3 + , base >=4.18 && <4.22 + , bytestring >=0.10.8.2 && <0.13 , case-insensitive >=1.1 && <2.0 , conduit >=1.3.0 && <1.4 , http-client >=0.6.0 && <0.8 @@ -64,10 +64,10 @@ , http-types ==0.12.* , mime-types >=0.1.0.0 && <0.2 , network-uri >=2.6.0.0 && <2.8 - , nri-observability >=0.1.0.0 && <0.2 - , nri-prelude >=0.1.0.0 && <0.7 + , nri-observability >=0.1.0.0 && <0.5 + , nri-prelude >=0.7.0.0 && <0.8 , safe-exceptions >=0.1.7.0 && <1.3 - , text >=1.2.3.1 && <2.1 + , text >=1.2.3.1 && <2.2 default-language: Haskell2010 test-suite spec @@ -77,6 +77,7 @@ Http Http.Internal Http.Mock + GoldenHelpers Paths_nri_http hs-source-dirs: src @@ -99,9 +100,9 @@ NumericUnderscores ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -fplugin=NriPrelude.Plugin -fno-warn-type-defaults build-depends: - aeson >=1.4.6.0 && <2.1 - , base >=4.12.0.0 && <4.17 - , bytestring >=0.10.8.2 && <0.12 + aeson >=2.0 && <2.3 + , base >=4.18 && <4.22 + , bytestring >=0.10.8.2 && <0.13 , case-insensitive >=1.1 && <2.0 , conduit >=1.3.0 && <1.4 , http-client >=0.6.0 && <0.8 @@ -109,10 +110,10 @@ , http-types ==0.12.* , mime-types >=0.1.0.0 && <0.2 , network-uri >=2.6.0.0 && <2.8 - , nri-observability >=0.1.0.0 && <0.2 - , nri-prelude >=0.1.0.0 && <0.7 + , nri-observability >=0.1.0.0 && <0.4 + , nri-prelude >=0.7.0.0 && <0.8 , safe-exceptions >=0.1.7.0 && <1.3 - , text >=1.2.3.1 && <2.1 + , text >=1.2.3.1 && <2.2 , wai >=3.2.0 && <3.3 , warp >=3.3.0 && <3.4 default-language: Haskell2010 diff --git a/src/Http.hs b/src/Http.hs --- a/src/Http.hs +++ b/src/Http.hs @@ -6,7 +6,12 @@ ( -- * Handlers Handler, handler, + handlerWith, + -- * Settings + HttpSettings (..), + defaultHttpSettings, + -- * Requests get, post, @@ -57,30 +62,53 @@ import qualified Data.Text.Encoding import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Encoding +import Data.Version (showVersion) import qualified Dict -import Http.Internal (Body, Expect, Handler, Expect') +import Http.Internal (Body, Expect, Expect', Handler) import qualified Http.Internal as Internal import qualified Log.HttpRequest as HttpRequest import qualified Maybe import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP.Internal import qualified Network.HTTP.Client.TLS as TLS +import qualified Network.HTTP.Types.Header as Header import qualified Network.HTTP.Types.Status as Status import qualified Network.URI +import Paths_nri_http (version) import qualified Platform import qualified Task import Prelude (Either (Left, Right), IO, fromIntegral, pure) +-- | Settings that influence HTTP requests. +data HttpSettings = HttpSettings + { -- | The User-Agent header to include in requests. + userAgent :: Text, + -- | The default timeout for requests, in microseconds. + defaultTimeout :: Int + } + +-- | The default 'HttpSettings'. +defaultHttpSettings :: HttpSettings +defaultHttpSettings = + HttpSettings + { userAgent = "nri-http/" ++ Text.fromList (showVersion version), + defaultTimeout = 30 * 1000 * 1000 + } + -- | Create a 'Handler' for making HTTP requests. handler :: Conduit.Acquire Handler -handler = do +handler = handlerWith defaultHttpSettings + +-- | Create a 'Handler' for making HTTP requests with specific settings. +handlerWith :: HttpSettings -> Conduit.Acquire Handler +handlerWith settings = do doAnything <- liftIO Platform.doAnythingHandler manager <- TLS.newTlsManager - pure - <| Internal.Handler - (_request doAnything manager) - (_withThirdParty manager) - (_withThirdPartyIO manager) + pure <| + Internal.Handler + (_request settings doAnything manager) + (_withThirdParty settings manager) + (_withThirdPartyIO settings manager) -- | Third party libraries that make HTTP requests often take a 'HTTP.Manager'. -- This helper allows us to call such a library using a 'Handler'. @@ -92,9 +120,9 @@ withThirdParty Internal.Handler {Internal.handlerWithThirdParty = wtp} library = wtp library -_withThirdParty :: HTTP.Manager -> (HTTP.Manager -> Task e a) -> Task e a -_withThirdParty manager library = do - requestManager <- prepareManagerForRequest manager +_withThirdParty :: HttpSettings -> HTTP.Manager -> (HTTP.Manager -> Task e a) -> Task e a +_withThirdParty settings manager library = do + requestManager <- prepareManagerForRequest settings manager library requestManager -- | Like `withThirdParty`, but runs in `IO`. @@ -102,9 +130,9 @@ withThirdPartyIO log Internal.Handler {Internal.handlerWithThirdPartyIO = wtp} library = wtp log library -_withThirdPartyIO :: HTTP.Manager -> Platform.LogHandler -> (HTTP.Manager -> IO a) -> IO a -_withThirdPartyIO manager log library = do - requestManager <- prepareManagerForRequest manager |> Task.perform log +_withThirdPartyIO :: HttpSettings -> HTTP.Manager -> Platform.LogHandler -> (HTTP.Manager -> IO a) -> IO a +_withThirdPartyIO settings manager log library = do + requestManager <- prepareManagerForRequest settings manager |> Task.perform log library requestManager -- QUICKS @@ -167,7 +195,7 @@ -- | Put some JSON value in the body of your Request. This will automatically -- add the Content-Type: application/json header. -jsonBody :: Aeson.ToJSON body => body -> Body +jsonBody :: (Aeson.ToJSON body) => body -> Body jsonBody json = Internal.Body { Internal.bodyContents = Aeson.encode json, @@ -197,55 +225,53 @@ Task x expect request Internal.Handler {Internal.handlerRequest} settings = handlerRequest settings -_request :: Platform.DoAnythingHandler -> HTTP.Manager -> Internal.Request' x expect -> Task x expect -_request doAnythingHandler manager settings = do - requestManager <- prepareManagerForRequest manager +_request :: HttpSettings -> Platform.DoAnythingHandler -> HTTP.Manager -> Internal.Request' x expect -> Task x expect +_request settings doAnythingHandler manager req = do + requestManager <- prepareManagerForRequest settings manager Platform.doAnything doAnythingHandler <| do response <- Exception.try <| do basicRequest <- - HTTP.parseUrlThrow <| Text.toList (Internal.url settings) + HTTP.parseUrlThrow <| Text.toList (Internal.url req) let finalRequest = basicRequest - { HTTP.method = Data.Text.Encoding.encodeUtf8 (Internal.method settings), - HTTP.requestHeaders = case Internal.bodyContentType (Internal.body settings) of + { HTTP.method = Data.Text.Encoding.encodeUtf8 (Internal.method req), + HTTP.requestHeaders = case Internal.bodyContentType (Internal.body req) of Nothing -> - Internal.headers settings + Internal.headers req |> List.map Internal.unHeader Just mimeType -> - ("content-type", mimeType) : - List.map Internal.unHeader (Internal.headers settings), - HTTP.requestBody = HTTP.RequestBodyLBS <| Internal.bodyContents (Internal.body settings), + ("content-type", mimeType) + : List.map Internal.unHeader (Internal.headers req), + HTTP.requestBody = HTTP.RequestBodyLBS <| Internal.bodyContents (Internal.body req), HTTP.responseTimeout = - Internal.timeout settings - |> Maybe.withDefault (30 * 1000) - |> (*) 1000 + Internal.timeout req + |> Maybe.withDefault (defaultTimeout settings) |> fromIntegral |> HTTP.responseTimeoutMicro } HTTP.httpLbs finalRequest requestManager - pure <| handleResponse (Internal.expect settings) response + pure <| handleResponse (Internal.expect req) response handleResponse :: Expect' x a -> Either HTTP.HttpException (HTTP.Response Data.ByteString.Lazy.ByteString) -> Result x a handleResponse expect response = case response of Right okResponse -> let bytes = HTTP.responseBody okResponse - bodyAsText = Data.Text.Lazy.toStrict <| Data.Text.Lazy.Encoding.decodeUtf8 bytes in case expect of Internal.ExpectJson -> case Aeson.eitherDecode bytes of Left err -> Err (Internal.BadBody (Text.fromList err)) Right x -> Ok x - Internal.ExpectText -> Ok bodyAsText + Internal.ExpectText -> Ok (Data.Text.Lazy.toStrict <| Data.Text.Lazy.Encoding.decodeUtf8 bytes) Internal.ExpectWhatever -> Ok () - Internal.ExpectTextResponse mkResult -> mkResult (Internal.GoodStatus_ (mkMetadata okResponse) bodyAsText) - Internal.ExpectBytesResponse mkResult -> mkResult (Internal.GoodStatus_ (mkMetadata okResponse) (Data.ByteString.Lazy.toStrict bytes)) + Internal.ExpectTextResponse mkResult -> mkResult (Internal.GoodStatus_ (mkMetadata okResponse) (Data.Text.Lazy.toStrict <| Data.Text.Lazy.Encoding.decodeUtf8 bytes)) + Internal.ExpectBytesResponse mkResult -> mkResult (Internal.GoodStatus_ (mkMetadata okResponse) (bytes)) Left exception -> case expect of Internal.ExpectTextResponse mkResult -> exception - |> exceptionToResponse Data.Text.Encoding.decodeUtf8 + |> exceptionToResponse (Data.Text.Lazy.toStrict << Data.Text.Lazy.Encoding.decodeUtf8) |> mkResult Internal.ExpectBytesResponse mkResult -> exception @@ -282,7 +308,7 @@ err -> Internal.NetworkError (Debug.toString err) -exceptionToResponse :: (ByteString -> a) -> HTTP.HttpException -> Internal.Response a +exceptionToResponse :: (Data.ByteString.Lazy.ByteString -> a) -> HTTP.HttpException -> Internal.Response a exceptionToResponse toBody exception = case exception of HTTP.InvalidUrlException _ message -> @@ -290,7 +316,7 @@ HTTP.HttpExceptionRequest _ content -> case content of HTTP.StatusCodeException res bytes -> - Internal.BadStatus_ (mkMetadata res) (toBody bytes) + Internal.BadStatus_ (mkMetadata res) (toBody <| Data.ByteString.Lazy.fromStrict bytes) HTTP.ResponseTimeout -> Internal.Timeout_ HTTP.ConnectionTimeout -> @@ -327,7 +353,7 @@ -- | -- Expect the response body to be JSON. -expectJson :: Aeson.FromJSON a => Expect a +expectJson :: (Aeson.FromJSON a) => Expect a expectJson = Internal.ExpectJson -- | @@ -347,10 +373,9 @@ -- | -- Expect a `Response` with a `ByteString` body -expectBytesResponse :: (Internal.Response ByteString -> Result x a) -> Expect' x a +expectBytesResponse :: (Internal.Response Data.ByteString.Lazy.ByteString -> Result x a) -> Expect' x a expectBytesResponse = Internal.ExpectBytesResponse --- | type Error = Internal.Error -- Our Task type carries around some context values which should influence in @@ -367,8 +392,8 @@ -- this code breaking in future versions of the `http-client` package. There's -- an outstanding PR for motivating these Manager modification functions are -- moved to the stable API: https://github.com/snoyberg/http-client/issues/426 -prepareManagerForRequest :: HTTP.Manager -> Task e HTTP.Manager -prepareManagerForRequest manager = do +prepareManagerForRequest :: HttpSettings -> HTTP.Manager -> Task e HTTP.Manager +prepareManagerForRequest settings manager = do log <- Platform.logHandler requestId <- Platform.requestId pure @@ -376,10 +401,11 @@ { -- To be able to correlate events and logs belonging to a single -- original user request we pass around a request ID on HTTP requests -- between services. Below we add this request ID to all outgoing HTTP - -- requests. + -- requests. Also we add a User-Agent header to all outgoing requests. HTTP.Internal.mModifyRequest = \req -> HTTP.Internal.mModifyRequest manager req - |> andThen (modifyRequest requestId), + |> map (addRequestIdHeader requestId) + |> map (addUserAgentHeader), -- We trace outgoing HTTP requests. This comes down to measuring how -- long they take and passing that information to some dashboard. This -- dashboard can then draw nice graphs showing how the time responding @@ -391,17 +417,23 @@ |> wrapException log req } where - modifyRequest :: Text -> HTTP.Request -> IO HTTP.Request - modifyRequest requestId req = + addHeader :: Header.Header -> HTTP.Request -> HTTP.Request + addHeader hdr req = + let hasHeader = List.any (\(name, _) -> name == Tuple.first hdr) (HTTP.requestHeaders req) + in if hasHeader + then req + else req {HTTP.requestHeaders = hdr : HTTP.requestHeaders req} + + addRequestIdHeader :: Text -> HTTP.Request -> HTTP.Request + addRequestIdHeader requestId req = case requestId of - "" -> pure req - _ -> - pure - req - { HTTP.requestHeaders = - ("x-request-id", Data.Text.Encoding.encodeUtf8 requestId) : - HTTP.requestHeaders req - } + "" -> req + _ -> addHeader ("X-Request-ID", Data.Text.Encoding.encodeUtf8 requestId) req + + addUserAgentHeader :: HTTP.Request -> HTTP.Request + addUserAgentHeader = + addHeader (Header.hUserAgent, Data.Text.Encoding.encodeUtf8 (userAgent settings)) + wrapException :: forall a. Platform.LogHandler -> HTTP.Request -> IO a -> IO a wrapException log req io = let uri = HTTP.getUri req diff --git a/src/Http/Internal.hs b/src/Http/Internal.hs --- a/src/Http/Internal.hs +++ b/src/Http/Internal.hs @@ -5,7 +5,6 @@ import qualified Control.Exception.Safe as Exception import qualified Data.Aeson as Aeson -import qualified Data.ByteString import qualified Data.ByteString.Lazy import qualified Data.Dynamic as Dynamic import Dict (Dict) @@ -56,11 +55,11 @@ -- | Logic for interpreting a response body. data Expect' x a where - ExpectJson :: Aeson.FromJSON a => Expect a + ExpectJson :: (Aeson.FromJSON a) => Expect a ExpectText :: Expect Text ExpectWhatever :: Expect () ExpectTextResponse :: (Response Text -> Result x a) -> Expect' x a - ExpectBytesResponse :: (Response Data.ByteString.ByteString -> Result x a) -> Expect' x a + ExpectBytesResponse :: (Response Data.ByteString.Lazy.ByteString -> Result x a) -> Expect' x a -- | A 'Request' can fail in a couple of ways: -- diff --git a/src/Http/Mock.hs b/src/Http/Mock.hs --- a/src/Http/Mock.hs +++ b/src/Http/Mock.hs @@ -16,11 +16,11 @@ ) where +import qualified Control.Concurrent.MVar as MVar import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy import qualified Data.Dynamic as Dynamic -import qualified Data.IORef import Data.String (fromString) import qualified Data.Text.Encoding import qualified Debug @@ -76,28 +76,35 @@ (Internal.Handler -> Expect.Expectation) -> Expect.Expectation' (List a) stub responders stubbedTestBody = do - logRef <- Expect.fromIO (Data.IORef.newIORef []) + logRef <- Expect.fromIO (MVar.newMVar []) doAnything <- Expect.fromIO Platform.doAnythingHandler let mockHandler = Internal.Handler ( \req -> do (log, res) <- tryRespond responders req - Data.IORef.modifyIORef' logRef (\prev -> log : prev) - |> map Ok - |> Platform.doAnything doAnything - Prelude.pure res + -- `modifyMVar_` and `withMVar` aren't completely atomic so those + -- could introduce a source of flake if used. that said, `takeMVar` + + -- `putMVar` aren't exception-safe. this is fine for the simple + -- usecase of just prepending to the contained list but if this logic + -- ever needs to include potentially-exception-causing code we'll need + -- to think a bit harder + -- (ref: https://hackage.haskell.org/package/base-4.21.0.0/docs/Control-Concurrent-MVar.html#v:withMVar) + Platform.doAnything doAnything <| do + prev <- MVar.takeMVar logRef + MVar.putMVar logRef (log : prev) + Prelude.pure (Ok res) ) (\_ -> Debug.todo "We don't mock third party HTTP calls yet") (\_ -> Debug.todo "We don't mock third party HTTP calls yet") Expect.around (\f -> f mockHandler) (Stack.withFrozenCallStack stubbedTestBody) - Expect.fromIO (Data.IORef.readIORef logRef) + Expect.fromIO (MVar.readMVar logRef) |> map List.reverse -- | Read the body of the request as text. Useful to check what data got -- submitted inside a 'stub' function. -- -- This will return 'Nothing' if the body cannot be parsed as UTF8 text. -getTextBody :: Internal.Request expect -> Maybe Text +getTextBody :: Internal.Request' e expect -> Maybe Text getTextBody req = Data.Text.Encoding.decodeUtf8' (getBytesBody req) |> eitherToMaybe @@ -106,7 +113,7 @@ -- submitted inside a 'stub' function. -- -- This will return an error if parsing the JSON body fails. -getJsonBody :: Aeson.FromJSON a => Internal.Request expect -> Result Text a +getJsonBody :: (Aeson.FromJSON a) => Internal.Request' e expect -> Result Text a getJsonBody req = case Aeson.eitherDecodeStrict (getBytesBody req) of Prelude.Left err -> Err (Text.fromList err) @@ -114,7 +121,7 @@ -- | Read the body of the request as bytes. Useful to check what data got -- submitted inside a 'stub' function. -getBytesBody :: Internal.Request expect -> ByteString +getBytesBody :: Internal.Request' e expect -> ByteString getBytesBody req = Internal.body req |> Internal.bodyContents @@ -125,7 +132,7 @@ -- -- This will return 'Nothing' if no header with that name was set on the -- request. -getHeader :: Text -> Internal.Request expect -> Maybe Text +getHeader :: Text -> Internal.Request' e expect -> Maybe Text getHeader name req = Internal.headers req |> List.map Internal.unHeader @@ -171,7 +178,7 @@ |> Maybe.andThen Dynamic.fromDynamic |> Maybe.withDefault (tryRespond rest req) -printType :: Dynamic.Typeable expect => proxy expect -> Text +printType :: (Dynamic.Typeable expect) => proxy expect -> Text printType expect = Type.Reflection.someTypeRep expect |> Debug.toString diff --git a/test/GoldenHelpers.hs b/test/GoldenHelpers.hs new file mode 100644 --- /dev/null +++ b/test/GoldenHelpers.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} + +module GoldenHelpers (goldenResultsDir) where + +-- | Historical context: +-- Golden results are slightly different between GHC 9.2.x and 8.10.x due +-- to apparent differences in internal handling of stack frame source locations. +-- In particular, the end of a function call now does not extend to the end of +-- the line but instead to the end of the function name. E.g. for the following: +-- +-- > foo +-- > bar +-- > baz +-- +-- In GHC 8.10.x (and possibly GHC 9.0.x?) `srcLocEndLine` and `srcLocEndCol` +-- would correspond to the `z` at the end of `baz`. Unfortunately, in GHC 9.2.x +-- it corresponds to the second `o` at the end of `foo`. +-- +-- We keep this helper around so that if this happens again for future GHC versions +-- we can have different golden results for different GHC versions as necessary. +goldenResultsDir :: Text +goldenResultsDir = "test/golden-results-9.8" diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -7,6 +7,7 @@ import qualified Data.List import qualified Debug import qualified Expect +import GoldenHelpers (goldenResultsDir) import qualified Http import qualified Http.Mock import qualified Log.HttpRequest as HttpRequest @@ -109,7 +110,7 @@ Http.get http url Http.expectWhatever |> spanForTask Debug.toString span - |> Expect.equalToContentsOf "test/golden-results/expected-http-span" + |> Expect.equalToContentsOf (goldenResultsDir ++ "/expected-http-span") ), test "Http.Mock.stub" <| \_ -> do urlsAccessed <- @@ -210,13 +211,13 @@ -- immediately returns that request so you can run expectations against it. -- -- Useful if you want to check properties of requests you send. -expectRequest :: Show e => (Http.Handler -> Text -> Task e a) -> Expect.Expectation' Wai.Request +expectRequest :: (Show e) => (Http.Handler -> Text -> Task e a) -> Expect.Expectation' Wai.Request expectRequest run = do let app req _respond = Exception.throwIO (FirstRequest req) log <- Expect.succeeds Platform.logHandler either <- Expect.fromIO <| Exception.try (withServerIO log app run) - Expect.succeeds - <| case either of + Expect.succeeds <| + case either of Prelude.Left (FirstRequest req) -> Task.succeed req Prelude.Right (Ok _) -> Task.fail "Expected a request, but none was received." Prelude.Right (Err err) -> Task.fail (Debug.toString err) @@ -225,13 +226,14 @@ instance Exception.Exception FirstRequest -spanForTask :: Show e => Task e () -> Expect.Expectation' Platform.TracingSpan +spanForTask :: (Show e) => Task e () -> Expect.Expectation' Platform.TracingSpan spanForTask task = do spanVar <- Expect.fromIO MVar.newEmptyMVar res <- Expect.fromIO <| do Platform.rootTracingSpanIO "test-request" + Platform.silentTrack (MVar.putMVar spanVar) "test-root" (\log -> Task.attempt log task) diff --git a/test/golden-results-9.8/expected-http-span b/test/golden-results-9.8/expected-http-span new file mode 100644 --- /dev/null +++ b/test/golden-results-9.8/expected-http-span @@ -0,0 +1,51 @@ +TracingSpan + { name = "test-root" + , started = MonotonicTime { inMicroseconds = 0 } + , finished = MonotonicTime { inMicroseconds = 0 } + , frame = + Just + ( "rootTracingSpanIO" + , SrcLoc + { srcLocPackage = "nri-http-0.6.0.0-inplace-spec" + , srcLocModule = "Main" + , srcLocFile = "test/Main.hs" + , srcLocStartLine = 234 + , srcLocStartCol = 7 + , srcLocEndLine = 234 + , srcLocEndCol = 33 + } + ) + , details = Nothing + , summary = Just "mock-uri" + , succeeded = Succeeded + , containsFailures = False + , allocated = 0 + , children = + [ TracingSpan + { name = "Outgoing HTTP Request" + , started = MonotonicTime { inMicroseconds = 0 } + , finished = MonotonicTime { inMicroseconds = 0 } + , frame = + Just + ( "tracingSpanIO" + , SrcLoc + { srcLocPackage = "nri-http-0.6.0.0-inplace-spec" + , srcLocModule = "Http" + , srcLocFile = "src/Http.hs" + , srcLocStartLine = 433 + , srcLocStartCol = 11 + , srcLocEndLine = 433 + , srcLocEndCol = 33 + } + ) + , details = + Just + "{\"method\":\"GET\",\"host\":\"mock-uri\",\"path\":\"/\",\"query string\":\"\",\"headers\":{}}" + , summary = Just "mock-uri" + , succeeded = Succeeded + , containsFailures = False + , allocated = 0 + , children = [] + } + ] + } diff --git a/test/golden-results/expected-http-span b/test/golden-results/expected-http-span deleted file mode 100644 --- a/test/golden-results/expected-http-span +++ /dev/null @@ -1,49 +0,0 @@ -TracingSpan - { name = "test-root" - , started = MonotonicTime { inMicroseconds = 0 } - , finished = MonotonicTime { inMicroseconds = 0 } - , frame = - Just - ( "rootTracingSpanIO" - , SrcLoc - { srcLocPackage = "main" - , srcLocModule = "Main" - , srcLocFile = "test/Main.hs" - , srcLocStartLine = 233 - , srcLocStartCol = 7 - , srcLocEndLine = 237 - , srcLocEndCol = 40 - } - ) - , details = Nothing - , summary = Just "mock-uri" - , succeeded = Succeeded - , allocated = 0 - , children = - [ TracingSpan - { name = "Outgoing HTTP Request" - , started = MonotonicTime { inMicroseconds = 0 } - , finished = MonotonicTime { inMicroseconds = 0 } - , frame = - Just - ( "tracingSpanIO" - , SrcLoc - { srcLocPackage = "main" - , srcLocModule = "Http" - , srcLocFile = "src/Http.hs" - , srcLocStartLine = 436 - , srcLocStartCol = 11 - , srcLocEndLine = 448 - , srcLocEndCol = 14 - } - ) - , details = - Just - "{\"method\":\"GET\",\"host\":\"mock-uri\",\"path\":\"/\",\"query string\":\"\",\"headers\":{}}" - , summary = Just "mock-uri" - , succeeded = Succeeded - , allocated = 0 - , children = [] - } - ] - }