diff --git a/docs/Examples/Image/Main.purs b/docs/Examples/Image/Main.purs new file mode 100644 index 0000000..f48882b --- /dev/null +++ b/docs/Examples/Image/Main.purs @@ -0,0 +1,36 @@ +module Examples.Image.Main where + +import Prelude + +import Effect.Console as Console +import Node.FS.Aff as FS +import HTTPure as HTTPure + +-- | Serve the example server on this port +port :: Int +port = 8090 + +-- | Shortcut for `show port` +portS :: String +portS = show port + +-- | The path to the file containing the response to send +filePath :: String +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 + where + headers = HTTPure.header "Content-Type" "image/png" + +-- | Boot up the server +main :: HTTPure.ServerM +main = HTTPure.serve port image do + Console.log $ " ┌────────────────────────────────────────────┐" + Console.log $ " │ Server now up on port " <> portS <> " │" + Console.log $ " │ │" + Console.log $ " │ To test, run: │" + Console.log $ " │ > curl -o circle.png localhost:" <> portS <> " │" + Console.log $ " └────────────────────────────────────────────┘" diff --git a/docs/Examples/Image/circle.png b/docs/Examples/Image/circle.png new file mode 100644 index 0000000..663faa2 Binary files /dev/null and b/docs/Examples/Image/circle.png differ diff --git a/docs/Examples/Middleware/Main.purs b/docs/Examples/Middleware/Main.purs index e163298..bb7aeaf 100644 --- a/docs/Examples/Middleware/Main.purs +++ b/docs/Examples/Middleware/Main.purs @@ -32,8 +32,8 @@ headerMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) -> HTTPure.Request -> HTTPure.ResponseM headerMiddleware router request = do - response <- router request - HTTPure.response' response.status (header <> response.headers) response.body + response@{ headers } <- router request + pure $ response { headers = header <> headers } where header = HTTPure.header "X-Middleware" "middleware" diff --git a/src/HTTPure.purs b/src/HTTPure.purs index e9699c8..51464da 100644 --- a/src/HTTPure.purs +++ b/src/HTTPure.purs @@ -20,6 +20,7 @@ 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 686752e..ee57547 100644 --- a/src/HTTPure/Body.purs +++ b/src/HTTPure/Body.purs @@ -1,25 +1,30 @@ module HTTPure.Body - ( Body + ( Body(..) , read , write + , size ) where import Prelude import Data.Either as Either +import Data.String as String import Effect as Effect import Effect.Aff as Aff import Effect.Ref as Ref +import Node.Buffer as Buffer 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. -type Body = String +data Body + = StringBody String + | BinaryBody Buffer.Buffer -- | Extract the contents of the body of the HTTP `Request`. -read :: HTTP.Request -> Aff.Aff Body +read :: HTTP.Request -> Aff.Aff String read request = Aff.makeAff \done -> do let stream = HTTP.requestAsStream request buf <- Ref.new "" @@ -31,7 +36,16 @@ read request = Aff.makeAff \done -> do -- | Write a `Body` to the given HTTP `Response` and close it. write :: HTTP.Response -> Body -> Effect.Effect Unit write response body = void do - _ <- Stream.writeString stream Encoding.UTF8 body $ pure unit + _ <- 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) = pure $ String.length body +size (BinaryBody body) = Buffer.size body diff --git a/src/HTTPure/Request.purs b/src/HTTPure/Request.purs index 8e07888..61c19b2 100644 --- a/src/HTTPure/Request.purs +++ b/src/HTTPure/Request.purs @@ -24,7 +24,7 @@ type Request = , path :: Path.Path , query :: Query.Query , headers :: Headers.Headers - , body :: Body.Body + , body :: String } -- | Return the full resolved path, including query parameters. This may not diff --git a/src/HTTPure/Response.purs b/src/HTTPure/Response.purs index 0fbc445..f72ee19 100644 --- a/src/HTTPure/Response.purs +++ b/src/HTTPure/Response.purs @@ -3,6 +3,7 @@ module HTTPure.Response , ResponseM , send , response, response' + , binaryResponse, binaryResponse' , emptyResponse, emptyResponse' -- 1xx @@ -78,9 +79,9 @@ module HTTPure.Response import Prelude -import Data.String as String import Effect as Effect import Effect.Aff as Aff +import Node.Buffer as Buffer import Node.HTTP as HTTP import HTTPure.Body as Body @@ -105,22 +106,36 @@ type Response = send :: HTTP.Response -> Response -> Effect.Effect Unit send httpresponse { status, headers, body } = do Status.write httpresponse $ status - Headers.write httpresponse $ headers <> contentLength + size <- Body.size body + Headers.write httpresponse $ headers <> contentLength size Body.write httpresponse $ body where - contentLength = Headers.header "Content-Length" $ show $ String.length body + contentLength size = Headers.header "Content-Length" $ show size -- | For custom response statuses or providing a body for response codes that -- | don't typically send one. -response :: Status.Status -> Body.Body -> ResponseM +response :: Status.Status -> String -> ResponseM response status = response' status Headers.empty -- | The same as `response` but with headers. response' :: Status.Status -> Headers.Headers -> - Body.Body -> + String -> ResponseM -response' status headers body = pure $ { status, headers, body } +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 } -- | The same as `response` but without a body. emptyResponse :: Status.Status -> ResponseM @@ -163,11 +178,11 @@ processing' = emptyResponse' Status.processing --------- -- | 200 -ok :: Body.Body -> ResponseM +ok :: String -> ResponseM ok = ok' Headers.empty -- | 200 with headers -ok' :: Headers.Headers -> Body.Body -> ResponseM +ok' :: Headers.Headers -> String -> ResponseM ok' = response' Status.ok -- | 201 @@ -187,12 +202,12 @@ accepted' :: Headers.Headers -> ResponseM accepted' = emptyResponse' Status.accepted -- | 203 -nonAuthoritativeInformation :: Body.Body -> ResponseM +nonAuthoritativeInformation :: String -> ResponseM nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty -- | 203 with headers nonAuthoritativeInformation' :: Headers.Headers -> - Body.Body -> + String -> ResponseM nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation @@ -213,19 +228,19 @@ resetContent' :: Headers.Headers -> ResponseM resetContent' = emptyResponse' Status.resetContent -- | 206 -partialContent :: Body.Body -> ResponseM +partialContent :: String -> ResponseM partialContent = partialContent' Headers.empty -- | 206 with headers -partialContent' :: Headers.Headers -> Body.Body -> ResponseM +partialContent' :: Headers.Headers -> String -> ResponseM partialContent' = response' Status.partialContent -- | 207 -multiStatus :: Body.Body -> ResponseM +multiStatus :: String -> ResponseM multiStatus = multiStatus' Headers.empty -- | 207 with headers -multiStatus' :: Headers.Headers -> Body.Body -> ResponseM +multiStatus' :: Headers.Headers -> String -> ResponseM multiStatus' = response' Status.multiStatus -- | 208 @@ -237,11 +252,11 @@ alreadyReported' :: Headers.Headers -> ResponseM alreadyReported' = emptyResponse' Status.alreadyReported -- | 226 -iMUsed :: Body.Body -> ResponseM +iMUsed :: String -> ResponseM iMUsed = iMUsed' Headers.empty -- | 226 with headers -iMUsed' :: Headers.Headers -> Body.Body -> ResponseM +iMUsed' :: Headers.Headers -> String -> ResponseM iMUsed' = response' Status.iMUsed --------- @@ -249,35 +264,35 @@ iMUsed' = response' Status.iMUsed --------- -- | 300 -multipleChoices :: Body.Body -> ResponseM +multipleChoices :: String -> ResponseM multipleChoices = multipleChoices' Headers.empty -- | 300 with headers -multipleChoices' :: Headers.Headers -> Body.Body -> ResponseM +multipleChoices' :: Headers.Headers -> String -> ResponseM multipleChoices' = response' Status.multipleChoices -- | 301 -movedPermanently :: Body.Body -> ResponseM +movedPermanently :: String -> ResponseM movedPermanently = movedPermanently' Headers.empty -- | 301 with headers -movedPermanently' :: Headers.Headers -> Body.Body -> ResponseM +movedPermanently' :: Headers.Headers -> String -> ResponseM movedPermanently' = response' Status.movedPermanently -- | 302 -found :: Body.Body -> ResponseM +found :: String -> ResponseM found = found' Headers.empty -- | 302 with headers -found' :: Headers.Headers -> Body.Body -> ResponseM +found' :: Headers.Headers -> String -> ResponseM found' = response' Status.found -- | 303 -seeOther :: Body.Body -> ResponseM +seeOther :: String -> ResponseM seeOther = seeOther' Headers.empty -- | 303 with headers -seeOther' :: Headers.Headers -> Body.Body -> ResponseM +seeOther' :: Headers.Headers -> String -> ResponseM seeOther' = response' Status.seeOther -- | 304 @@ -289,27 +304,27 @@ notModified' :: Headers.Headers -> ResponseM notModified' = emptyResponse' Status.notModified -- | 305 -useProxy :: Body.Body -> ResponseM +useProxy :: String -> ResponseM useProxy = useProxy' Headers.empty -- | 305 with headers -useProxy' :: Headers.Headers -> Body.Body -> ResponseM +useProxy' :: Headers.Headers -> String -> ResponseM useProxy' = response' Status.useProxy -- | 307 -temporaryRedirect :: Body.Body -> ResponseM +temporaryRedirect :: String -> ResponseM temporaryRedirect = temporaryRedirect' Headers.empty -- | 307 with headers -temporaryRedirect' :: Headers.Headers -> Body.Body -> ResponseM +temporaryRedirect' :: Headers.Headers -> String -> ResponseM temporaryRedirect' = response' Status.temporaryRedirect -- | 308 -permanentRedirect :: Body.Body -> ResponseM +permanentRedirect :: String -> ResponseM permanentRedirect = permanentRedirect' Headers.empty -- | 308 with headers -permanentRedirect' :: Headers.Headers -> Body.Body -> ResponseM +permanentRedirect' :: Headers.Headers -> String -> ResponseM permanentRedirect' = response' Status.permanentRedirect @@ -318,11 +333,11 @@ permanentRedirect' = response' Status.permanentRedirect --------- -- | 400 -badRequest :: Body.Body -> ResponseM +badRequest :: String -> ResponseM badRequest = badRequest' Headers.empty -- | 400 with headers -badRequest' :: Headers.Headers -> Body.Body -> ResponseM +badRequest' :: Headers.Headers -> String -> ResponseM badRequest' = response' Status.badRequest -- | 401 @@ -390,11 +405,11 @@ requestTimeout' :: Headers.Headers -> ResponseM requestTimeout' = emptyResponse' Status.requestTimeout -- | 409 -conflict :: Body.Body -> ResponseM +conflict :: String -> ResponseM conflict = conflict' Headers.empty -- | 409 with headers -conflict' :: Headers.Headers -> Body.Body -> ResponseM +conflict' :: Headers.Headers -> String -> ResponseM conflict' = response' Status.conflict -- | 410 @@ -546,11 +561,11 @@ unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons --------- -- | 500 -internalServerError :: Body.Body -> ResponseM +internalServerError :: String -> ResponseM internalServerError = internalServerError' Headers.empty -- | 500 with headers -internalServerError' :: Headers.Headers -> Body.Body -> ResponseM +internalServerError' :: Headers.Headers -> String -> ResponseM internalServerError' = response' Status.internalServerError -- | 501 diff --git a/test/Test/HTTPure/BodySpec.purs b/test/Test/HTTPure/BodySpec.purs index 3d8d633..c3c36cc 100644 --- a/test/Test/HTTPure/BodySpec.purs +++ b/test/Test/HTTPure/BodySpec.purs @@ -22,7 +22,7 @@ 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 "test" + Body.write resp $ Body.StringBody "test" pure $ TestHelpers.getResponseBody resp body ?= "test" diff --git a/test/Test/HTTPure/IntegrationSpec.purs b/test/Test/HTTPure/IntegrationSpec.purs index 8d9c152..3643f4c 100644 --- a/test/Test/HTTPure/IntegrationSpec.purs +++ b/test/Test/HTTPure/IntegrationSpec.purs @@ -4,6 +4,8 @@ import Prelude import Effect.Class as EffectClass import Foreign.Object as Object +import Node.Buffer as Buffer +import Node.FS.Aff as FS import Test.Spec as Spec import Test.HTTPure.TestHelpers as TestHelpers @@ -12,6 +14,7 @@ import Test.HTTPure.TestHelpers ((?=)) import Examples.AsyncResponse.Main as AsyncResponse import Examples.Headers.Main as Headers import Examples.HelloWorld.Main as HelloWorld +import Examples.Image.Main as Image import Examples.Middleware.Main as Middleware import Examples.MultiRoute.Main as MultiRoute import Examples.PathSegments.Main as PathSegments @@ -42,6 +45,16 @@ helloWorldSpec = Spec.it "runs the hello world example" do response ?= "hello world!" where port = HelloWorld.port +imageSpec :: TestHelpers.Test +imageSpec = Spec.it "runs the image example" do + imageBuf <- FS.readFile Image.filePath + expected <- EffectClass.liftEffect $ Buffer.toArray imageBuf + EffectClass.liftEffect Image.main + responseBuf <- TestHelpers.getBinary port Object.empty "/" + response <- EffectClass.liftEffect $ Buffer.toArray responseBuf + response ?= expected + where port = Image.port + middlewareSpec :: TestHelpers.Test middlewareSpec = Spec.it "runs the middleware example" do EffectClass.liftEffect Middleware.main @@ -105,6 +118,7 @@ integrationSpec = Spec.describe "Integration" do asyncResponseSpec headersSpec helloWorldSpec + imageSpec middlewareSpec multiRouteSpec pathSegmentsSpec diff --git a/test/Test/HTTPure/ResponseSpec.purs b/test/Test/HTTPure/ResponseSpec.purs index a96fc6c..2ff5e6f 100644 --- a/test/Test/HTTPure/ResponseSpec.purs +++ b/test/Test/HTTPure/ResponseSpec.purs @@ -3,8 +3,12 @@ module Test.HTTPure.ResponseSpec where import Prelude import Effect.Class as EffectClass +import Node.Buffer as Buffer +import Node.Encoding as Encoding 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 @@ -39,7 +43,11 @@ sendSpec = Spec.describe "send" do body ?= "test" where mockHeaders = Headers.header "Test" "test" - mockResponse = { status: 123, headers: mockHeaders, body: "test" } + mockResponse = + { status: 123 + , headers: mockHeaders + , body: Body.StringBody "test" + } responseFunctionSpec :: TestHelpers.Test responseFunctionSpec = Spec.describe "response" do @@ -51,7 +59,9 @@ responseFunctionSpec = Spec.describe "response" do resp.headers ?= Headers.empty Spec.it "has the right body" do resp <- Response.response 123 "test" - resp.body ?= "test" + case resp.body of + Body.StringBody str -> str ?= "test" + _ -> Assertions.fail "String body expected" response'Spec :: TestHelpers.Test response'Spec = Spec.describe "response'" do @@ -63,11 +73,54 @@ response'Spec = Spec.describe "response'" do resp.headers ?= mockHeaders Spec.it "has the right body" do resp <- mockResponse - resp.body ?= "test" + case resp.body of + Body.StringBody str -> str ?= "test" + _ -> Assertions.fail "String body expected" 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 @@ -78,7 +131,9 @@ emptyResponseSpec = Spec.describe "emptyResponse" do resp.headers ?= Headers.empty Spec.it "has an empty body" do resp <- Response.emptyResponse 123 - resp.body ?= "" + case resp.body of + Body.StringBody str -> str ?= "" + _ -> Assertions.fail "String body expected" emptyResponse'Spec :: TestHelpers.Test emptyResponse'Spec = Spec.describe "emptyResponse'" do @@ -90,7 +145,9 @@ emptyResponse'Spec = Spec.describe "emptyResponse'" do resp.headers ?= mockHeaders Spec.it "has an empty body" do resp <- mockResponse - resp.body ?= "" + case resp.body of + Body.StringBody str -> str ?= "" + _ -> Assertions.fail "String body expected" where mockHeaders = Headers.header "Test" "test" mockResponse = Response.emptyResponse' 123 mockHeaders @@ -100,5 +157,7 @@ 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 ba83911..66035fc 100644 --- a/test/Test/HTTPure/TestHelpers.purs +++ b/test/Test/HTTPure/TestHelpers.purs @@ -6,12 +6,15 @@ import Effect as Effect import Effect.Aff as Aff import Effect.Class as EffectClass import Effect.Ref as Ref +import Data.Array as Array import Data.Either as Either +import Data.List as List import Data.Maybe as Maybe import Data.Options ((:=)) import Data.String as StringUtil import Data.Tuple as Tuple import Foreign.Object as Object +import Node.Buffer as Buffer import Node.Encoding as Encoding import Node.HTTP as HTTP import Node.HTTP.Client as HTTPClient @@ -53,19 +56,23 @@ request secure port method headers path body = Aff.makeAff \done -> do HTTPClient.headers := HTTPClient.RequestHeaders headers <> HTTPClient.rejectUnauthorized := false --- | Given an ST String buffer and a new string, concatenate that new string --- | onto the ST buffer. -concat :: Ref.Ref String -> String -> Effect.Effect Unit -concat buf new = void $ Ref.modify ((<>) new) buf +-- | Convert a request to an Aff containing the `Buffer with the response body. +toBuffer :: HTTPClient.Response -> Aff.Aff Buffer.Buffer +toBuffer response = Aff.makeAff \done -> do + let stream = HTTPClient.responseAsStream response + chunks <- Ref.new List.Nil + Stream.onData stream $ \new -> Ref.modify_ (List.Cons new) chunks + Stream.onEnd stream $ + Ref.read chunks + >>= List.reverse >>> Array.fromFoldable >>> Buffer.concat + >>= Either.Right >>> done + pure $ Aff.nonCanceler -- | Convert a request to an Aff containing the string with the response body. toString :: HTTPClient.Response -> Aff.Aff String -toString response = Aff.makeAff \done -> do - let stream = HTTPClient.responseAsStream response - buf <- Ref.new "" - Stream.onDataString stream Encoding.UTF8 $ concat buf - Stream.onEnd stream $ Ref.read buf >>= Either.Right >>> done - pure $ Aff.nonCanceler +toString resp = do + buf <- toBuffer resp + EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 buf -- | Run an HTTP GET with the given url and return an Aff that contains the -- | string with the response body. @@ -75,6 +82,14 @@ get :: Int -> Aff.Aff String get port headers path = request false port "GET" headers path "" >>= toString +-- | Like `get` but return a response body in a `Buffer` +getBinary :: Int -> + Object.Object String -> + String -> + Aff.Aff Buffer.Buffer +getBinary port headers path = + request false port "GET" headers path "" >>= toBuffer + -- | Run an HTTPS GET with the given url and return an Aff that contains the -- | string with the response body. get' :: Int ->