From cfd0a4b243429d2a20c8087e7c652a0bae3f7444 Mon Sep 17 00:00:00 2001 From: Connor Prussin Date: Mon, 10 Jul 2017 03:17:13 -0700 Subject: [PATCH] Test all the things! (#20) --- .gitignore | 1 + CONTRIBUTING.md | 9 +-- Makefile | 117 +++++++++++++++++++++++++---- README.md | 37 ++++++++- bower.json | 10 ++- docs/examples/HelloWorld/Main.purs | 35 +++++++++ docs/examples/HelloWorld/README.md | 10 +++ docs/examples/MultiRoute/Main.purs | 41 ++++++++++ docs/examples/MultiRoute/README.md | 11 +++ lib/HTTPure.purs | 10 +-- lib/HTTPure/HTTPureM.purs | 15 +++- lib/HTTPure/Request.purs | 33 ++++---- lib/HTTPure/Response.purs | 47 +++++++----- lib/HTTPure/Route.purs | 101 ++++++++++++++++--------- lib/HTTPure/Server.purs | 85 ++++++++++++--------- package.json | 5 ++ test/HTTPure/HTTPureMSpec.purs | 13 ++-- test/HTTPure/IntegrationSpec.purs | 36 ++++++--- test/HTTPure/RequestSpec.purs | 27 ++++--- test/HTTPure/ResponseSpec.purs | 35 +++++---- test/HTTPure/RouteSpec.purs | 100 ++++++++++++++++++++++-- test/HTTPure/ServerSpec.purs | 69 +++++++++++++---- test/HTTPure/SpecHelpers.purs | 99 ++++++++++++++++++++++++ test/HTTPureSpec.purs | 39 +++++----- 24 files changed, 766 insertions(+), 219 deletions(-) create mode 100644 docs/examples/HelloWorld/Main.purs create mode 100644 docs/examples/HelloWorld/README.md create mode 100644 docs/examples/MultiRoute/Main.purs create mode 100644 docs/examples/MultiRoute/README.md create mode 100644 package.json create mode 100644 test/HTTPure/SpecHelpers.purs diff --git a/.gitignore b/.gitignore index 404b8d6..ab32c23 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ /output +/node_modules /.pulp-cache/ /.psc* /.purs* diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 467dab6..b1679bc 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -23,7 +23,7 @@ steps for creating a successful PR: 2. [Create a fork](https://github.com/cprussin/purescript-httpure) on github. 3. Create a branch in your fork for your contribution. 4. Add your contribution to the source tree. -5. Run the test suite. All tests MUST pass for a PR to be accepted. +5. Run the test suite. All tests MUST pass for a PR to be accepted. 6. Push your code and create a PR on github. Please make sure to reference your issue number in your PR description. @@ -43,10 +43,9 @@ live in the [docs](docs) directory. Please ensure all guides are written in markdown format, and all examples are fully-functional and implemented as self-contained subdirectories under [docs/examples](docs/examples). -We try to ensure most examples have corresponding integration tests, both to add -additional testing and to ensure that examples we promote remain functional. If -you plan to contribute examples, please take a look -at [IntegrationSpec.purs](test/HTTPure/IntegrationSpec.purs). +All examples should have corresponding integration tests, to ensure that +examples we promote remain functional. If you plan to contribute examples, +please take a look at [IntegrationSpec.purs](test/HTTPure/IntegrationSpec.purs). ### Code diff --git a/Makefile b/Makefile index b967967..d3492c2 100644 --- a/Makefile +++ b/Makefile @@ -1,34 +1,123 @@ +# Configuration for Make +MAKEFLAGS += --warn-undefined-variables +.DEFAULT_GOAL := help +.PHONY: clean test repl example help +.SILENT: + +# Executables used in this makefile PULP := pulp BOWER := bower +NODE := node +NPM := npm + +# Package manifest files BOWERJSON := bower.json +PACKAGEJSON := package.json + +# Various input directories SRCPATH := ./lib TESTPATH := ./test OUTPUT := ./output +DOCS := ./docs +EXAMPLESPATH := $(DOCS)/examples +EXAMPLEPATH := $(EXAMPLESPATH)/$(EXAMPLE) + +# Various output directories BUILD := $(OUTPUT)/build COMPONENTS := $(OUTPUT)/components -DOCS := $(OUTPUT)/docs -TESTMAIN := HTTPure.HTTPureSpec +NODE_MODULES := ./node_modules +OUTPUT_DOCS := $(OUTPUT)/docs +OUTPUT_EXAMPLE := $(OUTPUT)/examples/$(EXAMPLE) + +# The entry point for the compiled example, if an EXAMPLE is specified +EXAMPLE_INDEX := $(OUTPUT_EXAMPLE)/index.js + +# Globs that match all source files SOURCES := $(SRCPATH)/**/* TESTSOURCES := $(TESTPATH)/**/* -.PHONY: clean test +EXAMPLESOURCES := $(EXAMPLESPATH)/**/* -test: $(BUILD) $(TESTSOURCES) - $(PULP) test --src-path $(SRCPATH) --build-path $(BUILD) --main $(TESTMAIN) +# This is the module name for the entry point for the test suite +TESTMAIN := HTTPure.HTTPureSpec -$(BUILD): $(COMPONENTS) $(SOURCES) - $(PULP) build --src-path $(SRCPATH) --build-path $(BUILD) - touch $(BUILD) +$(NODE_MODULES): $(PACKAGEJSON) + $(NPM) install +# Install bower components $(COMPONENTS): $(BOWERJSON) $(BOWER) install +# Build the source files +$(BUILD): $(COMPONENTS) $(NODE_MODULES) $(SOURCES) + $(PULP) build \ + --src-path $(SRCPATH) \ + --build-path $(BUILD) + touch $(BUILD) +build: $(BUILD) + +# Create the example output directory for the example in the environment +# variable EXAMPLE +$(OUTPUT_EXAMPLE): + mkdir -p $(OUTPUT_EXAMPLE) + +# Build the example specified by the environment variable EXAMPLE +$(EXAMPLE_INDEX): $(OUTPUT_EXAMPLE) $(BUILD) $(EXAMPLEPATH)/Main.purs + $(PULP) build \ + --src-path $(EXAMPLEPATH) \ + --include $(SRCPATH) \ + --build-path $(BUILD) \ + --main $(EXAMPLE) \ + --to $(EXAMPLE_INDEX) + +# Run the example specified by the environment variable EXAMPLE +ifeq ($(EXAMPLE),) +example: + $(info You must supply a value in the environment variable EXAMPLE) + $(info ) + $(info Available examples:) + ls -1 $(EXAMPLESPATH) | sed 's/^/ - /' +else +example: $(BUILD) $(EXAMPLE_INDEX) + $(NODE) $(EXAMPLE_INDEX) +endif + +# Run the test suite +test: $(BUILD) $(TESTSOURCES) $(EXAMPLESOURCES) + $(PULP) test \ + --src-path $(SRCPATH) \ + --include $(EXAMPLESPATH) \ + --build-path $(BUILD) \ + --main $(TESTMAIN) + +# Launch a repl with all modules loaded +repl: $(COMPONENTS) $(NODE_MODULES) $(SOURCES) $(TESTSOURCES) $(EXAMPLESOURCES) + $(PULP) repl \ + --include $(EXAMPLESPATH) \ + --src-path $(SRCPATH) \ + --test-path $(TESTPATH) + +# Remove all make output from the source tree clean: rm -rf $(OUTPUT) + rm -rf $(NODE_MODULES) -$(DOCS): $(COMPONENTS) $(SOURCES) - $(PULP) docs --src-path $(SRCPATH) - rm -rf $(DOCS) - mv generated-docs $(DOCS) +# Print out a description of all the supported tasks +help: + $(info HTTPure make utility) + $(info ) + $(info Usage: make [ test | docs | example | repl | clean | help ]) + $(info ) + $(info - make test Run the test suite) + $(info - make docs Build the documentation into $(OUTPUT_DOCS)) + $(info - make example Run the example in environment variable EXAMPLE) + $(info - make repl Launch a repl with all project code loaded) + $(info - make clean Remove all build files) + $(info - make help Print this help) -docs: $(DOCS) -build: $(BUILD) +# Build the documentation +$(OUTPUT_DOCS): $(COMPONENTS) $(NODE_MODULES) $(SOURCES) + $(PULP) docs \ + --src-path $(SRCPATH) + rm -rf $(OUTPUT_DOCS) + mv generated-docs $(OUTPUT_DOCS) +docs: $(OUTPUT_DOCS) diff --git a/README.md b/README.md index b48cab8..67b609d 100644 --- a/README.md +++ b/README.md @@ -17,19 +17,48 @@ our [contributing guide](CONTRIBUTING.md). bower install --save purescript-httpure ``` +## Quick Start + +```purescript +module Main where + +import Prelude (map, ($)) + +import Control.Monad.Eff.Console as Console +import HTTPure as HTTPure + +main :: HTTPure.HTTPureM (console :: Console.CONSOLE) +main = do + HTTPure.serve 8080 routes $ Console.log "Server now up on port 8080" + where + routes = map HTTPure.Route + [ { method: HTTPure.Get + , route: "/" + , body: \_ -> "hello world!" + } + ] +``` + ## Documentation Module documentation is published on [Pursuit](http://pursuit.purescript.org/packages/purescript-httpure). -## Quick Start +## Examples -TODO +HTTPure ships with a number of [examples](docs/examples). To run an example, +in the project root, run: + +```bash +make example EXAMPLE= +``` + +Each example's startup banner will include information on routes available on +the example server. ## Testing -We have a Makefile that wraps all commands for development. To run the test -suite, in the project root run: +To run the test suite, in the project root run: ```bash make test diff --git a/bower.json b/bower.json index 10d0b3f..4552378 100644 --- a/bower.json +++ b/bower.json @@ -1,11 +1,11 @@ { "name": "purescript-httpure", - "homepage": "", - "description": "", + "homepage": "https://github.com/cprussin/purescript-httpure", + "description": "A web framework written in PureScript.", "license": "MIT", "repository": { "type": "git", - "url": "" + "url": "https://github.com/cprussin/purescript-httpure" }, "ignore": [ "**/.*", @@ -19,6 +19,8 @@ }, "devDependencies": { "purescript-psci-support": "^3.0.0", - "purescript-spec": "^1.0.0" + "purescript-spec": "^1.0.0", + "purescript-unsafe-coerce": "^3.0.0", + "purescript-node-stream-buffers": "^0.1.0" } } diff --git a/docs/examples/HelloWorld/Main.purs b/docs/examples/HelloWorld/Main.purs new file mode 100644 index 0000000..13a2c0e --- /dev/null +++ b/docs/examples/HelloWorld/Main.purs @@ -0,0 +1,35 @@ +module HelloWorld where + +import Prelude (discard, show, (<>), ($)) + +import Control.Monad.Eff.Console as Console +import HTTPure as HTTPure + +-- | Serve the example server on this port +port :: Int +port = 8080 + +-- | Shortcut for `show port` +portS :: String +portS = show port + +-- | Specify the routes +routes :: forall e. Array (HTTPure.Route e) +routes = + [ HTTPure.Get "/" + { status: \_ -> 200 + , headers: \_ -> [] + , body: \_ -> "hello world!" + } + ] + +-- | Boot up the server +main :: forall e. HTTPure.HTTPureM (console :: Console.CONSOLE | e) +main = HTTPure.serve port routes do + Console.log $ "" + Console.log $ " ┌────────────────────────────────────────────┐" + Console.log $ " │ Server now up on port " <> portS <> " │" + Console.log $ " │ │" + Console.log $ " │ To test, run: │" + Console.log $ " │ > curl localhost:" <> portS <> " # => hello world! │" + Console.log $ " └────────────────────────────────────────────┘" diff --git a/docs/examples/HelloWorld/README.md b/docs/examples/HelloWorld/README.md new file mode 100644 index 0000000..de1c1f7 --- /dev/null +++ b/docs/examples/HelloWorld/README.md @@ -0,0 +1,10 @@ +# Hello World Example + +This is a basic 'hello world' example. It simply returns 'hello world!' when +requesting '/' via an HTTP GET. + +To run the example server, run: + +```bash +make example EXAMPLE=HelloWorld +``` diff --git a/docs/examples/MultiRoute/Main.purs b/docs/examples/MultiRoute/Main.purs new file mode 100644 index 0000000..5053d4b --- /dev/null +++ b/docs/examples/MultiRoute/Main.purs @@ -0,0 +1,41 @@ +module MultiRoute where + +import Prelude (discard, show, (<>), ($)) + +import Control.Monad.Eff.Console as Console +import HTTPure as HTTPure + +-- | Serve the example server on this port +port :: Int +port = 8081 + +-- | Shortcut for `show port` +portS :: String +portS = show port + +-- | Specify the routes +routes :: forall e. Array (HTTPure.Route e) +routes = + [ HTTPure.Get "/hello" + { status: \_ -> 200 + , headers: \_ -> [] + , body: \_ -> "hello" + } + , HTTPure.Get "/goodbye" + { status: \_ -> 200 + , headers: \_ -> [] + , body: \_ -> "goodbye" + } + ] + +-- | Boot up the server +main :: forall e. HTTPure.HTTPureM (console :: Console.CONSOLE | e) +main = HTTPure.serve port routes do + Console.log $ "" + Console.log $ " ┌───────────────────────────────────────────────┐" + Console.log $ " │ Server now up on port " <> portS <> " │" + Console.log $ " │ │" + Console.log $ " │ To test, run: │" + Console.log $ " │ > curl localhost:" <> portS <> "/hello # => hello │" + Console.log $ " │ > curl localhost:" <> portS <> "/goodbye # => goodbye │" + Console.log $ " └───────────────────────────────────────────────┘" diff --git a/docs/examples/MultiRoute/README.md b/docs/examples/MultiRoute/README.md new file mode 100644 index 0000000..fa757af --- /dev/null +++ b/docs/examples/MultiRoute/README.md @@ -0,0 +1,11 @@ +# Multi Route Example + +This is a basic example that shows how to create multiple basic routes. It will +return 'hello' when requesting /hello with an HTTP GET, and it will return +'goodbye' when requesting /goodbye with an HTTP GET. + +To run the example server, run: + +```bash +make example EXAMPLE=MultiRoute +``` diff --git a/lib/HTTPure.purs b/lib/HTTPure.purs index 0f2974f..e53b3f7 100644 --- a/lib/HTTPure.purs +++ b/lib/HTTPure.purs @@ -1,13 +1,11 @@ module HTTPure ( module HTTPure.HTTPureM - , module HTTPure.Server , module HTTPure.Request - , module HTTPure.Response , module HTTPure.Route + , module HTTPure.Server ) where -import HTTPure.HTTPureM (HTTPureM) -import HTTPure.Server (serve) +import HTTPure.HTTPureM (HTTPureEffects, HTTPureM) import HTTPure.Request (Request, getURL) -import HTTPure.Response (Response, write) -import HTTPure.Route (Method(..), Route) +import HTTPure.Route (Route(..)) +import HTTPure.Server (serve) diff --git a/lib/HTTPure/HTTPureM.purs b/lib/HTTPure/HTTPureM.purs index e5997da..ed6e409 100644 --- a/lib/HTTPure/HTTPureM.purs +++ b/lib/HTTPure/HTTPureM.purs @@ -1,13 +1,20 @@ module HTTPure.HTTPureM - ( HTTPureM + ( HTTPureEffects + , HTTPureM ) where -import Control.Monad.Eff (Eff) import Prelude (Unit) -import Node.HTTP (HTTP) + +import Control.Monad.Eff as Eff +import Node.HTTP as HTTP + +-- | The `HTTPureMEffects` type is a row that wraps up all HTTPure effects. +-- | Under the hood this uses Node.HTTP, but it could be replaced by another +-- | adapter. +type HTTPureEffects e = (http :: HTTP.HTTP | e) -- | The `HTTPureM` monad represents actions acting over an HTTPure server -- | lifecycle. It is the return type of all route handlers and of the `serve` -- | function. It takes an effects row parameter which enumerates all other -- | side-effects performed while carrying out the server actions. -type HTTPureM e = Eff (http :: HTTP | e) Unit +type HTTPureM e = Eff.Eff (HTTPureEffects e) Unit diff --git a/lib/HTTPure/Request.purs b/lib/HTTPure/Request.purs index 3bf4a66..fdd03ba 100644 --- a/lib/HTTPure/Request.purs +++ b/lib/HTTPure/Request.purs @@ -4,22 +4,29 @@ module HTTPure.Request , getURL ) where -import Node.HTTP (HTTP, Request, requestAsStream, requestURL) as HTTP -import Node.Stream (Readable) +import Node.HTTP as HTTP +import Node.Stream as Stream --- | TODO write me -type Request e = { - httpRequest :: HTTP.Request, - stream :: Readable () (http :: HTTP.HTTP | e) -} +-- | The Request type takes as it's parameter an effects row. It is a Record +-- | type with two fields: +-- | +-- | - `httpRequest`: The raw underlying HTTP request. +-- | - `stream`: The raw request converted to a Readable stream. +-- | +-- | Neither field is intended to be accessed directly, rather it is recommended +-- | to use the methods exported by this module. +type Request e = + { httpRequest :: HTTP.Request + , stream :: Stream.Readable () (http :: HTTP.HTTP | e) + } --- | TODO write me +-- | Convert a Node.HTTP Request into a HTTPure Request. fromHTTPRequest :: forall e. HTTP.Request -> Request e -fromHTTPRequest request = { - httpRequest: request, - stream: HTTP.requestAsStream request -} +fromHTTPRequest request = + { httpRequest: request + , stream: HTTP.requestAsStream request + } --- | TODO write me +-- | Get the URL used to generate a Request. getURL :: forall e. Request e -> String getURL request = HTTP.requestURL request.httpRequest diff --git a/lib/HTTPure/Response.purs b/lib/HTTPure/Response.purs index c0974d9..d722977 100644 --- a/lib/HTTPure/Response.purs +++ b/lib/HTTPure/Response.purs @@ -4,25 +4,38 @@ module HTTPure.Response , write ) where -import Control.Monad.Eff (Eff) -import Node.Encoding (Encoding(UTF8)) -import Node.HTTP (HTTP, Response, responseAsStream) as HTTP -import Node.Stream (Writable, writeString) -import Prelude (Unit, bind, pure, unit) +import Prelude (Unit, bind, discard, pure, unit) --- | TODO write me --- | TODO wrap me in a Record so that the HTTP response is accessible -type Response e = Writable () (http :: HTTP.HTTP | e) +import Control.Monad.Eff as Eff +import Node.Encoding as Encoding +import Node.HTTP as HTTP +import Node.Stream as Stream --- | TODO write me +-- | The Response type takes as it's parameter an effects row. It is a Record +-- | type with two fields: +-- | +-- | - `httpResponse`: The raw underlying HTTP response. +-- | - `stream`: The raw response converted to a Writable stream. +-- | +-- | Neither field is intended to be accessed directly, rather it is recommended +-- | to use the methods exported by this module. +type Response e = + { httpResponse :: HTTP.Response + , stream :: Stream.Writable () (http :: HTTP.HTTP | e) + } + +-- | Convert a Node.HTTP Response into a HTTPure Response. fromHTTPResponse :: forall e. HTTP.Response -> Response e -fromHTTPResponse = HTTP.responseAsStream +fromHTTPResponse response = + { httpResponse: response + , stream: HTTP.responseAsStream response + } --- | TODO write me ---setStatusCode :: - --- | TODO write me -write :: forall e. Response e -> String -> Eff (http :: HTTP.HTTP | e) Unit +-- | Write a string into the Response output. +write :: forall e. Response e -> String -> Eff.Eff (http :: HTTP.HTTP | e) Unit write response str = do - _ <- writeString response UTF8 str (pure unit) - pure unit + _ <- Stream.writeString response.stream Encoding.UTF8 str noop + Stream.end response.stream noop + noop + where + noop = pure unit diff --git a/lib/HTTPure/Route.purs b/lib/HTTPure/Route.purs index 55e503b..ecdb33e 100644 --- a/lib/HTTPure/Route.purs +++ b/lib/HTTPure/Route.purs @@ -1,46 +1,73 @@ module HTTPure.Route - ( Method(..) - , Route - , RouteHandler + ( Route(..) + , RouteHooks + , run + , match + , isMatch ) where -import HTTPure.Request (Request) -import HTTPure.Response (Response) -import HTTPure.HTTPureM (HTTPureM) +import Prelude (flip, ($), (==), (>>=), (<>)) --- | The available HTTP methods that a Route can service. -data Method = All | Get | Post | Put | Delete +import Data.Array as Array +import Data.Eq as Eq +import Data.Maybe as Maybe +import Data.Show as Show --- | All route handler methods - that is, methods for before hooks, after hooks, --- | or route handlers themselves - have this type signature. -type RouteHandler e = Request e -> Response e -> HTTPureM e +import HTTPure.HTTPureM as HTTPureM +import HTTPure.Request as Request +import HTTPure.Response as Response --- | A Route matches a given HTTP Method against a given URL string. The route --- | string's format is inspired by express. When a request comes in that --- | matches the route, the handler is executed against the request and the --- | response. -type Route e = { - method :: Method, - route :: String, - handler :: RouteHandler e -} +type RouteHooks e = + { status :: Request.Request e -> Int + , body :: Request.Request e -> String + , headers :: Request.Request e -> Array String + } --- The internal representation of a route. The route is converted from a String --- to a RouteMatcher, which can cheaply match routes and extract params. ---type LoadedRoute e = { --- method :: Method, --- route :: RouteMatcher, --- handler :: Request e -> Response e -> HTTPure e ---} +-- | A Route matches a given HTTP Method against a given path matcher string. +-- | When a request comes in that matches the route, the body function is +-- | executed against the request and the result is sent back to the client. +data Route e + = Get String (RouteHooks e) + | Post String (RouteHooks e) + | Put String (RouteHooks e) + | Delete String (RouteHooks e) --- The main request handler. +-- | When calling `show` on a route, display the method and the matching +-- | pattern. +instance show :: Show.Show (Route e) where + show (Get pattern _) = "GET: " <> pattern + show (Post pattern _) = "POST: " <> pattern + show (Put pattern _) = "PUT: " <> pattern + show (Delete pattern _) = "DELETE: " <> pattern --- Convert the passed in routes to their internal representation. ---loadRoutes :: forall e. --- Array (Route e) -> --- Array (LoadedRoute e) ---loadRoutes = map \route -> { --- method: route.method, --- handler: route.handler, --- route: toRouteMatcher(route.route) ---} +-- | Two routes are equal if they are the same method and have the same matching +-- | pattern. +instance eq :: Eq.Eq (Route e) where + eq (Get pattern1 _) (Get pattern2 _) = pattern1 == pattern2 + eq (Post pattern1 _) (Post pattern2 _) = pattern1 == pattern2 + eq (Put pattern1 _) (Put pattern2 _) = pattern1 == pattern2 + eq (Delete pattern1 _) (Delete pattern2 _) = pattern1 == pattern2 + eq _ _ = false + +-- | Given a route and a request, return the response body. +run :: forall e. + Route e -> + Request.Request e -> + Response.Response e -> + HTTPureM.HTTPureM e +run (Get _ { body: body }) req resp = Response.write resp $ body req +run (Post _ { body: body }) req resp = Response.write resp $ body req +run (Put _ { body: body }) req resp = Response.write resp $ body req +run (Delete _ { body: body }) req resp = Response.write resp $ body req + +-- | Returns true if the request matches the route. +isMatch :: forall e. Route e -> Request.Request e -> Boolean +isMatch (Get matcher _) request = matcher == Request.getURL request +isMatch (Post matcher _) request = matcher == Request.getURL request +isMatch (Put matcher _) request = matcher == Request.getURL request +isMatch (Delete matcher _) request = matcher == Request.getURL request + +-- | Returns the matching route for the request. +match :: forall e. Array (Route e) -> Request.Request e -> Maybe.Maybe (Route e) +match routes request = + Array.findIndex (flip isMatch request) routes >>= Array.index routes diff --git a/lib/HTTPure/Server.purs b/lib/HTTPure/Server.purs index 1a92338..aec046b 100644 --- a/lib/HTTPure/Server.purs +++ b/lib/HTTPure/Server.purs @@ -1,40 +1,57 @@ -module HTTPure.Server ( - serve -) where +module HTTPure.Server + ( boot, + handleRequest, + serve + ) where -import Data.Maybe (Maybe(Nothing)) -import Data.Traversable (traverse_) -import Node.HTTP (Request, Response, ListenOptions, createServer, listen) as HTTP -import Node.Stream (end) -import Prelude (bind, discard, pure, unit, ($), (==)) -import Data.Array (filter) +import Prelude (pure, unit, (>>=)) -import HTTPure.Route (Route) -import HTTPure.Response (fromHTTPResponse) -import HTTPure.Request (fromHTTPRequest, getURL) -import HTTPure.HTTPureM (HTTPureM) +import Data.Maybe as Maybe +import Node.HTTP as HTTP --- | TODO write me -handleRequest :: forall e. Array (Route e) -> HTTP.Request -> HTTP.Response -> HTTPureM e -handleRequest routes request response = do - traverse_ (\route -> route.handler req resp) (filter matching routes) - end resp (pure unit) - pure unit +import HTTPure.HTTPureM as HTTPureM +import HTTPure.Request as Request +import HTTPure.Response as Response +import HTTPure.Route as Route + +-- | This function takes an array of Routes, a request, and a response, and +-- | routes the request to the correct Routes. After the Routes have run, this +-- | function closes the request stream. +handleRequest :: forall e. + Array (Route.Route e) -> + HTTP.Request -> + HTTP.Response -> + HTTPureM.HTTPureM e +handleRequest routes request response = + case Route.match routes req of + Maybe.Just route -> Route.run route req resp + Maybe.Nothing -> pure unit where - req = fromHTTPRequest request - resp = fromHTTPResponse response - matching = \route -> route.route == getURL req + req = Request.fromHTTPRequest request + resp = Response.fromHTTPResponse response --- | TODO write me -getOptions :: Int -> HTTP.ListenOptions -getOptions port = { - hostname: "localhost", - port: port, - backlog: Nothing -} +-- | Given an options object, an Array of Routes, and an HTTPureM containing +-- | effects to run on boot, creates and runs a HTTPure server. +boot :: forall e. + HTTP.ListenOptions -> + Array (Route.Route e) -> + HTTPureM.HTTPureM e -> + HTTPureM.HTTPureM e +boot options routes onStarted = + HTTP.createServer (handleRequest routes) >>= \server -> + HTTP.listen server options onStarted --- | TODO write me -serve :: forall e. Array (Route e) -> Int -> HTTPureM e -> HTTPureM e -serve routes port onStarted = do - server <- HTTP.createServer $ handleRequest routes -- $ loadRoutes routes - HTTP.listen server (getOptions port) onStarted +-- | Create and start a server. This is the main entry point for HTTPure. Takes +-- | a port number on which to listen, an Array of Routes to serve, and an +-- | HTTPureM containing effects to run after the server has booted (usually +-- | logging). Returns an HTTPureM containing the server's effects. +serve :: forall e. + Int -> + Array (Route.Route e) -> + HTTPureM.HTTPureM e -> + HTTPureM.HTTPureM e +serve port = boot + { hostname: "localhost" + , port: port + , backlog: Maybe.Nothing + } diff --git a/package.json b/package.json new file mode 100644 index 0000000..4b28278 --- /dev/null +++ b/package.json @@ -0,0 +1,5 @@ +{ + "devDependencies": { + "stream-buffers": "^3.0.1" + } +} diff --git a/test/HTTPure/HTTPureMSpec.purs b/test/HTTPure/HTTPureMSpec.purs index 9e22c3f..c148f27 100644 --- a/test/HTTPure/HTTPureMSpec.purs +++ b/test/HTTPure/HTTPureMSpec.purs @@ -1,8 +1,11 @@ module HTTPure.HTTPureMSpec where -import Prelude (Unit, pure, unit) -import Test.Spec (Spec) -import Test.Spec.Runner (RunnerEffects) +import Prelude (pure, unit, ($)) -httpureMSpec :: Spec (RunnerEffects ()) Unit -httpureMSpec = pure unit +import Test.Spec as Spec + +import HTTPure.SpecHelpers as SpecHelpers + +httpureMSpec :: SpecHelpers.Test +httpureMSpec = Spec.describe "HTTPureM" $ + pure unit diff --git a/test/HTTPure/IntegrationSpec.purs b/test/HTTPure/IntegrationSpec.purs index 530b6f9..0c68ff2 100644 --- a/test/HTTPure/IntegrationSpec.purs +++ b/test/HTTPure/IntegrationSpec.purs @@ -1,13 +1,31 @@ module HTTPure.IntegrationSpec where -import Prelude (Unit, ($)) -import Test.Spec (Spec, describe, pending) -import Test.Spec.Runner (RunnerEffects) +import Prelude (discard, bind) -startsServerSpec :: Spec (RunnerEffects ()) Unit -startsServerSpec = - pending "starts a server" +import Control.Monad.Eff.Class as EffClass +import Test.Spec as Spec +import Test.Spec.Assertions as Assertions -integrationSpec :: Spec (RunnerEffects ()) Unit -integrationSpec = describe "integration" $ - startsServerSpec +import HTTPure.SpecHelpers as SpecHelpers + +import HelloWorld as HelloWorld +import MultiRoute as MultiRoute + +helloWorldSpec :: SpecHelpers.Test +helloWorldSpec = Spec.it "runs the hello world example" do + EffClass.liftEff HelloWorld.main + response <- SpecHelpers.get "http://localhost:8080" + response `Assertions.shouldEqual` "hello world!" + +multiRouteSpec :: SpecHelpers.Test +multiRouteSpec = Spec.it "runs the multi route example" do + EffClass.liftEff MultiRoute.main + hello <- SpecHelpers.get "http://localhost:8081/hello" + hello `Assertions.shouldEqual` "hello" + goodbye <- SpecHelpers.get "http://localhost:8081/goodbye" + goodbye `Assertions.shouldEqual` "goodbye" + +integrationSpec :: SpecHelpers.Test +integrationSpec = Spec.describe "Integration" do + helloWorldSpec + multiRouteSpec diff --git a/test/HTTPure/RequestSpec.purs b/test/HTTPure/RequestSpec.purs index 499afce..7af9600 100644 --- a/test/HTTPure/RequestSpec.purs +++ b/test/HTTPure/RequestSpec.purs @@ -1,18 +1,21 @@ module HTTPure.RequestSpec where -import Prelude (Unit, discard, ($)) -import Test.Spec (Spec, describe, pending) -import Test.Spec.Runner (RunnerEffects) +import Prelude (($)) -fromHTTPRequestSpec :: Spec (RunnerEffects ()) Unit -fromHTTPRequestSpec = describe "fromHTTPRequest" $ - pending "wraps an HTTP request" +import Test.Spec as Spec +import Test.Spec.Assertions as Assertions -getURLSpec :: Spec (RunnerEffects ()) Unit -getURLSpec = describe "getURL" $ - pending "returns the URL of the request" +import HTTPure.SpecHelpers as SpecHelpers -requestSpec :: Spec (RunnerEffects ()) Unit -requestSpec = describe "Request" do - fromHTTPRequestSpec +import HTTPure.Request as Request + +getURLSpec :: SpecHelpers.Test +getURLSpec = Spec.describe "getURL" $ + Spec.it "is the URL of the request" $ + Request.getURL req `Assertions.shouldEqual` "/test" + where + req = SpecHelpers.mockRequest "/test" + +requestSpec :: SpecHelpers.Test +requestSpec = Spec.describe "Request" $ getURLSpec diff --git a/test/HTTPure/ResponseSpec.purs b/test/HTTPure/ResponseSpec.purs index d70d538..5fa8415 100644 --- a/test/HTTPure/ResponseSpec.purs +++ b/test/HTTPure/ResponseSpec.purs @@ -1,23 +1,26 @@ module HTTPure.ResponseSpec where -import Prelude (Unit, discard, ($)) -import Test.Spec (Spec, describe, pending) -import Test.Spec.Runner (RunnerEffects) +import Prelude (bind, discard, ($)) -fromHTTPResponseSpec :: Spec (RunnerEffects ()) Unit -fromHTTPResponseSpec = describe "fromHTTPResponse" $ - pending "wraps an HTTP response" +import Control.Monad.Eff.Class as EffClass +import Node.Encoding as Encoding +import Node.StreamBuffer as StreamBuffer +import Test.Spec as Spec +import Test.Spec.Assertions as Assertions -setStatusCodeSpec :: Spec (RunnerEffects ()) Unit -setStatusCodeSpec = describe "setStatusCode" $ - pending "sets the status code" +import HTTPure.SpecHelpers as SpecHelpers -writeSpec :: Spec (RunnerEffects ()) Unit -writeSpec = describe "write" $ - pending "adds the string to the response output" +import HTTPure.Response as Response -responseSpec :: Spec (RunnerEffects ()) Unit -responseSpec = describe "Response" do - fromHTTPResponseSpec - setStatusCodeSpec +writeSpec :: SpecHelpers.Test +writeSpec = Spec.describe "write" $ + Spec.it "sets the response body" do + body <- EffClass.liftEff do + buf <- StreamBuffer.writable + Response.write (SpecHelpers.mockResponse buf) "test" + StreamBuffer.contents Encoding.UTF8 buf + body `Assertions.shouldEqual` "test" + +responseSpec :: SpecHelpers.Test +responseSpec = Spec.describe "Response" $ writeSpec diff --git a/test/HTTPure/RouteSpec.purs b/test/HTTPure/RouteSpec.purs index b834d1b..3c7638f 100644 --- a/test/HTTPure/RouteSpec.purs +++ b/test/HTTPure/RouteSpec.purs @@ -1,8 +1,98 @@ module HTTPure.RouteSpec where -import Prelude (Unit, pure, unit) -import Test.Spec (Spec) -import Test.Spec.Runner (RunnerEffects) +import Prelude (bind, discard, eq, flip, show, ($)) -routeSpec :: Spec (RunnerEffects ()) Unit -routeSpec = pure unit +import Control.Monad.Eff.Class as EffClass +import Data.Maybe as Maybe +import Node.Encoding as Encoding +import Node.StreamBuffer as StreamBuffer +import Test.Spec as Spec +import Test.Spec.Assertions as Assertions + +import HTTPure.SpecHelpers as SpecHelpers + +import HTTPure.Route as Route + +hooks :: forall e. Route.RouteHooks e +hooks = { body: \_ -> "", headers: \_ -> [], status: \_ -> 200 } + +showSpec :: SpecHelpers.Test +showSpec = Spec.describe "show" do + Spec.describe "with a Get route on /test" $ + Spec.it "is 'GET: /test'" $ + show (Route.Get "/test" hooks) `Assertions.shouldEqual` "GET: /test" + Spec.describe "with a Post route on /test" $ + Spec.it "is 'POST: /test" $ + show (Route.Post "/test" hooks) `Assertions.shouldEqual` "POST: /test" + Spec.describe "with a Put route on /test" $ + Spec.it "is 'PUT /test" $ + show (Route.Put "/test" hooks) `Assertions.shouldEqual` "PUT: /test" + Spec.describe "with a Delete route on /test" $ + Spec.it "is 'DELETE: /test" $ + show (Route.Delete "/test" hooks) `Assertions.shouldEqual` "DELETE: /test" + +eqSpec :: SpecHelpers.Test +eqSpec = Spec.describe "eq" do + Spec.describe "with routes with the same method and same match patterns" $ + Spec.it "is true" $ + route1 `eq` route2 `Assertions.shouldEqual` true + Spec.describe "with routes with different match patterns" $ + Spec.it "is false" $ + route1 `eq` route3 `Assertions.shouldEqual` false + Spec.describe "with routes with different methods" $ + Spec.it "is false" $ + route1 `eq` route4 `Assertions.shouldEqual` false + where + route1 = Route.Get "a" hooks + route2 = Route.Get "a" hooks + route3 = Route.Get "b" hooks + route4 = Route.Put "a" hooks + +runSpec :: SpecHelpers.Test +runSpec = Spec.describe "run" $ + Spec.it "writes the body" do + body <- EffClass.liftEff do + buf <- StreamBuffer.writable + run $ SpecHelpers.mockResponse buf + StreamBuffer.contents Encoding.UTF8 buf + body `Assertions.shouldEqual` "test" + where + run resp = Route.run testRoute (SpecHelpers.mockRequest "/") resp + testRoute = Route.Get "/" + { body: \_ -> "test" + , headers: \_ -> [] + , status: \_ -> 200 + } + +isMatchSpec :: SpecHelpers.Test +isMatchSpec = Spec.describe "isMatch" do + Spec.describe "when the route is a match" $ + Spec.it "is true" $ + isMatch (SpecHelpers.mockRequest "test") `Assertions.shouldEqual` true + Spec.describe "when the route is not a match" $ + Spec.it "is false" $ + isMatch (SpecHelpers.mockRequest "test2") `Assertions.shouldEqual` false + where + isMatch = Route.isMatch route + route = Route.Get "test" hooks + +matchSpec :: SpecHelpers.Test +matchSpec = Spec.describe "match" do + Spec.describe "when a matching route exists" $ + Spec.it "is Just the matching route" $ + match [ route1, route2 ] `Assertions.shouldEqual` Maybe.Just route1 + Spec.describe "when a matching route does not exist" $ + Spec.it "is Nothing" $ + match [ route2 ] `Assertions.shouldEqual` Maybe.Nothing + where + match = (flip Route.match) (SpecHelpers.mockRequest "1") + route1 = Route.Get "1" hooks + route2 = Route.Get "2" hooks + +routeSpec :: SpecHelpers.Test +routeSpec = Spec.describe "Route" do + showSpec + eqSpec + runSpec + isMatchSpec + matchSpec diff --git a/test/HTTPure/ServerSpec.purs b/test/HTTPure/ServerSpec.purs index ec5aaba..15338da 100644 --- a/test/HTTPure/ServerSpec.purs +++ b/test/HTTPure/ServerSpec.purs @@ -1,23 +1,62 @@ module HTTPure.ServerSpec where -import Prelude (Unit, discard, ($)) -import Test.Spec (Spec, describe, pending) -import Test.Spec.Runner (RunnerEffects) +import Prelude (bind, discard, pure, unit, ($)) -handleRequestSpec :: Spec (RunnerEffects ()) Unit -handleRequestSpec = describe "handleRequest" $ - pending "handles the request" +import Control.Monad.Eff.Class as EffClass +import Data.Maybe as Maybe +import Node.Encoding as Encoding +import Node.StreamBuffer as StreamBuffer +import Test.Spec as Spec +import Test.Spec.Assertions as Assertions -getOptionsSpec :: Spec (RunnerEffects ()) Unit -getOptionsSpec = describe "getOptions" $ - pending "returns an options object" +import HTTPure.SpecHelpers as SpecHelpers -serveSpec :: Spec (RunnerEffects ()) Unit -serveSpec = describe "serve" $ - pending "starts the server" +import HTTPure.Server as Server +import HTTPure.Route as Route -serverSpec :: Spec (RunnerEffects ()) Unit -serverSpec = describe "Server" do +routes :: forall e. Array (Route.Route e) +routes = + [ Route.Get "/test1" + { status: \_ -> 200 + , headers: \_ -> [] + , body: \_ -> "test1" + } + , Route.Get "/test2" + { status: \_ -> 200 + , headers: \_ -> [] + , body: \_ -> "test2" + } + ] + +handleRequestSpec :: SpecHelpers.Test +handleRequestSpec = Spec.describe "handleRequest" $ + Spec.it "matches and runs a route" do + body <- EffClass.liftEff do + buf <- StreamBuffer.writable + Server.handleRequest routes mockRequest $ SpecHelpers.mockHTTPResponse buf + StreamBuffer.contents Encoding.UTF8 buf + body `Assertions.shouldEqual` "test1" + where + mockRequest = SpecHelpers.mockHTTPRequest "/test1" + +bootSpec :: SpecHelpers.Test +bootSpec = Spec.describe "boot" $ + Spec.it "boots a server with the given options" do + EffClass.liftEff $ Server.boot options routes $ pure unit + out <- SpecHelpers.get "http://localhost:7900/test1" + out `Assertions.shouldEqual` "test1" + where + options = { port: 7900, hostname: "localhost", backlog: Maybe.Nothing } + +serveSpec :: SpecHelpers.Test +serveSpec = Spec.describe "serve" $ + Spec.it "boots a server on the given port" do + EffClass.liftEff $ Server.serve 7901 routes $ pure unit + out <- SpecHelpers.get "http://localhost:7901/test2" + out `Assertions.shouldEqual` "test2" + +serverSpec :: SpecHelpers.Test +serverSpec = Spec.describe "Server" do handleRequestSpec - getOptionsSpec + bootSpec serveSpec diff --git a/test/HTTPure/SpecHelpers.purs b/test/HTTPure/SpecHelpers.purs new file mode 100644 index 0000000..5dfbb5f --- /dev/null +++ b/test/HTTPure/SpecHelpers.purs @@ -0,0 +1,99 @@ +module HTTPure.SpecHelpers where + +import Prelude (Unit, bind, discard, pure, unit, ($), (<>), (>>=), (<<<)) + +import Control.Monad.Aff as Aff +import Control.Monad.Eff as Eff +import Control.Monad.Eff.Exception as Exception +import Control.Monad.ST as ST +import Node.Encoding as Encoding +import Node.HTTP as HTTP +import Node.HTTP.Client as HTTPClient +import Node.Stream as Stream +import Node.StreamBuffer as StreamBuffer +import Test.Spec as Spec +import Test.Spec.Runner as Runner +import Unsafe.Coerce as Coerce + +import HTTPure.HTTPureM as HTTPureM +import HTTPure.Request as Request +import HTTPure.Response as Response + + +-- | A type alias encapsulating all effect types used in making a mock request. +type MockRequestEffects e s = + ( st :: ST.ST s + , exception :: Exception.EXCEPTION + , http :: HTTP.HTTP | e + ) + +-- | A type alias encapsulating all effect types used in tests. +type TestEffects s = + Runner.RunnerEffects ( + HTTPureM.HTTPureEffects ( + MockRequestEffects + ( sb :: StreamBuffer.STREAM_BUFFER + ) s + ) + ) + +-- | The type for integration tests. +type Test = forall s. Spec.Spec (TestEffects s) Unit + +-- | The type for the entire test suite. +type TestSuite = forall s. Eff.Eff (TestEffects s) Unit + +-- | Given an HTTPClient.Request, close the request stream so the request can be +-- | fired. +endRequest :: forall e. + HTTPClient.Request -> Eff.Eff (http :: HTTP.HTTP | e) Unit +endRequest request = Stream.end (HTTPClient.requestAsStream request) $ pure unit + +-- | Given a URL, a failure handler, and a success handler, create an HTTP +-- | client request. +getResponse :: forall e. + String -> + (Exception.Error -> Eff.Eff (http :: HTTP.HTTP | e) Unit) -> + (HTTPClient.Response -> Eff.Eff (http :: HTTP.HTTP | e) Unit) -> + Eff.Eff (http :: HTTP.HTTP | e) Unit +getResponse url _ success = HTTPClient.requestFromURI url success >>= endRequest + +-- | Given an ST String buffer and a new string, concatenate that new string +-- | onto the ST buffer. +concat :: forall e s. + ST.STRef s String -> String -> Eff.Eff (st :: ST.ST s | e) Unit +concat buf new = ST.modifySTRef buf (\old -> old <> new) >>= (\_ -> pure unit) + +-- | Convert a request to an Aff containing the string with the response body. +toString :: forall e s. + HTTPClient.Response -> Aff.Aff (MockRequestEffects e s) String +toString response = Aff.makeAff \_ success -> do + let stream = HTTPClient.responseAsStream response + buf <- ST.newSTRef "" + Stream.onDataString stream Encoding.UTF8 $ concat buf + Stream.onEnd stream $ ST.readSTRef buf >>= success + +-- | Run an HTTP GET with the given url and return an Aff that contains the +-- | string with the response body. +get :: forall e s. String -> Aff.Aff (MockRequestEffects e s) String +get url = Aff.makeAff (getResponse url) >>= toString + +-- | Mock a Request object +mockRequest :: forall e. String -> Request.Request e +mockRequest = Request.fromHTTPRequest <<< mockHTTPRequest + +-- | Mock a Request object +mockResponse :: forall e1 e2. + Stream.Writable () (sb :: StreamBuffer.STREAM_BUFFER | e1) -> + Response.Response e2 +mockResponse = Response.fromHTTPResponse <<< mockHTTPResponse + +-- | Mock an HTTP Request object +mockHTTPRequest :: String -> HTTP.Request +mockHTTPRequest url = Coerce.unsafeCoerce { url: url } + +-- | Mock an HTTP Request object +mockHTTPResponse :: forall e1. + Stream.Writable () (sb :: StreamBuffer.STREAM_BUFFER | e1) -> + HTTP.Response +mockHTTPResponse = Coerce.unsafeCoerce diff --git a/test/HTTPureSpec.purs b/test/HTTPureSpec.purs index a20f7aa..84ceada 100644 --- a/test/HTTPureSpec.purs +++ b/test/HTTPureSpec.purs @@ -1,23 +1,24 @@ module HTTPure.HTTPureSpec where -import Prelude (Unit, discard, ($)) -import Control.Monad.Eff (Eff) -import Test.Spec (describe) -import Test.Spec.Reporter (specReporter) -import Test.Spec.Runner (RunnerEffects, run) +import Prelude (discard, ($)) -import HTTPure.HTTPureMSpec (httpureMSpec) -import HTTPure.RequestSpec (requestSpec) -import HTTPure.ResponseSpec (responseSpec) -import HTTPure.RouteSpec (routeSpec) -import HTTPure.ServerSpec (serverSpec) -import HTTPure.IntegrationSpec (integrationSpec) +import Test.Spec as Spec +import Test.Spec.Reporter as Reporter +import Test.Spec.Runner as Runner -main :: Eff (RunnerEffects ()) Unit -main = run [ specReporter ] $ describe "HTTPure" do - httpureMSpec - requestSpec - responseSpec - routeSpec - serverSpec - integrationSpec +import HTTPure.HTTPureMSpec as HTTPureMSpec +import HTTPure.RequestSpec as RequestSpec +import HTTPure.ResponseSpec as ResponseSpec +import HTTPure.RouteSpec as RouteSpec +import HTTPure.ServerSpec as ServerSpec +import HTTPure.SpecHelpers as SpecHelpers +import HTTPure.IntegrationSpec as IntegrationSpec + +main :: SpecHelpers.TestSuite +main = Runner.run [ Reporter.specReporter ] $ Spec.describe "HTTPure" do + HTTPureMSpec.httpureMSpec + RequestSpec.requestSpec + ResponseSpec.responseSpec + RouteSpec.routeSpec + ServerSpec.serverSpec + IntegrationSpec.integrationSpec