diff --git a/docs/Examples/Binary/Readme.md b/docs/Examples/Binary/Readme.md deleted file mode 100644 index 01b164b..0000000 --- a/docs/Examples/Binary/Readme.md +++ /dev/null @@ -1,10 +0,0 @@ -# Binary Example - -This is a basic example of sending binary data. It serves an image file as -binary data on any URL. - -To run the server, run: - -```bash -make example EXAMPLE=Binary -``` diff --git a/docs/Examples/BinaryRequest/Main.js b/docs/Examples/BinaryRequest/Main.js new file mode 100644 index 0000000..5311e57 --- /dev/null +++ b/docs/Examples/BinaryRequest/Main.js @@ -0,0 +1,7 @@ +'use strict'; + +const crypto = require('crypto'); + +exports.sha256sum = function(buffer) { + return crypto.createHash('sha256').update(buffer).digest('hex'); +} diff --git a/docs/Examples/BinaryRequest/Main.purs b/docs/Examples/BinaryRequest/Main.purs new file mode 100644 index 0000000..c4c05ff --- /dev/null +++ b/docs/Examples/BinaryRequest/Main.purs @@ -0,0 +1,24 @@ +module Examples.BinaryRequest.Main where + +import Prelude +import Effect.Console as Console +import Node.Buffer (Buffer) +import HTTPure as HTTPure + +foreign import sha256sum :: Buffer -> String + +-- | Respond with file's sha256sum +router :: HTTPure.Request -> HTTPure.ResponseM +router { body } = HTTPure.toBuffer body >>= sha256sum >>> HTTPure.ok + +-- | Boot up the server +main :: HTTPure.ServerM +main = + HTTPure.serve 8080 router do + Console.log $ " ┌─────────────────────────────────────────────────────────┐" + Console.log $ " │ Server now up on port 8080 │" + Console.log $ " │ │" + Console.log $ " │ To test, run: │" + Console.log $ " │ > curl -XPOST --data-binary @circle.png localhost:8080 │" + Console.log $ " │ # => d5e776724dd5... │" + Console.log $ " └─────────────────────────────────────────────────────────┘" diff --git a/docs/Examples/BinaryRequest/Readme.md b/docs/Examples/BinaryRequest/Readme.md new file mode 100644 index 0000000..064d3a8 --- /dev/null +++ b/docs/Examples/BinaryRequest/Readme.md @@ -0,0 +1,10 @@ +# Binary Request Example + +This is a basic example of sending binary request data. It will read in the +binary file and send back the file's sha256 checksum. + +To run the server, run: + +```bash +make example EXAMPLE=BinaryRequest +``` diff --git a/docs/Examples/Binary/Main.purs b/docs/Examples/BinaryResponse/Main.purs similarity index 91% rename from docs/Examples/Binary/Main.purs rename to docs/Examples/BinaryResponse/Main.purs index 321be76..7452312 100644 --- a/docs/Examples/Binary/Main.purs +++ b/docs/Examples/BinaryResponse/Main.purs @@ -1,4 +1,4 @@ -module Examples.Binary.Main where +module Examples.BinaryResponse.Main where import Prelude import Effect.Console as Console @@ -7,7 +7,7 @@ import HTTPure as HTTPure -- | The path to the file containing the response to send filePath :: String -filePath = "./docs/Examples/Binary/circle.png" +filePath = "./docs/Examples/BinaryResponse/circle.png" responseHeaders :: HTTPure.Headers responseHeaders = HTTPure.header "Content-Type" "image/png" diff --git a/docs/Examples/BinaryResponse/Readme.md b/docs/Examples/BinaryResponse/Readme.md new file mode 100644 index 0000000..50cacaa --- /dev/null +++ b/docs/Examples/BinaryResponse/Readme.md @@ -0,0 +1,10 @@ +# Binary Response Example + +This is a basic example of sending binary response data. It serves an image +file as binary data on any URL. + +To run the server, run: + +```bash +make example EXAMPLE=BinaryResponse +``` diff --git a/docs/Examples/Binary/circle.png b/docs/Examples/BinaryResponse/circle.png similarity index 100% rename from docs/Examples/Binary/circle.png rename to docs/Examples/BinaryResponse/circle.png diff --git a/docs/Examples/Post/Main.purs b/docs/Examples/Post/Main.purs index ff668f1..f0b07f2 100644 --- a/docs/Examples/Post/Main.purs +++ b/docs/Examples/Post/Main.purs @@ -6,7 +6,7 @@ import HTTPure as HTTPure -- | Route to the correct handler router :: HTTPure.Request -> HTTPure.ResponseM -router { body, method: HTTPure.Post } = HTTPure.ok body +router { body, method: HTTPure.Post } = HTTPure.toString body >>= HTTPure.ok router _ = HTTPure.notFound -- | Boot up the server diff --git a/src/HTTPure.purs b/src/HTTPure.purs index d3aad16..c63be9e 100644 --- a/src/HTTPure.purs +++ b/src/HTTPure.purs @@ -1,5 +1,6 @@ module HTTPure - ( module HTTPure.Headers + ( module HTTPure.Body + , module HTTPure.Headers , module HTTPure.Lookup , module HTTPure.Method , module HTTPure.Path @@ -10,6 +11,7 @@ module HTTPure , module HTTPure.Status ) where +import HTTPure.Body (toString, toBuffer) import HTTPure.Headers (Headers, empty, header, headers) import HTTPure.Lookup (at, (!@), has, (!?), lookup, (!!)) import HTTPure.Method (Method(..)) diff --git a/src/HTTPure/Body.purs b/src/HTTPure/Body.purs index 0090c04..104cb29 100644 --- a/src/HTTPure/Body.purs +++ b/src/HTTPure/Body.purs @@ -1,13 +1,16 @@ module HTTPure.Body ( class Body , defaultHeaders - , read , write + , read + , toString + , toBuffer ) where import Prelude import Data.Either as Either import Effect as Effect +import Effect.Class (liftEffect) import Effect.Aff as Aff import Effect.Ref as Ref import HTTPure.Headers as Headers @@ -17,6 +20,26 @@ import Node.HTTP as HTTP import Node.Stream as Stream import Type.Equality as TypeEquals +-- | Read the body `Readable` stream out of the incoming request +read :: HTTP.Request -> Stream.Readable () +read = HTTP.requestAsStream + +-- | Slurp the entire `Readable` stream into a `String` +toString :: Stream.Readable () -> Aff.Aff String +toString = toBuffer >=> Buffer.toString Encoding.UTF8 >>> liftEffect + +-- | Slurp the entire `Readable` stream into a `Buffer` +toBuffer :: Stream.Readable () -> Aff.Aff Buffer.Buffer +toBuffer stream = + Aff.makeAff \done -> do + bufs <- Ref.new [] + Stream.onData stream \buf -> + void $ Ref.modify (_ <> [ buf ]) bufs + Stream.onEnd stream do + body <- Ref.read bufs >>= Buffer.concat + done $ Either.Right body + pure Aff.nonCanceler + -- | 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 @@ -77,17 +100,3 @@ instance bodyChunked :: void $ Stream.pipe stream $ HTTP.responseAsStream response Stream.onEnd stream $ done $ Either.Right unit pure Aff.nonCanceler - --- | Extract the contents of the body of the HTTP `Request`. -read :: HTTP.Request -> Aff.Aff String -read request = - Aff.makeAff \done -> do - let - stream = HTTP.requestAsStream request - bufs <- Ref.new [] - Stream.onData stream \buf -> - void $ Ref.modify (_ <> [ buf ]) bufs - Stream.onEnd stream do - body <- Ref.read bufs >>= Buffer.concat >>= Buffer.toString Encoding.UTF8 - done $ Either.Right body - pure Aff.nonCanceler diff --git a/src/HTTPure/Request.purs b/src/HTTPure/Request.purs index 5cd28d4..3ef6695 100644 --- a/src/HTTPure/Request.purs +++ b/src/HTTPure/Request.purs @@ -9,6 +9,7 @@ import Effect.Aff as Aff import Data.String as String import Foreign.Object as Object import Node.HTTP as HTTP +import Node.Stream as Stream import HTTPure.Body as Body import HTTPure.Headers as Headers import HTTPure.Method as Method @@ -24,7 +25,7 @@ type Request = , path :: Path.Path , query :: Query.Query , headers :: Headers.Headers - , body :: String + , body :: Stream.Readable () , httpVersion :: Version.Version , url :: String } @@ -48,14 +49,12 @@ fullPath request = "/" <> path <> questionMark <> queryParams -- | Given an HTTP `Request` object, this method will convert it to an HTTPure -- | `Request` object. fromHTTPRequest :: HTTP.Request -> Aff.Aff Request -fromHTTPRequest request = do - body <- Body.read request - pure $ - { method: Method.read request - , path: Path.read request - , query: Query.read request - , headers: Headers.read request - , body - , httpVersion: Version.read request - , url: HTTP.requestURL request - } +fromHTTPRequest request = pure + { method: Method.read request + , path: Path.read request + , query: Query.read request + , headers: Headers.read request + , body: Body.read request + , httpVersion: Version.read request + , url: HTTP.requestURL request + } diff --git a/test/Test/HTTPure/BodySpec.purs b/test/Test/HTTPure/BodySpec.purs index bef7e15..87c1738 100644 --- a/test/Test/HTTPure/BodySpec.purs +++ b/test/Test/HTTPure/BodySpec.purs @@ -1,22 +1,39 @@ module Test.HTTPure.BodySpec where import Prelude +import Data.Maybe (Maybe(Nothing), fromMaybe) import Effect.Class as EffectClass import Node.Buffer as Buffer import Node.Encoding as Encoding +import Node.Stream as Stream import Test.Spec as Spec import HTTPure.Body as Body import HTTPure.Headers as Headers import Test.HTTPure.TestHelpers as TestHelpers -import Test.HTTPure.TestHelpers ((?=)) +import Test.HTTPure.TestHelpers ((?=), stringToStream) readSpec :: TestHelpers.Test readSpec = Spec.describe "read" do Spec.it "is the body of the Request" do - request <- TestHelpers.mockRequest "" "GET" "" "test" [] - body <- Body.read request - body ?= "test" + body <- Body.read <$> TestHelpers.mockRequest "" "GET" "" "test" [] + string <- EffectClass.liftEffect $ fromMaybe "" <$> Stream.readString body Nothing Encoding.UTF8 + string ?= "test" + +toStringSpec :: TestHelpers.Test +toStringSpec = + Spec.describe "toString" do + Spec.it "slurps Streams into Strings" do + string <- Body.toString $ stringToStream "foobar" + string ?= "foobar" + +toBufferSpec :: TestHelpers.Test +toBufferSpec = + Spec.describe "toBuffer" do + Spec.it "slurps Streams into Buffers" do + buf <- Body.toBuffer $ stringToStream "foobar" + string <- EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 buf + string ?= "foobar" defaultHeadersSpec :: TestHelpers.Test defaultHeadersSpec = @@ -73,4 +90,6 @@ bodySpec = Spec.describe "Body" do defaultHeadersSpec readSpec + toStringSpec + toBufferSpec writeSpec diff --git a/test/Test/HTTPure/IntegrationSpec.purs b/test/Test/HTTPure/IntegrationSpec.purs index 14b648e..6f18d42 100644 --- a/test/Test/HTTPure/IntegrationSpec.purs +++ b/test/Test/HTTPure/IntegrationSpec.purs @@ -9,7 +9,8 @@ import Test.Spec as Spec import Test.HTTPure.TestHelpers as TestHelpers import Test.HTTPure.TestHelpers ((?=)) import Examples.AsyncResponse.Main as AsyncResponse -import Examples.Binary.Main as Binary +import Examples.BinaryRequest.Main as BinaryRequest +import Examples.BinaryResponse.Main as BinaryResponse import Examples.Chunked.Main as Chunked import Examples.CustomStack.Main as CustomStack import Examples.Headers.Main as Headers @@ -29,13 +30,22 @@ asyncResponseSpec = EffectClass.liftEffect $ close $ pure unit response ?= "hello world!" -binarySpec :: TestHelpers.Test -binarySpec = - Spec.it "runs the binary example" do - close <- EffectClass.liftEffect Binary.main +binaryRequestSpec :: TestHelpers.Test +binaryRequestSpec = + Spec.it "runs the binary request example" do + close <- EffectClass.liftEffect BinaryRequest.main + binaryBuf <- FS.readFile BinaryResponse.filePath + response <- TestHelpers.postBinary 8080 Object.empty "/" binaryBuf + EffectClass.liftEffect $ close $ pure unit + response ?= "d5e776724dd545d8b54123b46362a553d10257cee688ef1be62166c984b34405" + +binaryResponseSpec :: TestHelpers.Test +binaryResponseSpec = + Spec.it "runs the binary response example" do + close <- EffectClass.liftEffect BinaryResponse.main responseBuf <- TestHelpers.getBinary 8080 Object.empty "/" EffectClass.liftEffect $ close $ pure unit - binaryBuf <- FS.readFile Binary.filePath + binaryBuf <- FS.readFile BinaryResponse.filePath expected <- EffectClass.liftEffect $ Buffer.toArray binaryBuf response <- EffectClass.liftEffect $ Buffer.toArray responseBuf response ?= expected @@ -144,7 +154,8 @@ integrationSpec :: TestHelpers.Test integrationSpec = Spec.describe "Integration" do asyncResponseSpec - binarySpec + binaryRequestSpec + binaryResponseSpec chunkedSpec customStackSpec headersSpec diff --git a/test/Test/HTTPure/RequestSpec.purs b/test/Test/HTTPure/RequestSpec.purs index 360dc0f..4aa9890 100644 --- a/test/Test/HTTPure/RequestSpec.purs +++ b/test/Test/HTTPure/RequestSpec.purs @@ -4,6 +4,7 @@ import Prelude import Data.Tuple as Tuple import Foreign.Object as Object import Test.Spec as Spec +import HTTPure.Body as Body import HTTPure.Headers as Headers import HTTPure.Method as Method import HTTPure.Request as Request @@ -27,8 +28,8 @@ fromHTTPRequestSpec = mock <- mockRequest mock.headers ?= Headers.headers mockHeaders Spec.it "contains the correct body" do - mock <- mockRequest - mock.body ?= "body" + mockBody <- mockRequest >>= _.body >>> Body.toString + mockBody ?= "body" Spec.it "contains the correct httpVersion" do mock <- mockRequest mock.httpVersion ?= Version.HTTP1_1 diff --git a/test/Test/HTTPure/TestHelpers.purs b/test/Test/HTTPure/TestHelpers.purs index 4050d44..d041e21 100644 --- a/test/Test/HTTPure/TestHelpers.purs +++ b/test/Test/HTTPure/TestHelpers.purs @@ -40,7 +40,7 @@ request :: String -> Object.Object String -> String -> - String -> + Buffer.Buffer -> Aff.Aff HTTPClient.Response request secure port method headers path body = Aff.makeAff \done -> do @@ -48,7 +48,7 @@ request secure port method headers path body = let stream = HTTPClient.requestAsStream req void - $ Stream.writeString stream Encoding.UTF8 body + $ Stream.write stream body $ Stream.end stream $ pure unit pure Aff.nonCanceler @@ -62,6 +62,31 @@ request secure port method headers path body = <> HTTPClient.headers := HTTPClient.RequestHeaders headers <> HTTPClient.rejectUnauthorized := false +-- | Same as `request` but without. +request' :: + Boolean -> + Int -> + String -> + Object.Object String -> + String -> + Aff.Aff HTTPClient.Response +request' secure port method headers path = + EffectClass.liftEffect (Buffer.create 0) + >>= request secure port method headers path + +-- | Same as `request` but with a `String` body. +requestString :: + Boolean -> + Int -> + String -> + Object.Object String -> + String -> + String -> + Aff.Aff HTTPClient.Response +requestString secure port method headers path body = do + EffectClass.liftEffect (Buffer.fromString body Encoding.UTF8) + >>= request secure port method headers path + -- | Convert a request to an Aff containing the `Buffer with the response body. toBuffer :: HTTPClient.Response -> Aff.Aff Buffer.Buffer toBuffer response = @@ -91,7 +116,7 @@ get :: Object.Object String -> String -> Aff.Aff String -get port headers path = request false port "GET" headers path "" >>= toString +get port headers path = request' false port "GET" headers path >>= toString -- | Like `get` but return a response body in a `Buffer` getBinary :: @@ -99,7 +124,7 @@ getBinary :: Object.Object String -> String -> Aff.Aff Buffer.Buffer -getBinary port headers path = request false port "GET" headers path "" >>= toBuffer +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. @@ -108,7 +133,7 @@ get' :: Object.Object String -> String -> Aff.Aff String -get' port headers path = request true port "GET" headers path "" >>= toString +get' port headers path = request' true port "GET" headers path >>= toString -- | Run an HTTP POST with the given url and body and return an Aff that -- | contains the string with the response body. @@ -118,7 +143,17 @@ post :: String -> String -> Aff.Aff String -post port headers path = request false port "POST" headers path >=> toString +post port headers path = requestString false port "POST" headers path >=> toString + +-- | Run an HTTP POST with the given url and binary buffer body and return an +-- | Aff that contains the string with the response body. +postBinary :: + Int -> + Object.Object String -> + String -> + Buffer.Buffer -> + Aff.Aff String +postBinary port headers path = request false port "POST" headers path >=> toString -- | Convert a request to an Aff containing the string with the given header -- | value. @@ -137,14 +172,14 @@ getHeader :: String -> String -> Aff.Aff String -getHeader port headers path header = extractHeader header <$> request false port "GET" headers path "" +getHeader port headers path header = extractHeader header <$> request' false port "GET" headers path getStatus :: Int -> Object.Object String -> String -> Aff.Aff Int -getStatus port headers path = HTTPClient.statusCode <$> request false port "GET" headers path "" +getStatus port headers path = HTTPClient.statusCode <$> request' false port "GET" headers path -- | Mock an HTTP Request object foreign import mockRequestImpl ::