diff --git a/docs/Examples/Image/Main.purs b/docs/Examples/Image/Main.purs index f48882b..2b96fe9 100644 --- a/docs/Examples/Image/Main.purs +++ b/docs/Examples/Image/Main.purs @@ -20,8 +20,7 @@ filePath = "./docs/Examples/Image/circle.png" -- | Respond with image data when run image :: HTTPure.Request -> HTTPure.ResponseM -image _ = - FS.readFile filePath >>= HTTPure.binaryResponse' 200 headers +image _ = FS.readFile filePath >>= HTTPure.ok' headers where headers = HTTPure.header "Content-Type" "image/png" diff --git a/src/HTTPure.purs b/src/HTTPure.purs index 51464da..e9699c8 100644 --- a/src/HTTPure.purs +++ b/src/HTTPure.purs @@ -20,7 +20,6 @@ import HTTPure.Response ( Response , ResponseM , response, response' - , binaryResponse, binaryResponse' , emptyResponse, emptyResponse' -- 1xx diff --git a/src/HTTPure/Body.purs b/src/HTTPure/Body.purs index 73413e1..5e68dc6 100644 --- a/src/HTTPure/Body.purs +++ b/src/HTTPure/Body.purs @@ -1,13 +1,14 @@ module HTTPure.Body - ( Body(..) + ( class Body , read - , write , size + , write ) where import Prelude import Data.Either as Either +import Data.Maybe as Maybe import Effect as Effect import Effect.Aff as Aff import Effect.Ref as Ref @@ -16,11 +17,44 @@ import Node.Encoding as Encoding import Node.HTTP as HTTP import Node.Stream as Stream --- | The `Body` type is just sugar for a `String`, that will be sent or received --- | in the HTTP body. -data Body - = StringBody String - | BinaryBody Buffer.Buffer +-- | Types that implement the `Body` class can be used as a body to an HTTPure +-- | response, and can be used with all the response helpers. +class Body b where + + -- | Given a body value, return an effect that maybe calculates a size. + -- | TODO: This is a `Maybe` to support chunked transfer encoding. We still + -- | need to add code to send the body using chunking if the effect resolves a + -- | `Maybe.Nothing`. + size :: b -> Effect.Effect (Maybe.Maybe Int) + + -- | Given a body value and a Node HTTP `Response` value, write the body value + -- | to the Node response. + write :: b -> HTTP.Response -> Aff.Aff Unit + +-- | The instance for `String` will convert the string to a buffer first in +-- | order to determine it's size. This is to properly handle UTF-8 characters +-- | in the string. Writing is simply implemented by writing the string to the +-- | response stream and closing the response stream. +instance bodyString :: Body String where + size body = Buffer.fromString body Encoding.UTF8 >>= size + write body response = Aff.makeAff \done -> do + let stream = HTTP.responseAsStream response + _ <- Stream.writeString stream Encoding.UTF8 body $ pure unit + _ <- Stream.end stream $ pure unit + done $ Either.Right unit + pure Aff.nonCanceler + +-- | The instance for `Buffer` is trivial--to calculate size, we use +-- | `Buffer.size`, and to send the response, we just write the buffer to the +-- | stream and end the stream. +instance bodyBuffer :: Body Buffer.Buffer where + size = Buffer.size >>> map Maybe.Just + write body response = Aff.makeAff \done -> do + let stream = HTTP.responseAsStream response + _ <- Stream.write stream body $ pure unit + _ <- Stream.end stream $ pure unit + done $ Either.Right unit + pure Aff.nonCanceler -- | Extract the contents of the body of the HTTP `Request`. read :: HTTP.Request -> Aff.Aff String @@ -30,21 +64,4 @@ read request = Aff.makeAff \done -> do Stream.onDataString stream Encoding.UTF8 \str -> void $ Ref.modify ((<>) str) buf Stream.onEnd stream $ Ref.read buf >>= Either.Right >>> done - pure $ Aff.nonCanceler - --- | Write a `Body` to the given HTTP `Response` and close it. -write :: HTTP.Response -> Body -> Effect.Effect Unit -write response body = void do - _ <- writeToStream $ pure unit - Stream.end stream $ pure unit - where - stream = HTTP.responseAsStream response - writeToStream = - case body of - StringBody str -> Stream.writeString stream Encoding.UTF8 str - BinaryBody buf -> Stream.write stream buf - --- | Get the size of the body in bytes -size :: Body -> Effect.Effect Int -size (StringBody body) = Buffer.fromString body Encoding.UTF8 >>= Buffer.size -size (BinaryBody body) = Buffer.size body + pure Aff.nonCanceler diff --git a/src/HTTPure/Headers.purs b/src/HTTPure/Headers.purs index 9e48bed..d2dcd13 100644 --- a/src/HTTPure/Headers.purs +++ b/src/HTTPure/Headers.purs @@ -1,5 +1,5 @@ module HTTPure.Headers - ( Headers + ( Headers(..) , empty , headers , header @@ -11,6 +11,7 @@ import Prelude import Effect as Effect import Foreign.Object as Object +import Data.Newtype as Newtype import Data.String as String import Data.TraversableWithIndex as TraversableWithIndex import Data.Tuple as Tuple @@ -22,6 +23,7 @@ import HTTPure.Lookup ((!!)) -- | The `Headers` type is just sugar for a `Object` of `Strings` -- | that represents the set of headers in an HTTP request or response. newtype Headers = Headers (Object.Object String) +derive instance newtypeHeaders :: Newtype.Newtype Headers _ -- | Given a string, return a `Maybe` containing the value of the matching -- | header, if there is any. @@ -50,9 +52,7 @@ read = HTTP.requestHeaders >>> Headers -- | Given an HTTP `Response` and a `Headers` object, return an effect that will -- | write the `Headers` to the `Response`. -write :: HTTP.Response -> - Headers -> - Effect.Effect Unit +write :: HTTP.Response -> Headers -> Effect.Effect Unit write response (Headers headers') = void $ TraversableWithIndex.traverseWithIndex (HTTP.setHeader response) headers' diff --git a/src/HTTPure/Lookup.purs b/src/HTTPure/Lookup.purs index a9ac71e..d765f5d 100644 --- a/src/HTTPure/Lookup.purs +++ b/src/HTTPure/Lookup.purs @@ -16,7 +16,7 @@ import Foreign.Object as Object -- | retrieve some value. For instance, you could have an implementation for -- | `String Int String` where `lookup s i` returns `Just` a `String` containing -- | the character in `s` at `i`, or `Nothing` if `i` is out of bounds. -class Lookup c k r where +class Lookup c k r | c -> r where -- | Given some type and a key on that type, extract some value that -- | corresponds to that key. diff --git a/src/HTTPure/Response.purs b/src/HTTPure/Response.purs index f72ee19..79ed777 100644 --- a/src/HTTPure/Response.purs +++ b/src/HTTPure/Response.purs @@ -3,7 +3,6 @@ module HTTPure.Response , ResponseM , send , response, response' - , binaryResponse, binaryResponse' , emptyResponse, emptyResponse' -- 1xx @@ -79,9 +78,9 @@ module HTTPure.Response import Prelude -import Effect as Effect +import Data.Maybe as Maybe import Effect.Aff as Aff -import Node.Buffer as Buffer +import Effect.Class as EffectClass import Node.HTTP as HTTP import HTTPure.Body as Body @@ -97,45 +96,37 @@ type ResponseM = Aff.Aff Response type Response = { status :: Status.Status , headers :: Headers.Headers - , body :: Body.Body + , writeBody :: HTTP.Response -> Aff.Aff Unit + , size :: Maybe.Maybe Int } -- | Given an HTTP `Response` and a HTTPure `Response`, this method will return -- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response` -- | and closing the HTTP `Response`. -send :: HTTP.Response -> Response -> Effect.Effect Unit -send httpresponse { status, headers, body } = do - Status.write httpresponse $ status - size <- Body.size body - Headers.write httpresponse $ headers <> contentLength size - Body.write httpresponse $ body +send :: HTTP.Response -> Response -> Aff.Aff Unit +send httpresponse { status, headers, writeBody, size } = do + EffectClass.liftEffect $ Status.write httpresponse status + EffectClass.liftEffect $ Headers.write httpresponse finalHeaders + writeBody httpresponse where - contentLength size = Headers.header "Content-Length" $ show size + finalHeaders = headers <> contentLength size + contentLength (Maybe.Just s) = Headers.header "Content-Length" $ show s + contentLength Maybe.Nothing = Headers.empty -- | For custom response statuses or providing a body for response codes that -- | don't typically send one. -response :: Status.Status -> String -> ResponseM +response :: forall b. Body.Body b => Status.Status -> b -> ResponseM response status = response' status Headers.empty -- | The same as `response` but with headers. -response' :: Status.Status -> +response' :: forall b. Body.Body b => + Status.Status -> Headers.Headers -> - String -> + b -> ResponseM -response' status headers body = - pure $ { status, headers, body: Body.StringBody body } - --- | Like `response`, but the response body is binary data. -binaryResponse :: Status.Status -> Buffer.Buffer -> Aff.Aff Response -binaryResponse status = binaryResponse' status Headers.empty - --- | The same as `binaryResponse` but with headers. -binaryResponse' :: Status.Status -> - Headers.Headers -> - Buffer.Buffer -> - Aff.Aff Response -binaryResponse' status headers body - = pure $ { status, headers, body: Body.BinaryBody body } +response' status headers body = do + size <- EffectClass.liftEffect $ Body.size body + pure $ { status, headers, size, writeBody: Body.write body } -- | The same as `response` but without a body. emptyResponse :: Status.Status -> ResponseM @@ -178,11 +169,11 @@ processing' = emptyResponse' Status.processing --------- -- | 200 -ok :: String -> ResponseM +ok :: forall b. Body.Body b => b -> ResponseM ok = ok' Headers.empty -- | 200 with headers -ok' :: Headers.Headers -> String -> ResponseM +ok' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM ok' = response' Status.ok -- | 201 @@ -202,12 +193,13 @@ accepted' :: Headers.Headers -> ResponseM accepted' = emptyResponse' Status.accepted -- | 203 -nonAuthoritativeInformation :: String -> ResponseM +nonAuthoritativeInformation :: forall b. Body.Body b => b -> ResponseM nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty -- | 203 with headers -nonAuthoritativeInformation' :: Headers.Headers -> - String -> +nonAuthoritativeInformation' :: forall b. Body.Body b => + Headers.Headers -> + b -> ResponseM nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation @@ -228,19 +220,19 @@ resetContent' :: Headers.Headers -> ResponseM resetContent' = emptyResponse' Status.resetContent -- | 206 -partialContent :: String -> ResponseM +partialContent :: forall b. Body.Body b => b -> ResponseM partialContent = partialContent' Headers.empty -- | 206 with headers -partialContent' :: Headers.Headers -> String -> ResponseM +partialContent' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM partialContent' = response' Status.partialContent -- | 207 -multiStatus :: String -> ResponseM +multiStatus :: forall b. Body.Body b => b -> ResponseM multiStatus = multiStatus' Headers.empty -- | 207 with headers -multiStatus' :: Headers.Headers -> String -> ResponseM +multiStatus' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM multiStatus' = response' Status.multiStatus -- | 208 @@ -252,11 +244,11 @@ alreadyReported' :: Headers.Headers -> ResponseM alreadyReported' = emptyResponse' Status.alreadyReported -- | 226 -iMUsed :: String -> ResponseM +iMUsed :: forall b. Body.Body b => b -> ResponseM iMUsed = iMUsed' Headers.empty -- | 226 with headers -iMUsed' :: Headers.Headers -> String -> ResponseM +iMUsed' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM iMUsed' = response' Status.iMUsed --------- @@ -264,35 +256,35 @@ iMUsed' = response' Status.iMUsed --------- -- | 300 -multipleChoices :: String -> ResponseM +multipleChoices :: forall b. Body.Body b => b -> ResponseM multipleChoices = multipleChoices' Headers.empty -- | 300 with headers -multipleChoices' :: Headers.Headers -> String -> ResponseM +multipleChoices' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM multipleChoices' = response' Status.multipleChoices -- | 301 -movedPermanently :: String -> ResponseM +movedPermanently :: forall b. Body.Body b => b -> ResponseM movedPermanently = movedPermanently' Headers.empty -- | 301 with headers -movedPermanently' :: Headers.Headers -> String -> ResponseM +movedPermanently' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM movedPermanently' = response' Status.movedPermanently -- | 302 -found :: String -> ResponseM +found :: forall b. Body.Body b => b -> ResponseM found = found' Headers.empty -- | 302 with headers -found' :: Headers.Headers -> String -> ResponseM +found' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM found' = response' Status.found -- | 303 -seeOther :: String -> ResponseM +seeOther :: forall b. Body.Body b => b -> ResponseM seeOther = seeOther' Headers.empty -- | 303 with headers -seeOther' :: Headers.Headers -> String -> ResponseM +seeOther' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM seeOther' = response' Status.seeOther -- | 304 @@ -304,27 +296,27 @@ notModified' :: Headers.Headers -> ResponseM notModified' = emptyResponse' Status.notModified -- | 305 -useProxy :: String -> ResponseM +useProxy :: forall b. Body.Body b => b -> ResponseM useProxy = useProxy' Headers.empty -- | 305 with headers -useProxy' :: Headers.Headers -> String -> ResponseM +useProxy' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM useProxy' = response' Status.useProxy -- | 307 -temporaryRedirect :: String -> ResponseM +temporaryRedirect :: forall b. Body.Body b => b -> ResponseM temporaryRedirect = temporaryRedirect' Headers.empty -- | 307 with headers -temporaryRedirect' :: Headers.Headers -> String -> ResponseM +temporaryRedirect' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM temporaryRedirect' = response' Status.temporaryRedirect -- | 308 -permanentRedirect :: String -> ResponseM +permanentRedirect :: forall b. Body.Body b => b -> ResponseM permanentRedirect = permanentRedirect' Headers.empty -- | 308 with headers -permanentRedirect' :: Headers.Headers -> String -> ResponseM +permanentRedirect' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM permanentRedirect' = response' Status.permanentRedirect @@ -333,11 +325,11 @@ permanentRedirect' = response' Status.permanentRedirect --------- -- | 400 -badRequest :: String -> ResponseM +badRequest :: forall b. Body.Body b => b -> ResponseM badRequest = badRequest' Headers.empty -- | 400 with headers -badRequest' :: Headers.Headers -> String -> ResponseM +badRequest' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM badRequest' = response' Status.badRequest -- | 401 @@ -405,11 +397,11 @@ requestTimeout' :: Headers.Headers -> ResponseM requestTimeout' = emptyResponse' Status.requestTimeout -- | 409 -conflict :: String -> ResponseM +conflict :: forall b. Body.Body b => b -> ResponseM conflict = conflict' Headers.empty -- | 409 with headers -conflict' :: Headers.Headers -> String -> ResponseM +conflict' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM conflict' = response' Status.conflict -- | 410 @@ -561,11 +553,14 @@ unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons --------- -- | 500 -internalServerError :: String -> ResponseM +internalServerError :: forall b. Body.Body b => b -> ResponseM internalServerError = internalServerError' Headers.empty -- | 500 with headers -internalServerError' :: Headers.Headers -> String -> ResponseM +internalServerError' :: forall b. Body.Body b => + Headers.Headers -> + b -> + ResponseM internalServerError' = response' Status.internalServerError -- | 501 diff --git a/src/HTTPure/Server.purs b/src/HTTPure/Server.purs index a75334e..48261b1 100644 --- a/src/HTTPure/Server.purs +++ b/src/HTTPure/Server.purs @@ -10,7 +10,6 @@ import Prelude import Effect as Effect import Effect.Aff as Aff -import Effect.Class as EffectClass import Data.Maybe as Maybe import Data.Options ((:=), Options) import Node.Encoding as Encoding @@ -37,7 +36,7 @@ handleRequest :: (Request.Request -> Response.ResponseM) -> handleRequest router request response = void $ Aff.runAff (\_ -> pure unit) do req <- Request.fromHTTPRequest request - router req >>= Response.send response >>> EffectClass.liftEffect + router req >>= Response.send response -- | Given a `ListenOptions` object, a function mapping `Request` to -- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and diff --git a/test/Test/HTTPure/BodySpec.purs b/test/Test/HTTPure/BodySpec.purs index a54dcab..3e5cf9e 100644 --- a/test/Test/HTTPure/BodySpec.purs +++ b/test/Test/HTTPure/BodySpec.purs @@ -2,6 +2,7 @@ module Test.HTTPure.BodySpec where import Prelude +import Data.Maybe as Maybe import Effect.Class as EffectClass import Node.Buffer as Buffer import Node.Encoding as Encoding @@ -21,28 +22,37 @@ readSpec = Spec.describe "read" do sizeSpec :: TestHelpers.Test sizeSpec = Spec.describe "size" do - Spec.it "returns the correct size for ASCII string body" do - size <- EffectClass.liftEffect $ Body.size $ Body.StringBody "ascii" - size ?= 5 - - Spec.it "returns the correct size for UTF-8 string body" do - size <- EffectClass.liftEffect $ Body.size $ Body.StringBody "\x2603" -- snowman - size ?= 3 - - Spec.it "returns the correct size for binary body" do - size <- EffectClass.liftEffect do - buf <- Buffer.fromString "foobar" Encoding.UTF8 - Body.size $ Body.BinaryBody buf - size ?= 6 + Spec.describe "String" do + Spec.it "returns the correct size for ASCII string body" do + size <- EffectClass.liftEffect $ Body.size "ascii" + size ?= Maybe.Just 5 + Spec.it "returns the correct size for UTF-8 string body" do + size <- EffectClass.liftEffect $ Body.size "\x2603" -- snowman + size ?= Maybe.Just 3 + Spec.describe "Buffer" do + Spec.it "returns the correct size for binary body" do + size <- EffectClass.liftEffect do + buf <- Buffer.fromString "foobar" Encoding.UTF8 + Body.size buf + size ?= Maybe.Just 6 writeSpec :: TestHelpers.Test writeSpec = Spec.describe "write" do - Spec.it "writes the string to the Response body" do - body <- EffectClass.liftEffect do - resp <- TestHelpers.mockResponse - Body.write resp $ Body.StringBody "test" - pure $ TestHelpers.getResponseBody resp - body ?= "test" + Spec.describe "String" do + Spec.it "writes the String to the Response body" do + body <- do + resp <- EffectClass.liftEffect TestHelpers.mockResponse + Body.write "test" resp + pure $ TestHelpers.getResponseBody resp + body ?= "test" + Spec.describe "Buffer" do + Spec.it "writes the Buffer to the Response body" do + body <- do + resp <- EffectClass.liftEffect TestHelpers.mockResponse + buf <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8 + Body.write buf resp + pure $ TestHelpers.getResponseBody resp + body ?= "test" bodySpec :: TestHelpers.Test bodySpec = Spec.describe "Body" do diff --git a/test/Test/HTTPure/HTTPureEffectsSpec.purs b/test/Test/HTTPure/HTTPureEffectsSpec.purs deleted file mode 100644 index 73f9acc..0000000 --- a/test/Test/HTTPure/HTTPureEffectsSpec.purs +++ /dev/null @@ -1,11 +0,0 @@ -module Test.HTTPure.HTTPureEffectsSpec where - -import Prelude - -import Test.Spec as Spec - -import Test.HTTPure.TestHelpers as TestHelpers - -httpureEffectsSpec :: TestHelpers.Test -httpureEffectsSpec = Spec.describe "HTTPureEffects" do - pure unit diff --git a/test/Test/HTTPure/LookupSpec.purs b/test/Test/HTTPure/LookupSpec.purs index 1cdb157..302e3eb 100644 --- a/test/Test/HTTPure/LookupSpec.purs +++ b/test/Test/HTTPure/LookupSpec.purs @@ -30,23 +30,22 @@ hasSpec = Spec.describe "has" do Spec.it "is false" do [ "one", "two", "three" ] !? 4 ?= false -lookupArraySpec :: TestHelpers.Test -lookupArraySpec = Spec.describe "lookupArray" do - Spec.describe "when the index is in bounds" do - Spec.it "is Just the value at the index" do - [ "one", "two", "three" ] !! 1 ?= Maybe.Just "two" - Spec.describe "when the index is out of bounds" do - Spec.it "is Nothing" do - (([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing - -lookupMapSpec :: TestHelpers.Test -lookupMapSpec = Spec.describe "lookupMap" do - Spec.describe "when the key is in the Map" do - Spec.it "is Just the value at the given key" do - mockMap !! "foo" ?= Maybe.Just "bar" - Spec.describe "when the key is not in the Map" do - Spec.it "is Nothing" do - ((mockMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing +lookupFunctionSpec :: TestHelpers.Test +lookupFunctionSpec = Spec.describe "lookup" do + Spec.describe "Array" do + Spec.describe "when the index is in bounds" do + Spec.it "is Just the value at the index" do + [ "one", "two", "three" ] !! 1 ?= Maybe.Just "two" + Spec.describe "when the index is out of bounds" do + Spec.it "is Nothing" do + (([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing + Spec.describe "Map" do + Spec.describe "when the key is in the Map" do + Spec.it "is Just the value at the given key" do + mockMap !! "foo" ?= Maybe.Just "bar" + Spec.describe "when the key is not in the Map" do + Spec.it "is Nothing" do + ((mockMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing where mockMap = Object.singleton "foo" "bar" @@ -54,5 +53,4 @@ lookupSpec :: TestHelpers.Test lookupSpec = Spec.describe "Lookup" do atSpec hasSpec - lookupArraySpec - lookupMapSpec + lookupFunctionSpec diff --git a/test/Test/HTTPure/ResponseSpec.purs b/test/Test/HTTPure/ResponseSpec.purs index 2ff5e6f..d02e08e 100644 --- a/test/Test/HTTPure/ResponseSpec.purs +++ b/test/Test/HTTPure/ResponseSpec.purs @@ -2,13 +2,15 @@ module Test.HTTPure.ResponseSpec where import Prelude +import Data.Either as Either +import Data.Maybe as Maybe +import Effect.Aff as Aff import Effect.Class as EffectClass -import Node.Buffer as Buffer import Node.Encoding as Encoding +import Node.HTTP as HTTP +import Node.Stream as Stream import Test.Spec as Spec -import Test.Spec.Assertions as Assertions -import HTTPure.Body as Body import HTTPure.Headers as Headers import HTTPure.Response as Response @@ -18,35 +20,41 @@ import Test.HTTPure.TestHelpers ((?=)) sendSpec :: TestHelpers.Test sendSpec = Spec.describe "send" do Spec.it "writes the headers" do - header <- EffectClass.liftEffect do - httpResponse <- TestHelpers.mockResponse - Response.send httpResponse mockResponse + header <- do + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + Response.send httpResponse $ mockResponse unit pure $ TestHelpers.getResponseHeader "Test" httpResponse header ?= "test" Spec.it "sets the Content-Length header" do - header <- EffectClass.liftEffect do - httpResponse <- TestHelpers.mockResponse - Response.send httpResponse mockResponse + header <- do + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + Response.send httpResponse $ mockResponse unit pure $ TestHelpers.getResponseHeader "Content-Length" httpResponse header ?= "4" Spec.it "writes the status" do - status <- EffectClass.liftEffect do - httpResponse <- TestHelpers.mockResponse - Response.send httpResponse mockResponse + status <- do + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + Response.send httpResponse $ mockResponse unit pure $ TestHelpers.getResponseStatus httpResponse status ?= 123 Spec.it "writes the body" do - body <- EffectClass.liftEffect do - httpResponse <- TestHelpers.mockResponse - Response.send httpResponse mockResponse + body <- do + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + Response.send httpResponse $ mockResponse unit pure $ TestHelpers.getResponseBody httpResponse body ?= "test" where mockHeaders = Headers.header "Test" "test" - mockResponse = + mockResponse _ = { status: 123 , headers: mockHeaders - , body: Body.StringBody "test" + , writeBody: \response -> Aff.makeAff \done -> do + stream <- pure $ HTTP.responseAsStream response + _ <- Stream.writeString stream Encoding.UTF8 "test" $ pure unit + _ <- Stream.end stream $ pure unit + done $ Either.Right unit + pure Aff.nonCanceler + , size: Maybe.Just 4 } responseFunctionSpec :: TestHelpers.Test @@ -57,11 +65,16 @@ responseFunctionSpec = Spec.describe "response" do Spec.it "has empty headers" do resp <- Response.response 123 "test" resp.headers ?= Headers.empty - Spec.it "has the right body" do + Spec.it "has the right size" do resp <- Response.response 123 "test" - case resp.body of - Body.StringBody str -> str ?= "test" - _ -> Assertions.fail "String body expected" + resp.size ?= Maybe.Just 4 + Spec.it "has the right writeBody function" do + body <- do + resp <- Response.response 123 "test" + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + resp.writeBody httpResponse + pure $ TestHelpers.getResponseBody httpResponse + body ?= "test" response'Spec :: TestHelpers.Test response'Spec = Spec.describe "response'" do @@ -71,56 +84,20 @@ response'Spec = Spec.describe "response'" do Spec.it "has the right headers" do resp <- mockResponse resp.headers ?= mockHeaders - Spec.it "has the right body" do + Spec.it "has the right size" do resp <- mockResponse - case resp.body of - Body.StringBody str -> str ?= "test" - _ -> Assertions.fail "String body expected" + resp.size ?= Maybe.Just 4 + Spec.it "has the right writeBody function" do + body <- do + resp <- mockResponse + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + resp.writeBody httpResponse + pure $ TestHelpers.getResponseBody httpResponse + body ?= "test" where mockHeaders = Headers.header "Test" "test" mockResponse = Response.response' 123 mockHeaders "test" -binaryResponseSpec :: TestHelpers.Test -binaryResponseSpec = Spec.describe "binaryResponse" do - Spec.it "has the right status" do - body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8 - resp <- Response.binaryResponse 123 body - resp.status ?= 123 - Spec.it "has empty headers" do - body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8 - resp <- Response.binaryResponse 123 body - resp.headers ?= Headers.empty - Spec.it "has the right body" do - body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8 - resp <- Response.binaryResponse 123 body - case resp.body of - Body.BinaryBody bin -> do - str <- EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 bin - str ?= "test" - _ -> Assertions.fail "Binary body expected" - -binaryResponse'Spec :: TestHelpers.Test -binaryResponse'Spec = Spec.describe "binaryResponse'" do - Spec.it "has the right status" do - body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8 - resp <- mockResponse body - resp.status ?= 123 - Spec.it "has the right headers" do - body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8 - resp <- mockResponse body - resp.headers ?= mockHeaders - Spec.it "has the right body" do - body <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8 - resp <- mockResponse body - case resp.body of - Body.BinaryBody bin -> do - str <- EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 bin - str ?= "test" - _ -> Assertions.fail "Binary body expected" - where - mockHeaders = Headers.header "Test" "test" - mockResponse = Response.binaryResponse' 123 mockHeaders - emptyResponseSpec :: TestHelpers.Test emptyResponseSpec = Spec.describe "emptyResponse" do Spec.it "has the right status" do @@ -129,11 +106,16 @@ emptyResponseSpec = Spec.describe "emptyResponse" do Spec.it "has empty headers" do resp <- Response.emptyResponse 123 resp.headers ?= Headers.empty - Spec.it "has an empty body" do + Spec.it "has the right size" do resp <- Response.emptyResponse 123 - case resp.body of - Body.StringBody str -> str ?= "" - _ -> Assertions.fail "String body expected" + resp.size ?= Maybe.Just 0 + Spec.it "has the right writeBody function" do + body <- do + resp <- Response.emptyResponse 123 + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + resp.writeBody httpResponse + pure $ TestHelpers.getResponseBody httpResponse + body ?= "" emptyResponse'Spec :: TestHelpers.Test emptyResponse'Spec = Spec.describe "emptyResponse'" do @@ -143,11 +125,16 @@ emptyResponse'Spec = Spec.describe "emptyResponse'" do Spec.it "has the right headers" do resp <- mockResponse resp.headers ?= mockHeaders - Spec.it "has an empty body" do + Spec.it "has the right size" do resp <- mockResponse - case resp.body of - Body.StringBody str -> str ?= "" - _ -> Assertions.fail "String body expected" + resp.size ?= Maybe.Just 0 + Spec.it "has the right writeBody function" do + body <- do + resp <- mockResponse + httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse + resp.writeBody httpResponse + pure $ TestHelpers.getResponseBody httpResponse + body ?= "" where mockHeaders = Headers.header "Test" "test" mockResponse = Response.emptyResponse' 123 mockHeaders @@ -157,7 +144,5 @@ responseSpec = Spec.describe "Response" do sendSpec responseFunctionSpec response'Spec - binaryResponseSpec - binaryResponse'Spec emptyResponseSpec emptyResponse'Spec diff --git a/test/Test/HTTPure/TestHelpers.purs b/test/Test/HTTPure/TestHelpers.purs index 66035fc..a52bbc3 100644 --- a/test/Test/HTTPure/TestHelpers.purs +++ b/test/Test/HTTPure/TestHelpers.purs @@ -66,7 +66,7 @@ toBuffer response = Aff.makeAff \done -> do Ref.read chunks >>= List.reverse >>> Array.fromFoldable >>> Buffer.concat >>= Either.Right >>> done - pure $ Aff.nonCanceler + pure Aff.nonCanceler -- | Convert a request to an Aff containing the string with the response body. toString :: HTTPClient.Response -> Aff.Aff String @@ -143,8 +143,7 @@ mockRequest method url body = EffectClass.liftEffect <<< mockRequestImpl method url body <<< Object.fromFoldable -- | Mock an HTTP Response object -foreign import mockResponse :: - Effect.Effect HTTP.Response +foreign import mockResponse :: Effect.Effect HTTP.Response -- | Get the current body from an HTTP Response object (note this will only work -- | with an object returned from mockResponse). diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 205a606..71b68b1 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -8,7 +8,6 @@ import Test.Spec.Runner as Runner import Test.HTTPure.BodySpec as BodySpec import Test.HTTPure.HeadersSpec as HeadersSpec -import Test.HTTPure.HTTPureEffectsSpec as HTTPureEffectsSpec import Test.HTTPure.LookupSpec as LookupSpec import Test.HTTPure.MethodSpec as MethodSpec import Test.HTTPure.PathSpec as PathSpec @@ -25,7 +24,6 @@ main :: TestHelpers.TestSuite main = Runner.run [ Reporter.specReporter ] $ Spec.describe "HTTPure" do BodySpec.bodySpec HeadersSpec.headersSpec - HTTPureEffectsSpec.httpureEffectsSpec LookupSpec.lookupSpec MethodSpec.methodSpec PathSpec.pathSpec