nri-http-0.2.0.0: test/Main.hs
module Main (main) where
import qualified Conduit
import qualified Control.Concurrent.MVar as MVar
import qualified Control.Exception.Safe as Exception
import qualified Data.ByteString.Lazy
import qualified Data.List
import qualified Debug
import qualified Expect
import qualified Http
import qualified Http.Mock
import qualified Log.HttpRequest as HttpRequest
import qualified Network.HTTP.Types.Status as Status
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Platform
import qualified Task
import Test (Test, describe, test)
import qualified Test
import qualified Prelude
main :: Prelude.IO ()
main = Test.run tests
tests :: Test
tests =
describe
"Http"
[ test "Given a request made using `get` when the response has a 200 status code the task return succeeds" <| \() ->
withServer
(constant "" Status.ok200)
( \http url -> do
Http.get http url Http.expectWhatever
|> Expect.succeeds
),
test "Given a request made using `get` when the response has a 400 status code the task fails with a BadStatus error" <| \() ->
withServer
(constant "" Status.badRequest400)
( \http url -> do
err <-
Http.get http url Http.expectWhatever
|> Expect.fails
err
|> Expect.equal (Http.BadStatus 400)
),
test "Given a request made using `get` that expects a JSON response when the response includes the right JSON it is returned decoded" <| \() ->
withServer
(constant "[1,2,3]" Status.ok200)
( \http url -> do
response <-
Http.get http url Http.expectJson
|> Expect.succeeds
response
|> Expect.equal [1, 2, 3 :: Int]
),
test "Given a request made using `get` that expects a JSON response when the JSON in the responses can not be decoded we fail with a BadBody error" <| \() ->
withServer
(constant "12" Status.ok200)
( \http url -> do
err <-
Http.get http url (Http.expectJson :: Http.Expect Http.Error Text)
|> Expect.fails
err
|> Expect.equal (Http.BadBody "Error in $: parsing Text failed, expected String, but encountered Number")
),
test "When a request is made using `get` to an invalid URL we fail with a BadUrl error" <| \() ->
withServer
(constant "" Status.ok200)
( \http _ -> do
err <-
Http.get http "ceci n'est pas un URL" Http.expectWhatever
|> Expect.fails
err
|> Expect.equal (Http.BadUrl "Invalid URL")
),
test "When a request is made using `get` with a json body the `Content-Type` header is set to `application/json`" <| \() -> do
request <-
expectRequest
( \http url ->
Http.post http url (Http.jsonBody ()) Http.expectWhatever
)
request
|> Wai.requestHeaders
|> Data.List.lookup "content-type"
|> Expect.equal (Just "application/json"),
test "When a request is made using `get` with a json body the JSON is encoded correctly" <| \() -> do
request <-
expectRequest
( \http url ->
Http.post http url (Http.jsonBody [1, 2, 3 :: Int]) Http.expectWhatever
)
body <- Expect.fromIO (Wai.strictRequestBody request)
Expect.equal "[1,2,3]" body,
test "When a request is made using `get` with a string body the `Content-Type` header is set to provided mime type" <| \() -> do
request <-
expectRequest
( \http url ->
Http.post http url (Http.stringBody "element/fire" "WOOSH") Http.expectWhatever
)
request
|> Wai.requestHeaders
|> Data.List.lookup "content-type"
|> Expect.equal (Just "element/fire"),
test "Http requests report the span data we expect" <| \_ ->
withServer
(constant "" Status.ok200)
( \http url -> do
span <-
Http.get http url Http.expectWhatever
|> spanForTask
Debug.toString span
|> Expect.equalToContentsOf "test/golden-results/expected-http-span"
),
test "Http.Mock.stub" <| \_ -> do
urlsAccessed <-
Http.Mock.stub
[Http.Mock.mkStub (\req -> Task.succeed (Http.url req, "Response!") :: Task Http.Error (Text, Text))]
( \http ->
Expect.succeeds <| do
_ <- Http.get http "example.com/one" Http.expectText
_ <- Http.get http "example.com/two" Http.expectText
Task.succeed ()
)
urlsAccessed
|> Expect.equal ["example.com/one", "example.com/two"],
test "Using expectTextResponse, metadata returns the correct status" <| \() ->
withServer
(constant "Some text" Status.ok200)
( \http url -> do
res <-
Http.get http url (Http.expectTextResponse Ok)
|> Expect.succeeds
case res of
Http.GoodStatus_ metadata body -> do
Expect.equal 200 (Http.metadataStatusCode metadata)
Expect.equal "OK" (Http.metadataStatusText metadata)
Expect.equal "Some text" body
other ->
Expect.fail <| "Unexpected response: " ++ (Text.fromList <| Prelude.show other)
),
test "Using expectBytesResponse, we can read the body when the request is not successful" <| \() ->
withServer
(constant "This is a bad request" Status.badRequest400)
( \http url -> do
res <-
Http.get http url (Http.expectBytesResponse Ok)
|> Expect.succeeds
case res of
Http.BadStatus_ metadata body -> do
Expect.equal 400 (Http.metadataStatusCode metadata)
Expect.equal "Bad Request" (Http.metadataStatusText metadata)
Expect.equal "This is a bad request" body
other ->
Expect.fail <| "Unexpected response: " ++ (Text.fromList <| Prelude.show other)
),
test "We can use a custom error type" <| \() ->
withServer
(constant "This is a bad request" Status.badRequest400)
( \http url -> do
res <-
Http.get http url (Http.expectTextResponse (\_ -> Err CustomResponseError)) |> Expect.fails
case res of
CustomResponseError ->
Expect.pass
)
]
data CustomResponseError = CustomResponseError
-- # Wai applications to test against
-- WAI NOT?
-- | A web application that returns the same response to every request.
constant :: Data.ByteString.Lazy.ByteString -> Status.Status -> Wai.Application
constant body status _ respond =
Wai.responseLBS status [] body
|> respond
-- | Run a temporary web application to send requests to.
withServer ::
Wai.Application ->
(Http.Handler -> Text -> Expect.Expectation) ->
Expect.Expectation
withServer app run = do
log <- Expect.succeeds Platform.logHandler
doAnything <- Expect.fromIO Platform.doAnythingHandler
Expect.around
( \runTask ->
withServerIO log app (\http host -> runTask (http, host))
|> Platform.doAnything doAnything
)
(\(http, host) -> run http host)
-- | Run a temporary web application to send requests to.
withServerIO ::
Platform.LogHandler ->
Wai.Application ->
(Http.Handler -> Text -> Task e a) ->
Prelude.IO (Result e a)
withServerIO log app run = do
Conduit.withAcquire Http.handler <| \http ->
Warp.testWithApplication
(Prelude.pure app)
( \port ->
run http ("http://localhost:" ++ Text.fromInt (Prelude.fromIntegral port))
|> Task.attempt log
)
-- | Run a temporary web application that handles a single request, and then
-- 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 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
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)
newtype FirstRequest = FirstRequest Wai.Request deriving (Show)
instance Exception.Exception FirstRequest
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"
(MVar.putMVar spanVar)
"test-root"
(\log -> Task.attempt log task)
Expect.ok res
span <- Expect.fromIO (MVar.takeMVar spanVar)
constantValuesForVariableFields span
|> Task.succeed
|> Expect.succeeds
-- | Timestamps recorded in spans would make each test result different from the
-- last. This helper sets all timestamps to zero to prevent this.
--
-- Similarly the host URI changes in each test, because `warp` pickes a random
-- free port to run a test webserver on. To prevent this from failing tests we
-- set the URI to a standard value.
constantValuesForVariableFields :: Platform.TracingSpan -> Platform.TracingSpan
constantValuesForVariableFields span =
span
{ Platform.started = 0,
Platform.finished = 0,
Platform.details =
Platform.details span
|> andThen
( \details ->
Platform.renderTracingSpanDetails
[ Platform.Renderer
( \(HttpRequest.Outgoing httpDetails) ->
httpDetails {HttpRequest.host = Just "mock-uri"}
|> HttpRequest.Outgoing
|> Platform.toTracingSpanDetails
)
]
details
),
Platform.allocated = 0,
Platform.summary = Just "mock-uri",
Platform.children = map constantValuesForVariableFields (Platform.children span)
}