thunderstrike/purescript-httpurple
thunderstrike/purescript-httpurple
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add code formatting with purty (#171)

Browse Source 
* Add code formatting with purty

* Purtify code
This commit is contained in:
Connor Prussin 2021-03-22 12:02:36 -07:00 committed by GitHub
parent 1ce9147917
commit 1ad5a08306
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
45 changed files with 1515 additions and 1296 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/workflows/test.yaml vendored
View File

@ -21,4 +21,4 @@ jobs:
run: nix-shell --run 'make build'
- name: Test
run: nix-shell --run 'make test'
run: nix-shell --run 'make test-code'

24
.github/workflows/validate-formatting.yaml vendored Normal file
View File

@ -0,0 +1,24 @@
name: Validate Formatting
on:
pull_request:
push:
jobs:
test:
runs-on: ubuntu-latest
steps:
- name: Check out codebase
uses: actions/checkout@v2
- name: Install nix
uses: cachix/install-nix-action@v12
with:
nix_path: nixpkgs=channel:nixos-20.09
- name: Build
run: nix-shell --run 'make build'
- name: Test
run: nix-shell --run 'make test-format'

35
Makefile
View File

@ -1,7 +1,7 @@
# Configuration for Make
MAKEFLAGS += --warn-undefined-variables
.DEFAULT_GOAL := help
.PHONY: clean test repl example help
.PHONY: clean example format help repl test test-code test-format
.SILENT:
# Executables used in this makefile
@ -9,6 +9,7 @@ PULP := pulp
NODE := node
YARN := yarn
BOWER := bower
PURTY := purty
# Options to pass to pulp when building
BUILD_OPTIONS := -- --stash --censor-lib --strict
@ -87,8 +88,18 @@ example: $(BUILD) $(EXAMPLE_INDEX)
$(NODE) $(EXAMPLE_INDEX)
endif
format: $(MODULES) $(SOURCES) $(TESTSOURCES) $(EXAMPLESOURCES)
$(PURTY) format --write $(SRCPATH)
$(PURTY) format --write $(TESTPATH)
$(PURTY) format --write $(EXAMPLESPATH)
test-format: $(MODULES) $(SOURCES) $(TESTSOURCES) $(EXAMPLESOURCES)
$(PURTY) validate $(SRCPATH) &&\
$(PURTY) validate $(TESTPATH) &&\
$(PURTY) validate $(EXAMPLESPATH)
# Run the test suite
test: $(BUILD) $(TESTSOURCES) $(EXAMPLESOURCES) $(MODULES)
test-code: $(BUILD) $(TESTSOURCES) $(EXAMPLESOURCES) $(MODULES)
$(PULP) test \
--src-path $(SRCPATH) \
--test-path $(TESTPATH) \
@ -96,6 +107,8 @@ test: $(BUILD) $(TESTSOURCES) $(EXAMPLESOURCES) $(MODULES)
--build-path $(BUILD) \
$(BUILD_OPTIONS)
test: test-code test-format
# Launch a repl with all modules loaded
repl: $(BOWER_COMPONENTS) $(SOURCES) $(TESTSOURCES) $(EXAMPLESOURCES) $(MODULES)
$(PULP) repl \
@ -111,14 +124,18 @@ clean:
help:
$(info HTTPure make utility)
$(info )
$(info Usage: make [ test | docs | example | repl | clean | help ])
$(info Usage: make [ build | clean | docs | example | format | help | repl | test ])
$(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)
$(info - make build Build the documentation into $(OUTPUT_DOCS))
$(info - make clean Remove all build files)
$(info - make docs Build the documentation into $(OUTPUT_DOCS))
$(info - make example Run the example in environment variable EXAMPLE)
$(info - make format Run code formatting)
$(info - make help Print this help)
$(info - make repl Launch a repl with all project code loaded)
$(info - make test Run all checks)
$(info - make test-format Validate the code formatting)
$(info - make test-code Run the code test suite)
# Build the documentation
$(OUTPUT_DOCS): $(BOWER_COMPONENTS) $(SOURCES) $(MODULES)

16
docs/Examples/AsyncResponse/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.AsyncResponse.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
import Node.Encoding as Encoding
@ -17,10 +16,11 @@ sayHello = const $ FSAff.readTextFile Encoding.UTF8 filePath >>= HTTPure.ok
-- | Boot up the server
main :: HTTPure.ServerM
main = HTTPure.serve 8080 sayHello do
Console.log $ " ┌────────────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl localhost:8080 # => hello world! │"
Console.log $ " └────────────────────────────────────────────┘"
main =
HTTPure.serve 8080 sayHello do
Console.log $ " ┌────────────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl localhost:8080 # => hello world! │"
Console.log $ " └────────────────────────────────────────────┘"

16
docs/Examples/Binary/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.Binary.Main where
import Prelude
import Effect.Console as Console
import Node.FS.Aff as FS
import HTTPure as HTTPure
@ -19,10 +18,11 @@ image = const $ FS.readFile filePath >>= HTTPure.ok' responseHeaders
-- | Boot up the server
main :: HTTPure.ServerM
main = HTTPure.serve 8080 image do
Console.log $ " ┌──────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -o circle.png localhost:8080 │"
Console.log $ " └──────────────────────────────────────┘"
main =
HTTPure.serve 8080 image do
Console.log $ " ┌──────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -o circle.png localhost:8080 │"
Console.log $ " └──────────────────────────────────────┘"

36
docs/Examples/Chunked/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.Chunked.Main where
import Prelude
import Effect.Aff as Aff
import Effect.Class as EffectClass
import Effect.Console as Console
@ -11,26 +10,27 @@ import Node.Stream as Stream
-- | Run a script and return it's stdout stream
runScript :: String -> Aff.Aff (Stream.Readable ())
runScript script = EffectClass.liftEffect $ ChildProcess.stdout <$>
ChildProcess.spawn "sh" [ "-c", script ] ChildProcess.defaultSpawnOptions
runScript script =
EffectClass.liftEffect $ ChildProcess.stdout
<$> ChildProcess.spawn "sh" [ "-c", script ] ChildProcess.defaultSpawnOptions
-- | Say 'hello world!' in chunks when run
sayHello :: HTTPure.Request -> HTTPure.ResponseM
sayHello =
const $ runScript "echo 'hello '; sleep 1; echo 'world!'" >>= HTTPure.ok
sayHello = const $ runScript "echo 'hello '; sleep 1; echo 'world!'" >>= HTTPure.ok
-- | Boot up the server
main :: HTTPure.ServerM
main = HTTPure.serve 8080 sayHello do
Console.log $ " ┌──────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -Nv localhost:8080 │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => < Transfer-Encoding: chunked │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => hello │"
Console.log $ " │ (1 second pause) │"
Console.log $ " │ # => world! │"
Console.log $ " └──────────────────────────────────────┘"
main =
HTTPure.serve 8080 sayHello do
Console.log $ " ┌──────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -Nv localhost:8080 │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => < Transfer-Encoding: chunked │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => hello │"
Console.log $ " │ (1 second pause) │"
Console.log $ " │ # => world! │"
Console.log $ " └──────────────────────────────────────┘"

32
docs/Examples/CustomStack/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.CustomStack.Main where
import Prelude
import Control.Monad.Reader (class MonadAsk, ReaderT, asks, runReaderT)
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff)
@ -9,14 +8,15 @@ import Effect.Console as Console
import HTTPure as HTTPure
-- | A type to hold the environment for our ReaderT
type Env =
{ name :: String
}
type Env
= { name :: String
}
-- | A middleware that introduces a ReaderT
readerMiddleware :: (HTTPure.Request -> ReaderT Env Aff HTTPure.Response) ->
HTTPure.Request ->
HTTPure.ResponseM
readerMiddleware ::
(HTTPure.Request -> ReaderT Env Aff HTTPure.Response) ->
HTTPure.Request ->
HTTPure.ResponseM
readerMiddleware router request = do
runReaderT (router request) { name: "joe" }
@ -24,16 +24,16 @@ readerMiddleware router request = do
sayHello :: forall m. MonadAff m => MonadAsk Env m => HTTPure.Request -> m HTTPure.Response
sayHello _ = do
name <- asks _.name
HTTPure.ok $ "hello, " <> name
-- | Boot up the server
main :: HTTPure.ServerM
main = HTTPure.serve 8080 (readerMiddleware sayHello) do
Console.log $ " ┌───────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -v localhost:8080 │"
Console.log $ " │ # => hello, joe │"
Console.log $ " └───────────────────────────────────────┘"
main =
HTTPure.serve 8080 (readerMiddleware sayHello) do
Console.log $ " ┌───────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -v localhost:8080 │"
Console.log $ " │ # => hello, joe │"
Console.log $ " └───────────────────────────────────────┘"

24
docs/Examples/Headers/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.Headers.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
import HTTPure ((!@))
@ -16,14 +15,15 @@ router { headers } = HTTPure.ok' responseHeaders $ headers !@ "X-Input"
-- | 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 -H 'X-Input: test' -v localhost:8080 │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => ...< X-Example: hello world! │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => test │"
Console.log $ " └──────────────────────────────────────────────┘"
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 -H 'X-Input: test' -v localhost:8080 │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => ...< X-Example: hello world! │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => test │"
Console.log $ " └──────────────────────────────────────────────┘"

16
docs/Examples/HelloWorld/Main.purs
View File

@ -1,16 +1,16 @@
module Examples.HelloWorld.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
-- | Boot up the server
main :: HTTPure.ServerM
main = HTTPure.serve 8080 (const $ HTTPure.ok "hello world!") do
Console.log $ " ┌────────────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl localhost:8080 # => hello world! │"
Console.log $ " └────────────────────────────────────────────┘"
main =
HTTPure.serve 8080 (const $ HTTPure.ok "hello world!") do
Console.log $ " ┌────────────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl localhost:8080 # => hello world! │"
Console.log $ " └────────────────────────────────────────────┘"

62
docs/Examples/Middleware/Main.purs
View File

@ -1,40 +1,43 @@
module Examples.Middleware.Main where
import Prelude
import Effect.Class as EffectClass
import Effect.Console as Console
import HTTPure as HTTPure
-- | A middleware that logs at the beginning and end of each request
loggingMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) ->
HTTPure.Request ->
HTTPure.ResponseM
loggingMiddleware ::
(HTTPure.Request -> HTTPure.ResponseM) ->
HTTPure.Request ->
HTTPure.ResponseM
loggingMiddleware router request = do
EffectClass.liftEffect $ Console.log $ "Request starting for " <> path
response <- router request
EffectClass.liftEffect $ Console.log $ "Request ending for " <> path
pure response
where
path = HTTPure.fullPath request
path = HTTPure.fullPath request
-- | A middleware that adds the X-Middleware header to the response, if it
-- | wasn't already in the response
headerMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) ->
HTTPure.Request ->
HTTPure.ResponseM
headerMiddleware ::
(HTTPure.Request -> HTTPure.ResponseM) ->
HTTPure.Request ->
HTTPure.ResponseM
headerMiddleware router request = do
response@{ headers } <- router request
pure $ response { headers = header <> headers }
where
header = HTTPure.header "X-Middleware" "middleware"
header = HTTPure.header "X-Middleware" "middleware"
-- | A middleware that sends the body "Middleware!" instead of running the
-- | router when requesting /middleware
pathMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) ->
HTTPure.Request ->
HTTPure.ResponseM
pathMiddleware ::
(HTTPure.Request -> HTTPure.ResponseM) ->
HTTPure.Request ->
HTTPure.ResponseM
pathMiddleware _ { path: [ "middleware" ] } = HTTPure.ok "Middleware!"
pathMiddleware router request = router request
-- | Say 'hello' when run, and add a default value to the X-Middleware header
@ -43,21 +46,22 @@ sayHello _ = HTTPure.ok' (HTTPure.header "X-Middleware" "router") "hello"
-- | Boot up the server
main :: HTTPure.ServerM
main = HTTPure.serve 8080 (middlewares sayHello) do
Console.log $ " ┌───────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -v localhost:8080 │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => ...< X-Middleware: router │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => hello │"
Console.log $ " │ > curl -v localhost:8080/middleware │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => ...< X-Middleware: middleware │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => Middleware! │"
Console.log $ " └───────────────────────────────────────┘"
main =
HTTPure.serve 8080 (middlewares sayHello) do
Console.log $ " ┌───────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl -v localhost:8080 │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => ...< X-Middleware: router │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => hello │"
Console.log $ " │ > curl -v localhost:8080/middleware │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => ...< X-Middleware: middleware │"
Console.log $ " │ # => ... │"
Console.log $ " │ # => Middleware! │"
Console.log $ " └───────────────────────────────────────┘"
where
middlewares = loggingMiddleware <<< headerMiddleware <<< pathMiddleware
middlewares = loggingMiddleware <<< headerMiddleware <<< pathMiddleware

28
docs/Examples/MultiRoute/Main.purs
View File

@ -1,25 +1,27 @@
module Examples.MultiRoute.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
-- | Specify the routes
router :: HTTPure.Request -> HTTPure.ResponseM
router { path: [ "hello" ] } = HTTPure.ok "hello"
router { path: [ "hello" ] } = HTTPure.ok "hello"
router { path: [ "goodbye" ] } = HTTPure.ok "goodbye"
router _ = HTTPure.notFound
router _ = HTTPure.notFound
-- | 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 localhost:8080/hello │"
Console.log $ " │ # => hello │"
Console.log $ " │ > curl localhost:8080/goodbye │"
Console.log $ " │ # => goodbye │"
Console.log $ " └────────────────────────────────┘"
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 localhost:8080/hello │"
Console.log $ " │ # => hello │"
Console.log $ " │ > curl localhost:8080/goodbye │"
Console.log $ " │ # => goodbye │"
Console.log $ " └────────────────────────────────┘"

24
docs/Examples/PathSegments/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.PathSegments.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
import HTTPure ((!@))
@ -10,17 +9,18 @@ import HTTPure ((!@))
router :: HTTPure.Request -> HTTPure.ResponseM
router { path }
| path !@ 0 == "segment" = HTTPure.ok $ path !@ 1
| otherwise = HTTPure.ok $ show path
| otherwise = HTTPure.ok $ show path
-- | 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 localhost:8080/segment/<anything> │"
Console.log $ " │ # => <anything> │"
Console.log $ " │ > curl localhost:8080/<anything>/<else>/... │"
Console.log $ " │ # => [ <anything>, <else>, ... ] │"
Console.log $ " └───────────────────────────────────────────────┘"
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 localhost:8080/segment/<anything> │"
Console.log $ " │ # => <anything> │"
Console.log $ " │ > curl localhost:8080/<anything>/<else>/... │"
Console.log $ " │ # => [ <anything>, <else>, ... ] │"
Console.log $ " └───────────────────────────────────────────────┘"

21
docs/Examples/Post/Main.purs
View File

@ -1,22 +1,23 @@
module Examples.Post.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
-- | Route to the correct handler
router :: HTTPure.Request -> HTTPure.ResponseM
router { body, method: HTTPure.Post } = HTTPure.ok body
router _ = HTTPure.notFound
router _ = HTTPure.notFound
-- | 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 test localhost:8080 │"
Console.log $ " │ # => test │"
Console.log $ " └───────────────────────────────────────────┘"
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 test localhost:8080 │"
Console.log $ " │ # => test │"
Console.log $ " └───────────────────────────────────────────┘"

30
docs/Examples/QueryParameters/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.QueryParameters.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
import HTTPure ((!@), (!?))
@ -9,21 +8,22 @@ import HTTPure ((!@), (!?))
-- | Specify the routes
router :: HTTPure.Request -> HTTPure.ResponseM
router { query }
| query !? "foo" = HTTPure.ok "foo"
| query !? "foo" = HTTPure.ok "foo"
| query !@ "bar" == "test" = HTTPure.ok "bar"
| otherwise = HTTPure.ok $ query !@ "baz"
| otherwise = HTTPure.ok $ query !@ "baz"
-- | 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 localhost:8080?foo │"
Console.log $ " │ # => foo │"
Console.log $ " │ > curl localhost:8080?bar=test │"
Console.log $ " │ # => bar │"
Console.log $ " │ > curl localhost:8080?baz=<anything> │"
Console.log $ " │ # => <anything> │"
Console.log $ " └───────────────────────────────────────┘"
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 localhost:8080?foo │"
Console.log $ " │ # => foo │"
Console.log $ " │ > curl localhost:8080?bar=test │"
Console.log $ " │ # => bar │"
Console.log $ " │ > curl localhost:8080?baz=<anything> │"
Console.log $ " │ # => <anything> │"
Console.log $ " └───────────────────────────────────────┘"

18
docs/Examples/SSL/Main.purs
View File

@ -1,7 +1,6 @@
module Examples.SSL.Main where
import Prelude
import Effect.Console as Console
import HTTPure as HTTPure
@ -19,11 +18,12 @@ sayHello _ = HTTPure.ok "hello world!"
-- | Boot up the server
main :: HTTPure.ServerM
main = HTTPure.serveSecure 8080 cert key sayHello do
Console.log $ " ┌───────────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl --insecure https://localhost:8080 │"
Console.log $ " │ # => hello world! │"
Console.log $ " └───────────────────────────────────────────┘"
main =
HTTPure.serveSecure 8080 cert key sayHello do
Console.log $ " ┌───────────────────────────────────────────┐"
Console.log $ " │ Server now up on port 8080 │"
Console.log $ " │ │"
Console.log $ " │ To test, run: │"
Console.log $ " │ > curl --insecure https://localhost:8080 │"
Console.log $ " │ # => hello world! │"
Console.log $ " └───────────────────────────────────────────┘"

3
package.json
View File

@ -3,6 +3,7 @@
"devDependencies": {
"bower": "^1.8.12",
"pulp": "^15.0.0",
"purescript-psa": "^0.8.2"
"purescript-psa": "^0.8.2",
"purty": "^7.0.0"
}
}

191
src/HTTPure.purs
View File

@ -19,78 +19,135 @@ import HTTPure.Request (Request, fullPath)
import HTTPure.Response
( Response
, ResponseM
, response, response'
, emptyResponse, emptyResponse'
, response
, response'
, emptyResponse
, emptyResponse'
-- 1xx
, continue, continue'
, switchingProtocols, switchingProtocols'
, processing, processing'
, continue
, continue'
, switchingProtocols
, switchingProtocols'
, processing
, processing'
-- 2xx
, ok, ok'
, created, created'
, accepted, accepted'
, nonAuthoritativeInformation, nonAuthoritativeInformation'
, noContent, noContent'
, resetContent, resetContent'
, partialContent, partialContent'
, multiStatus, multiStatus'
, alreadyReported, alreadyReported'
, iMUsed, iMUsed'
, ok
, ok'
, created
, created'
, accepted
, accepted'
, nonAuthoritativeInformation
, nonAuthoritativeInformation'
, noContent
, noContent'
, resetContent
, resetContent'
, partialContent
, partialContent'
, multiStatus
, multiStatus'
, alreadyReported
, alreadyReported'
, iMUsed
, iMUsed'
-- 3xx
, multipleChoices, multipleChoices'
, movedPermanently, movedPermanently'
, found, found'
, seeOther, seeOther'
, notModified, notModified'
, useProxy, useProxy'
, temporaryRedirect, temporaryRedirect'
, permanentRedirect, permanentRedirect'
, multipleChoices
, multipleChoices'
, movedPermanently
, movedPermanently'
, found
, found'
, seeOther
, seeOther'
, notModified
, notModified'
, useProxy
, useProxy'
, temporaryRedirect
, temporaryRedirect'
, permanentRedirect
, permanentRedirect'
-- 4xx
, badRequest, badRequest'
, unauthorized, unauthorized'
, paymentRequired, paymentRequired'
, forbidden, forbidden'
, notFound, notFound'
, methodNotAllowed, methodNotAllowed'
, notAcceptable, notAcceptable'
, proxyAuthenticationRequired, proxyAuthenticationRequired'
, requestTimeout, requestTimeout'
, conflict, conflict'
, gone, gone'
, lengthRequired, lengthRequired'
, preconditionFailed, preconditionFailed'
, payloadTooLarge, payloadTooLarge'
, uRITooLong, uRITooLong'
, unsupportedMediaType, unsupportedMediaType'
, rangeNotSatisfiable, rangeNotSatisfiable'
, expectationFailed, expectationFailed'
, imATeapot, imATeapot'
, misdirectedRequest, misdirectedRequest'
, unprocessableEntity, unprocessableEntity'
, locked, locked'
, failedDependency, failedDependency'
, upgradeRequired, upgradeRequired'
, preconditionRequired, preconditionRequired'
, tooManyRequests, tooManyRequests'
, requestHeaderFieldsTooLarge, requestHeaderFieldsTooLarge'
, unavailableForLegalReasons, unavailableForLegalReasons'
, badRequest
, badRequest'
, unauthorized
, unauthorized'
, paymentRequired
, paymentRequired'
, forbidden
, forbidden'
, notFound
, notFound'
, methodNotAllowed
, methodNotAllowed'
, notAcceptable
, notAcceptable'
, proxyAuthenticationRequired
, proxyAuthenticationRequired'
, requestTimeout
, requestTimeout'
, conflict
, conflict'
, gone
, gone'
, lengthRequired
, lengthRequired'
, preconditionFailed
, preconditionFailed'
, payloadTooLarge
, payloadTooLarge'
, uRITooLong
, uRITooLong'
, unsupportedMediaType
, unsupportedMediaType'
, rangeNotSatisfiable
, rangeNotSatisfiable'
, expectationFailed
, expectationFailed'
, imATeapot
, imATeapot'
, misdirectedRequest
, misdirectedRequest'
, unprocessableEntity
, unprocessableEntity'
, locked
, locked'
, failedDependency
, failedDependency'
, upgradeRequired
, upgradeRequired'
, preconditionRequired
, preconditionRequired'
, tooManyRequests
, tooManyRequests'
, requestHeaderFieldsTooLarge
, requestHeaderFieldsTooLarge'
, unavailableForLegalReasons
, unavailableForLegalReasons'
-- 5xx
, internalServerError, internalServerError'
, notImplemented, notImplemented'
, badGateway, badGateway'
, serviceUnavailable, serviceUnavailable'
, gatewayTimeout, gatewayTimeout'
, hTTPVersionNotSupported, hTTPVersionNotSupported'
, variantAlsoNegotiates, variantAlsoNegotiates'
, insufficientStorage, insufficientStorage'
, loopDetected, loopDetected'
, notExtended, notExtended'
, networkAuthenticationRequired, networkAuthenticationRequired'
, internalServerError
, internalServerError'
, notImplemented
, notImplemented'
, badGateway
, badGateway'
, serviceUnavailable
, serviceUnavailable'
, gatewayTimeout
, gatewayTimeout'
, hTTPVersionNotSupported
, hTTPVersionNotSupported'
, variantAlsoNegotiates
, variantAlsoNegotiates'
, insufficientStorage
, insufficientStorage'
, loopDetected
, loopDetected'
, notExtended
, notExtended'
, networkAuthenticationRequired
, networkAuthenticationRequired'
)
import HTTPure.Server
( ServerM

72
src/HTTPure/Body.purs
View File

@ -6,7 +6,6 @@ module HTTPure.Body
) where
import Prelude
import Data.Either as Either
import Effect as Effect
import Effect.Aff as Aff
@ -21,13 +20,11 @@ import Type.Equality as TypeEquals
-- | 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
-- | Return any default headers that need to be sent with this body type,
-- | things like `Content-Type`, `Content-Length`, and `Transfer-Encoding`.
-- | Note that any headers passed in a response helper such as `ok'` will take
-- | precedence over these.
defaultHeaders :: b -> Effect.Effect Headers.Headers
-- | 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
@ -38,32 +35,31 @@ class Body b where
-- | string. Writing is simply implemented by writing the string to the
-- | response stream and closing the response stream.
instance bodyString :: Body String where
defaultHeaders body = do
buf :: Buffer.Buffer <- Buffer.fromString body Encoding.UTF8
defaultHeaders buf
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
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--we add a `Content-Length` header
-- | using `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
defaultHeaders buf =
Headers.header "Content-Length" <$> show <$> Buffer.size buf
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
defaultHeaders buf = Headers.header "Content-Length" <$> show <$> Buffer.size buf
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
-- | This instance can be used to send chunked data. Here, we add a
-- | `Transfer-Encoding` header to indicate chunked data. To write the data, we
@ -71,23 +67,25 @@ instance bodyBuffer :: Body Buffer.Buffer where
instance bodyChunked ::
TypeEquals.TypeEquals (Stream.Stream r) (Stream.Readable ()) =>
Body (Stream.Stream r) where
defaultHeaders _ = pure $ Headers.header "Transfer-Encoding" "chunked"
write body response = Aff.makeAff \done -> do
let stream = TypeEquals.to body
_ <- Stream.pipe stream $ HTTP.responseAsStream response
Stream.onEnd stream $ done $ Either.Right unit
pure Aff.nonCanceler
write body response =
Aff.makeAff \done -> do
let
stream = TypeEquals.to body
_ <- 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
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

27
src/HTTPure/Headers.purs
View File

@ -8,7 +8,6 @@ module HTTPure.Headers
) where
import Prelude
import Effect as Effect
import Foreign.Object as Object
import Data.Foldable as Foldable
@ -19,13 +18,14 @@ import Data.String.CaseInsensitive as CaseInsensitive
import Data.TraversableWithIndex as TraversableWithIndex
import Data.Tuple as Tuple
import Node.HTTP as HTTP
import HTTPure.Lookup as Lookup
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 (Map.Map CaseInsensitive.CaseInsensitiveString String)
newtype Headers
= Headers (Map.Map CaseInsensitive.CaseInsensitiveString String)
derive instance newtypeHeaders :: Newtype.Newtype Headers _
-- | Given a string, return a `Maybe` containing the value of the matching
@ -36,10 +36,9 @@ instance lookup :: Lookup.Lookup Headers String String where
-- | Allow a `Headers` to be represented as a string. This string is formatted
-- | in HTTP headers format.
instance show :: Show Headers where
show (Headers headers') =
FoldableWithIndex.foldMapWithIndex showField headers' <> "\n"
show (Headers headers') = FoldableWithIndex.foldMapWithIndex showField headers' <> "\n"
where
showField key value = Newtype.unwrap key <> ": " <> value <> "\n"
showField key value = Newtype.unwrap key <> ": " <> value <> "\n"
-- | Compare two `Headers` objects by comparing the underlying `Objects`.
instance eq :: Eq Headers where
@ -53,16 +52,16 @@ instance semigroup :: Semigroup Headers where
read :: HTTP.Request -> Headers
read = HTTP.requestHeaders >>> Object.fold insertField Map.empty >>> Headers
where
insertField x key value =
Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
insertField x key value = Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
-- | 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 response (Headers headers') = void $
TraversableWithIndex.traverseWithIndex writeField headers'
write response (Headers headers') =
void
$ TraversableWithIndex.traverseWithIndex writeField headers'
where
writeField key value = HTTP.setHeader response (Newtype.unwrap key) value
writeField key value = HTTP.setHeader response (Newtype.unwrap key) value
-- | Return a `Headers` containing nothing.
empty :: Headers
@ -72,10 +71,8 @@ empty = Headers Map.empty
headers :: Array (Tuple.Tuple String String) -> Headers
headers = Foldable.foldl insertField Map.empty >>> Headers
where
insertField x (Tuple.Tuple key value) =
Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
insertField x (Tuple.Tuple key value) = Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
-- | Create a singleton header from a key-value pair.
header :: String -> String -> Headers
header key =
Map.singleton (CaseInsensitive.CaseInsensitiveString key) >>> Headers
header key = Map.singleton (CaseInsensitive.CaseInsensitiveString key) >>> Headers

13
src/HTTPure/Lookup.purs
View File

@ -1,12 +1,14 @@
module HTTPure.Lookup
( class Lookup
, at, (!@)
, has, (!?)
, lookup, (!!)
, at
, (!@)
, has
, (!?)
, lookup
, (!!)
) where
import Prelude
import Data.Array as Array
import Data.Map as Map
import Data.Maybe as Maybe
@ -19,7 +21,6 @@ import Foreign.Object as Object
-- | `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 | c -> r where
-- | Given some type and a key on that type, extract some value that
-- | corresponds to that key.
lookup :: c -> k -> Maybe.Maybe r
@ -40,12 +41,10 @@ instance lookupArray :: Lookup (Array t) Int t where
instance lookupObject :: Lookup (Object.Object t) String t where
lookup = flip Object.lookup
-- | The instance of `Lookup` for a `Map CaseInsensitiveString` converts the
-- | `String` to a `CaseInsensitiveString` for lookup.
instance lookupMapCaseInsensitiveString ::
Lookup (Map.Map CaseInsensitive.CaseInsensitiveString t) String t where
lookup set key = Map.lookup (CaseInsensitive.CaseInsensitiveString key) set
-- | This simple helper works on any `Lookup` instance where the return type is

14
src/HTTPure/Method.purs
View File

@ -36,12 +36,12 @@ instance showMethod :: Show Method where
-- | Take an HTTP `Request` and extract the `Method` for that request.
read :: HTTP.Request -> Method
read request = case HTTP.requestMethod request of
"POST" -> Post
"PUT" -> Put
"DELETE" -> Delete
"HEAD" -> Head
"POST" -> Post
"PUT" -> Put
"DELETE" -> Delete
"HEAD" -> Head
"CONNECT" -> Connect
"OPTIONS" -> Options
"TRACE" -> Trace
"PATCH" -> Patch
_ -> Get
"TRACE" -> Trace
"PATCH" -> Patch
_ -> Get

17
src/HTTPure/Path.purs
View File

@ -4,28 +4,27 @@ module HTTPure.Path
) where
import Prelude
import Data.Array as Array
import Data.Maybe as Maybe
import Data.String as String
import Node.HTTP as HTTP
import HTTPure.Utils as Utils
-- | The `Path` type is just sugar for an `Array` of `String` segments that are
-- | sent in a request and indicates the path of the resource being requested.
-- | Note that this type has an implementation of `Lookup` for `Int` keys
-- | defined by `lookupArray` in [Lookup.purs](./Lookup.purs) because
-- | `lookupArray` is defined for any `Array` of `Monoids`. So you can do
-- | something like `path !! 2` to get the path segment at index 2.
type Path = Array String
type Path
= Array String
-- | Given an HTTP `Request` object, extract the `Path`.
read :: HTTP.Request -> Path
read =
HTTP.requestURL >>> split "?" >>> first >>> split "/" >>> nonempty >>> map Utils.urlDecode
read = HTTP.requestURL >>> split "?" >>> first >>> split "/" >>> nonempty >>> map Utils.urlDecode
where
nonempty = Array.filter ((/=) "")
split = String.Pattern >>> String.split
first = Array.head >>> Maybe.fromMaybe ""
nonempty = Array.filter ((/=) "")
split = String.Pattern >>> String.split
first = Array.head >>> Maybe.fromMaybe ""

35
src/HTTPure/Query.purs
View File

@ -4,7 +4,6 @@ module HTTPure.Query
) where
import Prelude
import Data.Array as Array
import Data.Bifunctor as Bifunctor
import Data.Maybe as Maybe
@ -12,7 +11,6 @@ import Data.String as String
import Data.Tuple as Tuple
import Foreign.Object as Object
import Node.HTTP as HTTP
import HTTPure.Utils as Utils
-- | The `Query` type is a `Object` of `Strings`, with one entry per query
@ -23,20 +21,27 @@ import HTTPure.Utils as Utils
-- | [Lookup.purs](./Lookup.purs) because `lookupObject` is defined for any
-- | `Object` of `Monoids`. So you can do something like `query !! "foo"` to get
-- | the value of the query parameter "foo".
type Query = Object.Object String
type Query
= Object.Object String
-- | The `Map` of query segments in the given HTTP `Request`.
read :: HTTP.Request -> Query
read =
HTTP.requestURL >>> split "?" >>> last >>> split "&" >>> nonempty >>> toObject
read = HTTP.requestURL >>> split "?" >>> last >>> split "&" >>> nonempty >>> toObject
where
toObject = map toTuple >>> Object.fromFoldable
nonempty = Array.filter ((/=) "")
split = String.Pattern >>> String.split
first = Array.head >>> Maybe.fromMaybe ""
last = Array.tail >>> Maybe.fromMaybe [] >>> String.joinWith ""
decode = Utils.replacePlus >>> Utils.urlDecode
decodeKeyValue = Bifunctor.bimap decode decode
toTuple item = decodeKeyValue $ Tuple.Tuple (first itemParts) (last itemParts)
where
itemParts = split "=" item
toObject = map toTuple >>> Object.fromFoldable
nonempty = Array.filter ((/=) "")
split = String.Pattern >>> String.split
first = Array.head >>> Maybe.fromMaybe ""
last = Array.tail >>> Maybe.fromMaybe [] >>> String.joinWith ""
decode = Utils.replacePlus >>> Utils.urlDecode
decodeKeyValue = Bifunctor.bimap decode decode
toTuple item = decodeKeyValue $ Tuple.Tuple (first itemParts) (last itemParts)
where
itemParts = split "=" item

52
src/HTTPure/Request.purs
View File

@ -5,12 +5,10 @@ module HTTPure.Request
) where
import Prelude
import Effect.Aff as Aff
import Data.String as String
import Foreign.Object as Object
import Node.HTTP as HTTP
import HTTPure.Body as Body
import HTTPure.Headers as Headers
import HTTPure.Method as Method
@ -21,15 +19,15 @@ import HTTPure.Version as Version
-- | The `Request` type is a `Record` type that includes fields for accessing
-- | the different parts of the HTTP request.
type Request =
{ method :: Method.Method
, path :: Path.Path
, query :: Query.Query
, headers :: Headers.Headers
, body :: String
, httpVersion :: Version.Version
, url :: String
}
type Request
= { method :: Method.Method
, path :: Path.Path
, query :: Query.Query
, headers :: Headers.Headers
, body :: String
, httpVersion :: Version.Version
, url :: String
}
-- | Return the full resolved path, including query parameters. This may not
-- | match the requested path--for instance, if there are empty path segments in
@ -37,23 +35,27 @@ type Request =
fullPath :: Request -> String
fullPath request = "/" <> path <> questionMark <> queryParams
where
path = String.joinWith "/" request.path
questionMark = if Object.isEmpty request.query then "" else "?"
queryParams = String.joinWith "&" queryParamsArr
queryParamsArr = Object.toArrayWithKey stringifyQueryParam request.query
stringifyQueryParam key value = encodeURIComponent key <> "=" <> encodeURIComponent value
path = String.joinWith "/" request.path
questionMark = if Object.isEmpty request.query then "" else "?"
queryParams = String.joinWith "&" queryParamsArr
queryParamsArr = Object.toArrayWithKey stringifyQueryParam request.query
stringifyQueryParam key value = encodeURIComponent key <> "=" <> encodeURIComponent value
-- | 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
}
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
}

268
src/HTTPure/Response.purs
View File

@ -2,88 +2,143 @@ module HTTPure.Response
( Response
, ResponseM
, send
, response, response'
, emptyResponse, emptyResponse'
, response
, response'
, emptyResponse
, emptyResponse'
-- 1xx
, continue, continue'
, switchingProtocols, switchingProtocols'
, processing, processing'
, continue
, continue'
, switchingProtocols
, switchingProtocols'
, processing
, processing'
-- 2xx
, ok, ok'
, created, created'
, accepted, accepted'
, nonAuthoritativeInformation, nonAuthoritativeInformation'
, noContent, noContent'
, resetContent, resetContent'
, partialContent, partialContent'
, multiStatus, multiStatus'
, alreadyReported, alreadyReported'
, iMUsed, iMUsed'
, ok
, ok'
, created
, created'
, accepted
, accepted'
, nonAuthoritativeInformation
, nonAuthoritativeInformation'
, noContent
, noContent'
, resetContent
, resetContent'
, partialContent
, partialContent'
, multiStatus
, multiStatus'
, alreadyReported
, alreadyReported'
, iMUsed
, iMUsed'
-- 3xx
, multipleChoices, multipleChoices'
, movedPermanently, movedPermanently'
, found, found'
, seeOther, seeOther'
, notModified, notModified'
, useProxy, useProxy'
, temporaryRedirect, temporaryRedirect'
, permanentRedirect, permanentRedirect'
, multipleChoices
, multipleChoices'
, movedPermanently
, movedPermanently'
, found
, found'
, seeOther
, seeOther'
, notModified
, notModified'
, useProxy
, useProxy'
, temporaryRedirect
, temporaryRedirect'
, permanentRedirect
, permanentRedirect'
-- 4xx
, badRequest, badRequest'
, unauthorized, unauthorized'
, paymentRequired, paymentRequired'
, forbidden, forbidden'
, notFound, notFound'
, methodNotAllowed, methodNotAllowed'
, notAcceptable, notAcceptable'
, proxyAuthenticationRequired, proxyAuthenticationRequired'
, requestTimeout, requestTimeout'
, conflict, conflict'
, gone, gone'
, lengthRequired, lengthRequired'
, preconditionFailed, preconditionFailed'
, payloadTooLarge, payloadTooLarge'
, uRITooLong, uRITooLong'
, unsupportedMediaType, unsupportedMediaType'
, rangeNotSatisfiable, rangeNotSatisfiable'
, expectationFailed, expectationFailed'
, imATeapot, imATeapot'
, misdirectedRequest, misdirectedRequest'
, unprocessableEntity, unprocessableEntity'
, locked, locked'
, failedDependency, failedDependency'
, upgradeRequired, upgradeRequired'
, preconditionRequired, preconditionRequired'
, tooManyRequests, tooManyRequests'
, requestHeaderFieldsTooLarge, requestHeaderFieldsTooLarge'
, unavailableForLegalReasons, unavailableForLegalReasons'
, badRequest
, badRequest'
, unauthorized
, unauthorized'
, paymentRequired
, paymentRequired'
, forbidden
, forbidden'
, notFound
, notFound'
, methodNotAllowed
, methodNotAllowed'
, notAcceptable
, notAcceptable'
, proxyAuthenticationRequired
, proxyAuthenticationRequired'
, requestTimeout
, requestTimeout'
, conflict
, conflict'
, gone
, gone'
, lengthRequired
, lengthRequired'
, preconditionFailed
, preconditionFailed'
, payloadTooLarge
, payloadTooLarge'
, uRITooLong
, uRITooLong'
, unsupportedMediaType
, unsupportedMediaType'
, rangeNotSatisfiable
, rangeNotSatisfiable'
, expectationFailed
, expectationFailed'
, imATeapot
, imATeapot'
, misdirectedRequest
, misdirectedRequest'
, unprocessableEntity
, unprocessableEntity'
, locked
, locked'
, failedDependency
, failedDependency'
, upgradeRequired
, upgradeRequired'
, preconditionRequired
, preconditionRequired'
, tooManyRequests
, tooManyRequests'
, requestHeaderFieldsTooLarge
, requestHeaderFieldsTooLarge'
, unavailableForLegalReasons
, unavailableForLegalReasons'
-- 5xx
, internalServerError, internalServerError'
, notImplemented, notImplemented'
, badGateway, badGateway'
, serviceUnavailable, serviceUnavailable'
, gatewayTimeout, gatewayTimeout'
, hTTPVersionNotSupported, hTTPVersionNotSupported'
, variantAlsoNegotiates, variantAlsoNegotiates'
, insufficientStorage, insufficientStorage'
, loopDetected, loopDetected'
, notExtended, notExtended'
, networkAuthenticationRequired, networkAuthenticationRequired'
, internalServerError
, internalServerError'
, notImplemented
, notImplemented'
, badGateway
, badGateway'
, serviceUnavailable
, serviceUnavailable'
, gatewayTimeout
, gatewayTimeout'
, hTTPVersionNotSupported
, hTTPVersionNotSupported'
, variantAlsoNegotiates
, variantAlsoNegotiates'
, insufficientStorage
, insufficientStorage'
, loopDetected
, loopDetected'
, notExtended
, notExtended'
, networkAuthenticationRequired
, networkAuthenticationRequired'
) where
import Prelude
import Effect.Aff as Aff
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Class (class MonadEffect)
import Effect.Class as EffectClass
import Node.HTTP as HTTP
import HTTPure.Body as Body
import HTTPure.Headers as Headers
import HTTPure.Status as Status
@ -91,14 +146,15 @@ import HTTPure.Status as Status
-- | The `ResponseM` type simply conveniently wraps up an HTTPure monad that
-- | returns a response. This type is the return type of all router/route
-- | methods.
type ResponseM = Aff.Aff Response
type ResponseM
= Aff.Aff Response
-- | A `Response` is a status code, headers, and a body.
type Response =
{ status :: Status.Status
, headers :: Headers.Headers
, writeBody :: HTTP.Response -> Aff.Aff Unit
}
type Response
= { status :: Status.Status
, headers :: Headers.Headers
, writeBody :: HTTP.Response -> Aff.Aff Unit
}
-- | Given an HTTP `Response` and a HTTPure `Response`, this method will return
-- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response`
@ -115,19 +171,22 @@ response :: forall m b. MonadAff m => Body.Body b => Status.Status -> b -> m Res
response status = response' status Headers.empty
-- | The same as `response` but with headers.
response' :: forall m b. MonadAff m =>
Body.Body b =>
Status.Status ->
Headers.Headers ->
b ->
m Response
response' status headers body = EffectClass.liftEffect do
defaultHeaders <- Body.defaultHeaders body
pure
{ status
, headers: defaultHeaders <> headers
, writeBody: Body.write body
}
response' ::
forall m b.
MonadAff m =>
Body.Body b =>
Status.Status ->
Headers.Headers ->
b ->
m Response
response' status headers body =
EffectClass.liftEffect do
defaultHeaders <- Body.defaultHeaders body
pure
{ status
, headers: defaultHeaders <> headers
, writeBody: Body.write body
}
-- | The same as `response` but without a body.
emptyResponse :: forall m. MonadAff m => Status.Status -> m Response
@ -140,7 +199,6 @@ emptyResponse' status headers = response' status headers ""
---------
-- 1xx --
---------
-- | 100
continue :: forall m. MonadAff m => m Response
continue = continue' Headers.empty
@ -168,7 +226,6 @@ processing' = emptyResponse' Status.processing
---------
-- 2xx --
---------
-- | 200
ok :: forall m b. MonadAff m => Body.Body b => b -> m Response
ok = ok' Headers.empty
@ -198,11 +255,13 @@ nonAuthoritativeInformation :: forall m b. MonadAff m => Body.Body b => b -> m R
nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty
-- | 203 with headers
nonAuthoritativeInformation' :: forall m b. MonadAff m =>
Body.Body b =>
Headers.Headers ->
b ->
m Response
nonAuthoritativeInformation' ::
forall m b.
MonadAff m =>
Body.Body b =>
Headers.Headers ->
b ->
m Response
nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation
-- | 204
@ -256,7 +315,6 @@ iMUsed' = response' Status.iMUsed
---------
-- 3xx --
---------
-- | 300
multipleChoices :: forall m b. MonadAff m => Body.Body b => b -> m Response
multipleChoices = multipleChoices' Headers.empty
@ -321,11 +379,9 @@ permanentRedirect = permanentRedirect' Headers.empty
permanentRedirect' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
permanentRedirect' = response' Status.permanentRedirect
---------
-- 4xx --
---------
-- | 400
badRequest :: forall m b. MonadAff m => Body.Body b => b -> m Response
badRequest = badRequest' Headers.empty
@ -553,17 +609,18 @@ unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons
---------
-- 5xx --
---------
-- | 500
internalServerError :: forall m b. MonadAff m => Body.Body b => b -> m Response
internalServerError = internalServerError' Headers.empty
-- | 500 with headers
internalServerError' :: forall m b. MonadAff m =>
Body.Body b =>
Headers.Headers ->
b ->
m Response
internalServerError' ::
forall m b.
MonadAff m =>
Body.Body b =>
Headers.Headers ->
b ->
m Response
internalServerError' = response' Status.internalServerError
-- | 501
@ -644,5 +701,4 @@ networkAuthenticationRequired = networkAuthenticationRequired' Headers.empty
-- | 511 with headers
networkAuthenticationRequired' :: forall m. MonadAff m => Headers.Headers -> m Response
networkAuthenticationRequired' =
emptyResponse' Status.networkAuthenticationRequired
networkAuthenticationRequired' = emptyResponse' Status.networkAuthenticationRequired

75
src/HTTPure/Server.purs
View File

@ -7,7 +7,6 @@ module HTTPure.Server
) where
import Prelude
import Effect as Effect
import Effect.Aff as Aff
import Effect.Class as EffectClass
@ -18,47 +17,49 @@ import Node.Encoding as Encoding
import Node.FS.Sync as FSSync
import Node.HTTP as HTTP
import Node.HTTP.Secure as HTTPS
import HTTPure.Request as Request
import HTTPure.Response as Response
-- | The `ServerM` is just an `Effect` containing a callback to close the
-- | server. This type is the return type of the HTTPure serve and related
-- | methods.
type ServerM = Effect.Effect (Effect.Effect Unit -> Effect.Effect Unit)
type ServerM
= Effect.Effect (Effect.Effect Unit -> Effect.Effect Unit)
-- | Given a router, handle unhandled exceptions it raises by
-- | responding with 500 Internal Server Error.
onError500 :: (Request.Request -> Response.ResponseM) ->
Request.Request ->
Response.ResponseM
onError500 ::
(Request.Request -> Response.ResponseM) ->
Request.Request ->
Response.ResponseM
onError500 router request =
Aff.catchError (router request) \err -> do
EffectClass.liftEffect $ Console.error $ Aff.message err
Response.internalServerError "Internal server error"
-- | This function takes a method which takes a `Request` and returns a
-- | `ResponseM`, an HTTP `Request`, and an HTTP `Response`. It runs the
-- | request, extracts the `Response` from the `ResponseM`, and sends the
-- | `Response` to the HTTP `Response`.
handleRequest :: (Request.Request -> Response.ResponseM) ->
HTTP.Request ->
HTTP.Response ->
Effect.Effect Unit
handleRequest ::
(Request.Request -> Response.ResponseM) ->
HTTP.Request ->
HTTP.Response ->
Effect.Effect Unit
handleRequest router request httpresponse =
void $ Aff.runAff (\_ -> pure unit) $
Request.fromHTTPRequest request
void $ Aff.runAff (\_ -> pure unit)
$ Request.fromHTTPRequest request
>>= onError500 router
>>= Response.send httpresponse
-- | Given a `ListenOptions` object, a function mapping `Request` to
-- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and
-- | runs a HTTPure server without SSL.
serve' :: HTTP.ListenOptions ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serve' ::
HTTP.ListenOptions ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serve' options router onStarted = do
server <- HTTP.createServer (handleRequest router)
HTTP.listen server options onStarted
@ -68,11 +69,12 @@ serve' options router onStarted = do
-- | object, a function mapping `Request` to `ResponseM`, and a `ServerM`
-- | containing effects to run on boot, creates and runs a HTTPure server with
-- | SSL.
serveSecure' :: Options HTTPS.SSLOptions ->
HTTP.ListenOptions ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serveSecure' ::
Options HTTPS.SSLOptions ->
HTTP.ListenOptions ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serveSecure' sslOptions options router onStarted = do
server <- HTTPS.createServer sslOptions (handleRequest router)
HTTP.listen server options onStarted
@ -91,10 +93,11 @@ listenOptions port =
-- | `ResponseM`, and a `ServerM` containing effects to run after the server has
-- | booted (usually logging). Returns an `ServerM` containing the server's
-- | effects.
serve :: Int ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serve ::
Int ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serve = serve' <<< listenOptions
-- | Create and start an SSL server. This method is the same as `serve`, but
@ -104,17 +107,19 @@ serve = serve' <<< listenOptions
-- | 3. A path to a private key file
-- | 4. A handler method which maps `Request` to `ResponseM`
-- | 5. A callback to call when the server is up
serveSecure :: Int ->
String ->
String ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serveSecure ::
Int ->
String ->
String ->
(Request.Request -> Response.ResponseM) ->
Effect.Effect Unit ->
ServerM
serveSecure port cert key router onStarted = do
cert' <- FSSync.readTextFile Encoding.UTF8 cert
key' <- FSSync.readTextFile Encoding.UTF8 key
serveSecure' (sslOpts key' cert') (listenOptions port) router onStarted
where
sslOpts key' cert' =
HTTPS.key := HTTPS.keyString key' <>
HTTPS.cert := HTTPS.certString cert'
sslOpts key' cert' =
HTTPS.key := HTTPS.keyString key'
<> HTTPS.cert
:= HTTPS.certString cert'

15
src/HTTPure/Status.purs
View File

@ -1,12 +1,10 @@
module HTTPure.Status
( Status
, write
-- 1xx
, continue
, switchingProtocols
, processing
-- 2xx
, ok
, created
@ -18,7 +16,6 @@ module HTTPure.Status
, multiStatus
, alreadyReported
, iMUsed
-- 3xx
, multipleChoices
, movedPermanently
@ -28,7 +25,6 @@ module HTTPure.Status
, useProxy
, temporaryRedirect
, permanentRedirect
-- 4xx
, badRequest
, unauthorized
@ -58,7 +54,6 @@ module HTTPure.Status
, tooManyRequests
, requestHeaderFieldsTooLarge
, unavailableForLegalReasons
-- 5xx
, internalServerError
, notImplemented
@ -74,12 +69,12 @@ module HTTPure.Status
) where
import Prelude
import Effect as Effect
import Node.HTTP as HTTP
-- | The `Status` type enumerates all valid HTTP response status codes.
type Status = Int
type Status
= Int
-- | Write a status to a given HTTP `Response`.
write :: HTTP.Response -> Status -> Effect.Effect Unit
@ -88,7 +83,6 @@ write = HTTP.setStatusCode
---------
-- 1xx --
---------
-- | 100
continue :: Status
continue = 100
@ -104,7 +98,6 @@ processing = 102
---------
-- 2xx --
---------
-- | 200
ok :: Status
ok = 200
@ -148,7 +141,6 @@ iMUsed = 226
---------
-- 3xx --
---------
-- | 300
multipleChoices :: Status
multipleChoices = 300
@ -181,11 +173,9 @@ temporaryRedirect = 307
permanentRedirect :: Status
permanentRedirect = 308
---------
-- 4xx --
---------
-- | 400
badRequest :: Status
badRequest = 400
@ -301,7 +291,6 @@ unavailableForLegalReasons = 451
---------
-- 5xx --
---------
-- | 500
internalServerError :: Status
internalServerError = 500

9
src/HTTPure/Utils.purs
View File

@ -5,7 +5,6 @@ module HTTPure.Utils
) where
import Prelude
import Data.Maybe as Maybe
import Data.String as String
import JSURI as JSURI
@ -13,12 +12,8 @@ import JSURI as JSURI
encodeURIComponent :: String -> String
encodeURIComponent s = Maybe.fromMaybe s $ JSURI.encodeURIComponent s
replacePlus :: String -> String
replacePlus =
String.replaceAll (String.Pattern "+") (String.Replacement "%20")
replacePlus = String.replaceAll (String.Pattern "+") (String.Replacement "%20")
urlDecode :: String -> String
urlDecode s =
Maybe.fromMaybe s $ JSURI.decodeURIComponent s
urlDecode s = Maybe.fromMaybe s $ JSURI.decodeURIComponent s

1
src/HTTPure/Version.purs
View File

@ -4,7 +4,6 @@ module HTTPure.Version
) where
import Prelude
import Node.HTTP as HTTP
-- | These are the HTTP versions that HTTPure understands. There are five

110
test/Test/HTTPure/BodySpec.purs
View File

@ -1,74 +1,76 @@
module Test.HTTPure.BodySpec where
import Prelude
import Effect.Class as EffectClass
import Node.Buffer as Buffer
import Node.Encoding as Encoding
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 ((?=))
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"
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"
defaultHeadersSpec :: TestHelpers.Test
defaultHeadersSpec = Spec.describe "defaultHeaders" do
Spec.describe "String" do
Spec.describe "with an ASCII string" do
defaultHeadersSpec =
Spec.describe "defaultHeaders" do
Spec.describe "String" do
Spec.describe "with an ASCII string" do
Spec.it "has the correct Content-Length header" do
headers <- EffectClass.liftEffect $ Body.defaultHeaders "ascii"
headers ?= Headers.header "Content-Length" "5"
Spec.describe "with a UTF-8 string" do
Spec.it "has the correct Content-Length header" do
headers <- EffectClass.liftEffect $ Body.defaultHeaders "\x2603"
headers ?= Headers.header "Content-Length" "3"
Spec.describe "Buffer" do
Spec.it "has the correct Content-Length header" do
headers <- EffectClass.liftEffect $ Body.defaultHeaders "ascii"
headers ?= Headers.header "Content-Length" "5"
Spec.describe "with a UTF-8 string" do
Spec.it "has the correct Content-Length header" do
headers <- EffectClass.liftEffect $ Body.defaultHeaders "\x2603"
headers ?= Headers.header "Content-Length" "3"
Spec.describe "Buffer" do
Spec.it "has the correct Content-Length header" do
buf :: Buffer.Buffer <- EffectClass.liftEffect $ Buffer.fromString "foobar" Encoding.UTF8
headers <- EffectClass.liftEffect $ Body.defaultHeaders buf
headers ?= Headers.header "Content-Length" "6"
Spec.describe "Readable" do
Spec.it "specifies the Transfer-Encoding header" do
let body = TestHelpers.stringToStream "test"
headers <- EffectClass.liftEffect $ Body.defaultHeaders body
headers ?= Headers.header "Transfer-Encoding" "chunked"
buf :: Buffer.Buffer <- EffectClass.liftEffect $ Buffer.fromString "foobar" Encoding.UTF8
headers <- EffectClass.liftEffect $ Body.defaultHeaders buf
headers ?= Headers.header "Content-Length" "6"
Spec.describe "Readable" do
Spec.it "specifies the Transfer-Encoding header" do
let
body = TestHelpers.stringToStream "test"
headers <- EffectClass.liftEffect $ Body.defaultHeaders body
headers ?= Headers.header "Transfer-Encoding" "chunked"
writeSpec :: TestHelpers.Test
writeSpec = Spec.describe "write" do
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 :: Buffer.Buffer <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
Body.write buf resp
pure $ TestHelpers.getResponseBody resp
body ?= "test"
Spec.describe "Readable" do
Spec.it "pipes the input stream to the Response body" do
body <- do
resp <- EffectClass.liftEffect TestHelpers.mockResponse
Body.write (TestHelpers.stringToStream "test") resp
pure $ TestHelpers.getResponseBody resp
body ?= "test"
writeSpec =
Spec.describe "write" do
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 :: Buffer.Buffer <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
Body.write buf resp
pure $ TestHelpers.getResponseBody resp
body ?= "test"
Spec.describe "Readable" do
Spec.it "pipes the input stream to the Response body" do
body <- do
resp <- EffectClass.liftEffect TestHelpers.mockResponse
Body.write (TestHelpers.stringToStream "test") resp
pure $ TestHelpers.getResponseBody resp
body ?= "test"
bodySpec :: TestHelpers.Test
bodySpec = Spec.describe "Body" do
defaultHeadersSpec
readSpec
writeSpec
bodySpec =
Spec.describe "Body" do
defaultHeadersSpec
readSpec
writeSpec

203
test/Test/HTTPure/HeadersSpec.purs
View File

@ -1,129 +1,146 @@
module Test.HTTPure.HeadersSpec where
import Prelude
import Effect.Class as EffectClass
import Data.Maybe as Maybe
import Data.Tuple as Tuple
import Test.Spec as Spec
import HTTPure.Headers as Headers
import HTTPure.Lookup ((!!))
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
lookupSpec :: TestHelpers.Test
lookupSpec = Spec.describe "lookup" do
Spec.describe "when the string is in the header set" do
Spec.describe "when searching with lowercase" do
Spec.it "is Just the string" do
Headers.header "x-test" "test" !! "x-test" ?= Maybe.Just "test"
Spec.describe "when searching with uppercase" do
Spec.it "is Just the string" do
Headers.header "x-test" "test" !! "X-Test" ?= Maybe.Just "test"
Spec.describe "when the string is uppercase" do
lookupSpec =
Spec.describe "lookup" do
Spec.describe "when the string is in the header set" do
Spec.describe "when searching with lowercase" do
Spec.it "is Just the string" do
Headers.header "X-Test" "test" !! "x-test" ?= Maybe.Just "test"
Headers.header "x-test" "test" !! "x-test" ?= Maybe.Just "test"
Spec.describe "when searching with uppercase" do
Spec.it "is Just the string" do
Headers.header "X-Test" "test" !! "X-Test" ?= Maybe.Just "test"
Spec.describe "when the string is not in the header set" do
Spec.it "is Nothing" do
((Headers.empty !! "X-Test") :: Maybe.Maybe String) ?= Maybe.Nothing
Headers.header "x-test" "test" !! "X-Test" ?= Maybe.Just "test"
Spec.describe "when the string is uppercase" do
Spec.describe "when searching with lowercase" do
Spec.it "is Just the string" do
Headers.header "X-Test" "test" !! "x-test" ?= Maybe.Just "test"
Spec.describe "when searching with uppercase" do
Spec.it "is Just the string" do
Headers.header "X-Test" "test" !! "X-Test" ?= Maybe.Just "test"
Spec.describe "when the string is not in the header set" do
Spec.it "is Nothing" do
((Headers.empty !! "X-Test") :: Maybe.Maybe String) ?= Maybe.Nothing
showSpec :: TestHelpers.Test
showSpec = Spec.describe "show" do
Spec.it "is a string representing the headers in HTTP format" do
let mock = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
show mock ?= "Test1: 1\nTest2: 2\n\n"
showSpec =
Spec.describe "show" do
Spec.it "is a string representing the headers in HTTP format" do
let
mock = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
show mock ?= "Test1: 1\nTest2: 2\n\n"
eqSpec :: TestHelpers.Test
eqSpec = Spec.describe "eq" do
Spec.describe "when the two Headers contain the same keys and values" do
Spec.it "is true" do
Headers.header "Test1" "test1" == Headers.header "Test1" "test1" ?= true
Spec.describe "when the two Headers contain different keys and values" do
Spec.it "is false" do
Headers.header "Test1" "test1" == Headers.header "Test2" "test2" ?= false
Spec.describe "when the two Headers contain only different values" do
Spec.it "is false" do
Headers.header "Test1" "test1" == Headers.header "Test1" "test2" ?= false
Spec.describe "when the one Headers contains additional keys and values" do
Spec.it "is false" do
let mock = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
Headers.header "Test1" "1" == mock ?= false
eqSpec =
Spec.describe "eq" do
Spec.describe "when the two Headers contain the same keys and values" do
Spec.it "is true" do
Headers.header "Test1" "test1" == Headers.header "Test1" "test1" ?= true
Spec.describe "when the two Headers contain different keys and values" do
Spec.it "is false" do
Headers.header "Test1" "test1" == Headers.header "Test2" "test2" ?= false
Spec.describe "when the two Headers contain only different values" do
Spec.it "is false" do
Headers.header "Test1" "test1" == Headers.header "Test1" "test2" ?= false
Spec.describe "when the one Headers contains additional keys and values" do
Spec.it "is false" do
let
mock = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
Headers.header "Test1" "1" == mock ?= false
appendSpec :: TestHelpers.Test
appendSpec = Spec.describe "append" do
Spec.describe "when there are multiple keys" do
Spec.it "appends the headers correctly" do
let mock1 = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
let mock2 = Headers.header "Test3" "3" <> Headers.header "Test4" "4"
let mock3 = Headers.headers
[ Tuple.Tuple "Test1" "1"
, Tuple.Tuple "Test2" "2"
, Tuple.Tuple "Test3" "3"
, Tuple.Tuple "Test4" "4"
]
mock1 <> mock2 ?= mock3
Spec.describe "when there is a duplicated key" do
Spec.it "uses the last appended value" do
let mock = Headers.header "Test" "foo" <> Headers.header "Test" "bar"
mock ?= Headers.header "Test" "bar"
appendSpec =
Spec.describe "append" do
Spec.describe "when there are multiple keys" do
Spec.it "appends the headers correctly" do
let
mock1 = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
let
mock2 = Headers.header "Test3" "3" <> Headers.header "Test4" "4"
let
mock3 =
Headers.headers
[ Tuple.Tuple "Test1" "1"
, Tuple.Tuple "Test2" "2"
, Tuple.Tuple "Test3" "3"
, Tuple.Tuple "Test4" "4"
]
mock1 <> mock2 ?= mock3
Spec.describe "when there is a duplicated key" do
Spec.it "uses the last appended value" do
let
mock = Headers.header "Test" "foo" <> Headers.header "Test" "bar"
mock ?= Headers.header "Test" "bar"
readSpec :: TestHelpers.Test
readSpec = Spec.describe "read" do
Spec.describe "with no headers" do
Spec.it "is an empty Map" do
request <- TestHelpers.mockRequest "" "" "" "" []
Headers.read request ?= Headers.empty
Spec.describe "with headers" do
Spec.it "is a Map with the contents of the headers" do
let testHeader = [Tuple.Tuple "X-Test" "test"]
request <- TestHelpers.mockRequest "" "" "" "" testHeader
Headers.read request ?= Headers.headers testHeader
readSpec =
Spec.describe "read" do
Spec.describe "with no headers" do
Spec.it "is an empty Map" do
request <- TestHelpers.mockRequest "" "" "" "" []
Headers.read request ?= Headers.empty
Spec.describe "with headers" do
Spec.it "is a Map with the contents of the headers" do
let
testHeader = [ Tuple.Tuple "X-Test" "test" ]
request <- TestHelpers.mockRequest "" "" "" "" testHeader
Headers.read request ?= Headers.headers testHeader
writeSpec :: TestHelpers.Test
writeSpec = Spec.describe "write" do
Spec.it "writes the headers to the response" do
header <- EffectClass.liftEffect do
mock <- TestHelpers.mockResponse
Headers.write mock $ Headers.header "X-Test" "test"
pure $ TestHelpers.getResponseHeader "X-Test" mock
header ?= "test"
writeSpec =
Spec.describe "write" do
Spec.it "writes the headers to the response" do
header <-
EffectClass.liftEffect do
mock <- TestHelpers.mockResponse
Headers.write mock $ Headers.header "X-Test" "test"
pure $ TestHelpers.getResponseHeader "X-Test" mock
header ?= "test"
emptySpec :: TestHelpers.Test
emptySpec = Spec.describe "empty" do
Spec.it "is an empty Map in an empty Headers" do
show Headers.empty ?= "\n"
emptySpec =
Spec.describe "empty" do
Spec.it "is an empty Map in an empty Headers" do
show Headers.empty ?= "\n"
headerSpec :: TestHelpers.Test
headerSpec = Spec.describe "header" do
Spec.it "creates a singleton Headers" do
show (Headers.header "X-Test" "test") ?= "X-Test: test\n\n"
headerSpec =
Spec.describe "header" do
Spec.it "creates a singleton Headers" do
show (Headers.header "X-Test" "test") ?= "X-Test: test\n\n"
headersFunctionSpec :: TestHelpers.Test
headersFunctionSpec = Spec.describe "headers" do
Spec.it "is equivalent to using Headers.header with <>" do
test ?= expected
headersFunctionSpec =
Spec.describe "headers" do
Spec.it "is equivalent to using Headers.header with <>" do
test ?= expected
where
test =
Headers.headers
[ Tuple.Tuple "X-Test-1" "1"
, Tuple.Tuple "X-Test-2" "2"
]
expected = Headers.header "X-Test-1" "1" <> Headers.header "X-Test-2" "2"
test =
Headers.headers
[ Tuple.Tuple "X-Test-1" "1"
, Tuple.Tuple "X-Test-2" "2"
]
expected = Headers.header "X-Test-1" "1" <> Headers.header "X-Test-2" "2"
headersSpec :: TestHelpers.Test
headersSpec = Spec.describe "Headers" do
lookupSpec
showSpec
eqSpec
appendSpec
readSpec
writeSpec
emptySpec
headerSpec
headersFunctionSpec
headersSpec =
Spec.describe "Headers" do
lookupSpec
showSpec
eqSpec
appendSpec
readSpec
writeSpec
emptySpec
headerSpec
headersFunctionSpec

208
test/Test/HTTPure/IntegrationSpec.purs
View File

@ -1,16 +1,13 @@
module Test.HTTPure.IntegrationSpec where
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
import Test.HTTPure.TestHelpers ((?=))
import Examples.AsyncResponse.Main as AsyncResponse
import Examples.Binary.Main as Binary
import Examples.Chunked.Main as Chunked
@ -25,123 +22,136 @@ import Examples.QueryParameters.Main as QueryParameters
import Examples.SSL.Main as SSL
asyncResponseSpec :: TestHelpers.Test
asyncResponseSpec = Spec.it "runs the async response example" do
close <- EffectClass.liftEffect AsyncResponse.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello world!"
asyncResponseSpec =
Spec.it "runs the async response example" do
close <- EffectClass.liftEffect AsyncResponse.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello world!"
binarySpec :: TestHelpers.Test
binarySpec = Spec.it "runs the binary example" do
close <- EffectClass.liftEffect Binary.main
responseBuf <- TestHelpers.getBinary 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
binaryBuf <- FS.readFile Binary.filePath
expected <- EffectClass.liftEffect $ Buffer.toArray binaryBuf
response <- EffectClass.liftEffect $ Buffer.toArray responseBuf
response ?= expected
binarySpec =
Spec.it "runs the binary example" do
close <- EffectClass.liftEffect Binary.main
responseBuf <- TestHelpers.getBinary 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
binaryBuf <- FS.readFile Binary.filePath
expected <- EffectClass.liftEffect $ Buffer.toArray binaryBuf
response <- EffectClass.liftEffect $ Buffer.toArray responseBuf
response ?= expected
chunkedSpec :: TestHelpers.Test
chunkedSpec = Spec.it "runs the chunked example" do
close <- EffectClass.liftEffect Chunked.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
-- TODO this isn't a great way to validate this, we need a way of inspecting
-- each individual chunk instead of just looking at the entire response
response ?= "hello \nworld!\n"
chunkedSpec =
Spec.it "runs the chunked example" do
close <- EffectClass.liftEffect Chunked.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
-- TODO this isn't a great way to validate this, we need a way of inspecting
-- each individual chunk instead of just looking at the entire response
response ?= "hello \nworld!\n"
customStackSpec :: TestHelpers.Test
customStackSpec = Spec.it "runs the custom stack example" do
close <- EffectClass.liftEffect CustomStack.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello, joe"
customStackSpec =
Spec.it "runs the custom stack example" do
close <- EffectClass.liftEffect CustomStack.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello, joe"
headersSpec :: TestHelpers.Test
headersSpec = Spec.it "runs the headers example" do
close <- EffectClass.liftEffect Headers.main
header <- TestHelpers.getHeader 8080 Object.empty "/" "X-Example"
response <- TestHelpers.get 8080 (Object.singleton "X-Input" "test") "/"
EffectClass.liftEffect $ close $ pure unit
header ?= "hello world!"
response ?= "test"
headersSpec =
Spec.it "runs the headers example" do
close <- EffectClass.liftEffect Headers.main
header <- TestHelpers.getHeader 8080 Object.empty "/" "X-Example"
response <- TestHelpers.get 8080 (Object.singleton "X-Input" "test") "/"
EffectClass.liftEffect $ close $ pure unit
header ?= "hello world!"
response ?= "test"
helloWorldSpec :: TestHelpers.Test
helloWorldSpec = Spec.it "runs the hello world example" do
close <- EffectClass.liftEffect HelloWorld.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello world!"
helloWorldSpec =
Spec.it "runs the hello world example" do
close <- EffectClass.liftEffect HelloWorld.main
response <- TestHelpers.get 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello world!"
middlewareSpec :: TestHelpers.Test
middlewareSpec = Spec.it "runs the middleware example" do
close <- EffectClass.liftEffect Middleware.main
header <- TestHelpers.getHeader 8080 Object.empty "/" "X-Middleware"
body <- TestHelpers.get 8080 Object.empty "/"
header' <- TestHelpers.getHeader 8080 Object.empty "/middleware" "X-Middleware"
body' <- TestHelpers.get 8080 Object.empty "/middleware"
EffectClass.liftEffect $ close $ pure unit
header ?= "router"
body ?= "hello"
header' ?= "middleware"
body' ?= "Middleware!"
middlewareSpec =
Spec.it "runs the middleware example" do
close <- EffectClass.liftEffect Middleware.main
header <- TestHelpers.getHeader 8080 Object.empty "/" "X-Middleware"
body <- TestHelpers.get 8080 Object.empty "/"
header' <- TestHelpers.getHeader 8080 Object.empty "/middleware" "X-Middleware"
body' <- TestHelpers.get 8080 Object.empty "/middleware"
EffectClass.liftEffect $ close $ pure unit
header ?= "router"
body ?= "hello"
header' ?= "middleware"
body' ?= "Middleware!"
multiRouteSpec :: TestHelpers.Test
multiRouteSpec = Spec.it "runs the multi route example" do
close <- EffectClass.liftEffect MultiRoute.main
hello <- TestHelpers.get 8080 Object.empty "/hello"
goodbye <- TestHelpers.get 8080 Object.empty "/goodbye"
EffectClass.liftEffect $ close $ pure unit
hello ?= "hello"
goodbye ?= "goodbye"
multiRouteSpec =
Spec.it "runs the multi route example" do
close <- EffectClass.liftEffect MultiRoute.main
hello <- TestHelpers.get 8080 Object.empty "/hello"
goodbye <- TestHelpers.get 8080 Object.empty "/goodbye"
EffectClass.liftEffect $ close $ pure unit
hello ?= "hello"
goodbye ?= "goodbye"
pathSegmentsSpec :: TestHelpers.Test
pathSegmentsSpec = Spec.it "runs the path segments example" do
close <- EffectClass.liftEffect PathSegments.main
foo <- TestHelpers.get 8080 Object.empty "/segment/foo"
somebars <- TestHelpers.get 8080 Object.empty "/some/bars"
EffectClass.liftEffect $ close $ pure unit
foo ?= "foo"
somebars ?= "[\"some\",\"bars\"]"
pathSegmentsSpec =
Spec.it "runs the path segments example" do
close <- EffectClass.liftEffect PathSegments.main
foo <- TestHelpers.get 8080 Object.empty "/segment/foo"
somebars <- TestHelpers.get 8080 Object.empty "/some/bars"
EffectClass.liftEffect $ close $ pure unit
foo ?= "foo"
somebars ?= "[\"some\",\"bars\"]"
postSpec :: TestHelpers.Test
postSpec = Spec.it "runs the post example" do
close <- EffectClass.liftEffect Post.main
response <- TestHelpers.post 8080 Object.empty "/" "test"
EffectClass.liftEffect $ close $ pure unit
response ?= "test"
postSpec =
Spec.it "runs the post example" do
close <- EffectClass.liftEffect Post.main
response <- TestHelpers.post 8080 Object.empty "/" "test"
EffectClass.liftEffect $ close $ pure unit
response ?= "test"
queryParametersSpec :: TestHelpers.Test
queryParametersSpec = Spec.it "runs the query parameters example" do
close <- EffectClass.liftEffect QueryParameters.main
foo <- TestHelpers.get 8080 Object.empty "/?foo"
bar <- TestHelpers.get 8080 Object.empty "/?bar=test"
notbar <- TestHelpers.get 8080 Object.empty "/?bar=nottest"
baz <- TestHelpers.get 8080 Object.empty "/?baz=test"
EffectClass.liftEffect $ close $ pure unit
foo ?= "foo"
bar ?= "bar"
notbar ?= ""
baz ?= "test"
queryParametersSpec =
Spec.it "runs the query parameters example" do
close <- EffectClass.liftEffect QueryParameters.main
foo <- TestHelpers.get 8080 Object.empty "/?foo"
bar <- TestHelpers.get 8080 Object.empty "/?bar=test"
notbar <- TestHelpers.get 8080 Object.empty "/?bar=nottest"
baz <- TestHelpers.get 8080 Object.empty "/?baz=test"
EffectClass.liftEffect $ close $ pure unit
foo ?= "foo"
bar ?= "bar"
notbar ?= ""
baz ?= "test"
sslSpec :: TestHelpers.Test
sslSpec = Spec.it "runs the ssl example" do
close <- EffectClass.liftEffect SSL.main
response <- TestHelpers.get' 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello world!"
sslSpec =
Spec.it "runs the ssl example" do
close <- EffectClass.liftEffect SSL.main
response <- TestHelpers.get' 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
response ?= "hello world!"
integrationSpec :: TestHelpers.Test
integrationSpec = Spec.describe "Integration" do
asyncResponseSpec
binarySpec
chunkedSpec
customStackSpec
headersSpec
helloWorldSpec
middlewareSpec
multiRouteSpec
pathSegmentsSpec
postSpec
queryParametersSpec
sslSpec
integrationSpec =
Spec.describe "Integration" do
asyncResponseSpec
binarySpec
chunkedSpec
customStackSpec
headersSpec
helloWorldSpec
middlewareSpec
multiRouteSpec
pathSegmentsSpec
postSpec
queryParametersSpec
sslSpec

76
test/Test/HTTPure/LookupSpec.purs
View File

@ -1,56 +1,56 @@
module Test.HTTPure.LookupSpec where
import Prelude
import Data.Maybe as Maybe
import Foreign.Object as Object
import Test.Spec as Spec
import HTTPure.Lookup ((!!), (!@), (!?))
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
atSpec :: TestHelpers.Test
atSpec = Spec.describe "at" do
Spec.describe "when the lookup returns a Just" do
Spec.it "is the value inside the Just" do
[ "one", "two", "three" ] !@ 1 ?= "two"
Spec.describe "when the lookup returns a Nothing" do
Spec.it "is mempty" do
[ "one", "two", "three" ] !@ 4 ?= ""
atSpec =
Spec.describe "at" do
Spec.describe "when the lookup returns a Just" do
Spec.it "is the value inside the Just" do
[ "one", "two", "three" ] !@ 1 ?= "two"
Spec.describe "when the lookup returns a Nothing" do
Spec.it "is mempty" do
[ "one", "two", "three" ] !@ 4 ?= ""
hasSpec :: TestHelpers.Test
hasSpec = Spec.describe "has" do
Spec.describe "when the lookup returns a Just" do
Spec.it "is true" do
[ "one", "two", "three" ] !? 1 ?= true
Spec.describe "when the lookup returns a Nothing" do
Spec.it "is false" do
[ "one", "two", "three" ] !? 4 ?= false
hasSpec =
Spec.describe "has" do
Spec.describe "when the lookup returns a Just" do
Spec.it "is true" do
[ "one", "two", "three" ] !? 1 ?= true
Spec.describe "when the lookup returns a Nothing" do
Spec.it "is false" do
[ "one", "two", "three" ] !? 4 ?= false
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
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"
mockMap = Object.singleton "foo" "bar"
lookupSpec :: TestHelpers.Test
lookupSpec = Spec.describe "Lookup" do
atSpec
hasSpec
lookupFunctionSpec
lookupSpec =
Spec.describe "Lookup" do
atSpec
hasSpec
lookupFunctionSpec

78
test/Test/HTTPure/MethodSpec.purs
View File

@ -1,52 +1,52 @@
module Test.HTTPure.MethodSpec where
import Prelude
import Test.Spec as Spec
import HTTPure.Method as Method
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
showSpec :: TestHelpers.Test
showSpec = Spec.describe "show" do
Spec.describe "with a Get" do
Spec.it "is 'Get'" do
show Method.Get ?= "Get"
Spec.describe "with a Post" do
Spec.it "is 'Post'" do
show Method.Post ?= "Post"
Spec.describe "with a Put" do
Spec.it "is 'Put'" do
show Method.Put ?= "Put"
Spec.describe "with a Delete" do
Spec.it "is 'Delete'" do
show Method.Delete ?= "Delete"
Spec.describe "with a Head" do
Spec.it "is 'Head'" do
show Method.Head ?= "Head"
Spec.describe "with a Connect" do
Spec.it "is 'Connect'" do
show Method.Connect ?= "Connect"
Spec.describe "with a Options" do
Spec.it "is 'Options'" do
show Method.Options ?= "Options"
Spec.describe "with a Trace" do
Spec.it "is 'Trace'" do
show Method.Trace ?= "Trace"
Spec.describe "with a Patch" do
Spec.it "is 'Patch'" do
show Method.Patch ?= "Patch"
showSpec =
Spec.describe "show" do
Spec.describe "with a Get" do
Spec.it "is 'Get'" do
show Method.Get ?= "Get"
Spec.describe "with a Post" do
Spec.it "is 'Post'" do
show Method.Post ?= "Post"
Spec.describe "with a Put" do
Spec.it "is 'Put'" do
show Method.Put ?= "Put"
Spec.describe "with a Delete" do
Spec.it "is 'Delete'" do
show Method.Delete ?= "Delete"
Spec.describe "with a Head" do
Spec.it "is 'Head'" do
show Method.Head ?= "Head"
Spec.describe "with a Connect" do
Spec.it "is 'Connect'" do
show Method.Connect ?= "Connect"
Spec.describe "with a Options" do
Spec.it "is 'Options'" do
show Method.Options ?= "Options"
Spec.describe "with a Trace" do
Spec.it "is 'Trace'" do
show Method.Trace ?= "Trace"
Spec.describe "with a Patch" do
Spec.it "is 'Patch'" do
show Method.Patch ?= "Patch"
readSpec :: TestHelpers.Test
readSpec = Spec.describe "read" do
Spec.describe "with a 'GET' Request" do
Spec.it "is Get" do
request <- TestHelpers.mockRequest "" "GET" "" "" []
Method.read request ?= Method.Get
readSpec =
Spec.describe "read" do
Spec.describe "with a 'GET' Request" do
Spec.it "is Get" do
request <- TestHelpers.mockRequest "" "GET" "" "" []
Method.read request ?= Method.Get
methodSpec :: TestHelpers.Test
methodSpec = Spec.describe "Method" do
showSpec
readSpec
methodSpec =
Spec.describe "Method" do
showSpec
readSpec

57
test/Test/HTTPure/PathSpec.purs
View File

@ -1,40 +1,39 @@
module Test.HTTPure.PathSpec where
import Prelude
import Test.Spec as Spec
import HTTPure.Path as Path
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
readSpec :: TestHelpers.Test
readSpec = Spec.describe "read" do
Spec.describe "with a query string" do
Spec.it "is just the path" do
request <- TestHelpers.mockRequest "" "GET" "test/path?blabla" "" []
Path.read request ?= [ "test", "path" ]
Spec.describe "with no query string" do
Spec.it "is the path" do
request <- TestHelpers.mockRequest "" "GET" "test/path" "" []
Path.read request ?= [ "test", "path" ]
Spec.describe "with no segments" do
Spec.it "is an empty array" do
request <- TestHelpers.mockRequest "" "GET" "" "" []
Path.read request ?= []
Spec.describe "with empty segments" do
Spec.it "strips the empty segments" do
request <- TestHelpers.mockRequest "" "GET" "//test//path///?query" "" []
Path.read request ?= [ "test", "path" ]
Spec.describe "with percent encoded segments" do
Spec.it "decodes percent encoding" do
request <- TestHelpers.mockRequest "" "GET" "/test%20path/%2Fthis" "" []
Path.read request ?= [ "test path", "/this" ]
Spec.it "does not decode a plus sign" do
request <- TestHelpers.mockRequest "" "GET" "/test+path/this" "" []
Path.read request ?= [ "test+path", "this" ]
readSpec =
Spec.describe "read" do
Spec.describe "with a query string" do
Spec.it "is just the path" do
request <- TestHelpers.mockRequest "" "GET" "test/path?blabla" "" []
Path.read request ?= [ "test", "path" ]
Spec.describe "with no query string" do
Spec.it "is the path" do
request <- TestHelpers.mockRequest "" "GET" "test/path" "" []
Path.read request ?= [ "test", "path" ]
Spec.describe "with no segments" do
Spec.it "is an empty array" do
request <- TestHelpers.mockRequest "" "GET" "" "" []
Path.read request ?= []
Spec.describe "with empty segments" do
Spec.it "strips the empty segments" do
request <- TestHelpers.mockRequest "" "GET" "//test//path///?query" "" []
Path.read request ?= [ "test", "path" ]
Spec.describe "with percent encoded segments" do
Spec.it "decodes percent encoding" do
request <- TestHelpers.mockRequest "" "GET" "/test%20path/%2Fthis" "" []
Path.read request ?= [ "test path", "/this" ]
Spec.it "does not decode a plus sign" do
request <- TestHelpers.mockRequest "" "GET" "/test+path/this" "" []
Path.read request ?= [ "test+path", "this" ]
pathSpec :: TestHelpers.Test
pathSpec = Spec.describe "Path" do
readSpec
pathSpec =
Spec.describe "Path" do
readSpec

101
test/Test/HTTPure/QuerySpec.purs
View File

@ -1,65 +1,64 @@
module Test.HTTPure.QuerySpec where
import Prelude
import Data.Tuple as Tuple
import Foreign.Object as Object
import Test.Spec as Spec
import HTTPure.Query as Query
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
readSpec :: TestHelpers.Test
readSpec = Spec.describe "read" do
Spec.describe "with no query string" do
Spec.it "is an empty Map" do
req <- TestHelpers.mockRequest "" "" "/test" "" []
Query.read req ?= Object.empty
Spec.describe "with an empty query string" do
Spec.it "is an empty Map" do
req <- TestHelpers.mockRequest "" "" "/test?" "" []
Query.read req ?= Object.empty
Spec.describe "with a query parameter in the query string" do
Spec.it "is a correct Map" do
req <- TestHelpers.mockRequest "" "" "/test?a=b" "" []
Query.read req ?= Object.singleton "a" "b"
Spec.describe "with empty fields in the query string" do
Spec.it "ignores the empty fields" do
req <- TestHelpers.mockRequest "" "" "/test?&&a=b&&" "" []
Query.read req ?= Object.singleton "a" "b"
Spec.describe "with duplicated params" do
Spec.it "takes the last param value" do
req <- TestHelpers.mockRequest "" "" "/test?a=b&a=c" "" []
Query.read req ?= Object.singleton "a" "c"
Spec.describe "with empty params" do
Spec.it "uses '' as the value" do
req <- TestHelpers.mockRequest "" "" "/test?a" "" []
Query.read req ?= Object.singleton "a" ""
Spec.describe "with complex params" do
Spec.it "is the correct Map" do
req <- TestHelpers.mockRequest "" "" "/test?&&a&b=c&b=d&&&e=f&g=&" "" []
Query.read req ?= expectedComplexResult
Spec.describe "with urlencoded params" do
Spec.it "decodes valid keys and values" do
req <- TestHelpers.mockRequest "" "" "/test?foo%20bar=%3Fx%3Dtest" "" []
Query.read req ?= Object.singleton "foo bar" "?x=test"
Spec.it "passes invalid keys and values through" do
req <- TestHelpers.mockRequest "" "" "/test?%%=%C3" "" []
Query.read req ?= Object.singleton "%%" "%C3"
Spec.it "converts + to a space" do
req <- TestHelpers.mockRequest "" "" "/test?foo=bar+baz" "" []
Query.read req ?= Object.singleton "foo" "bar baz"
readSpec =
Spec.describe "read" do
Spec.describe "with no query string" do
Spec.it "is an empty Map" do
req <- TestHelpers.mockRequest "" "" "/test" "" []
Query.read req ?= Object.empty
Spec.describe "with an empty query string" do
Spec.it "is an empty Map" do
req <- TestHelpers.mockRequest "" "" "/test?" "" []
Query.read req ?= Object.empty
Spec.describe "with a query parameter in the query string" do
Spec.it "is a correct Map" do
req <- TestHelpers.mockRequest "" "" "/test?a=b" "" []
Query.read req ?= Object.singleton "a" "b"
Spec.describe "with empty fields in the query string" do
Spec.it "ignores the empty fields" do
req <- TestHelpers.mockRequest "" "" "/test?&&a=b&&" "" []
Query.read req ?= Object.singleton "a" "b"
Spec.describe "with duplicated params" do
Spec.it "takes the last param value" do
req <- TestHelpers.mockRequest "" "" "/test?a=b&a=c" "" []
Query.read req ?= Object.singleton "a" "c"
Spec.describe "with empty params" do
Spec.it "uses '' as the value" do
req <- TestHelpers.mockRequest "" "" "/test?a" "" []
Query.read req ?= Object.singleton "a" ""
Spec.describe "with complex params" do
Spec.it "is the correct Map" do
req <- TestHelpers.mockRequest "" "" "/test?&&a&b=c&b=d&&&e=f&g=&" "" []
Query.read req ?= expectedComplexResult
Spec.describe "with urlencoded params" do
Spec.it "decodes valid keys and values" do
req <- TestHelpers.mockRequest "" "" "/test?foo%20bar=%3Fx%3Dtest" "" []
Query.read req ?= Object.singleton "foo bar" "?x=test"
Spec.it "passes invalid keys and values through" do
req <- TestHelpers.mockRequest "" "" "/test?%%=%C3" "" []
Query.read req ?= Object.singleton "%%" "%C3"
Spec.it "converts + to a space" do
req <- TestHelpers.mockRequest "" "" "/test?foo=bar+baz" "" []
Query.read req ?= Object.singleton "foo" "bar baz"
where
expectedComplexResult =
Object.fromFoldable
[ Tuple.Tuple "a" ""
, Tuple.Tuple "b" "d"
, Tuple.Tuple "e" "f"
, Tuple.Tuple "g" ""
]
expectedComplexResult =
Object.fromFoldable
[ Tuple.Tuple "a" ""
, Tuple.Tuple "b" "d"
, Tuple.Tuple "e" "f"
, Tuple.Tuple "g" ""
]
querySpec :: TestHelpers.Test
querySpec = Spec.describe "Query" do
readSpec
querySpec =
Spec.describe "Query" do
readSpec

122
test/Test/HTTPure/RequestSpec.purs
View File

@ -1,80 +1,82 @@
module Test.HTTPure.RequestSpec where
import Prelude
import Data.Tuple as Tuple
import Foreign.Object as Object
import Test.Spec as Spec
import HTTPure.Headers as Headers
import HTTPure.Method as Method
import HTTPure.Request as Request
import HTTPure.Version as Version
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
fromHTTPRequestSpec :: TestHelpers.Test
fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
Spec.it "contains the correct method" do
mock <- mockRequest
mock.method ?= Method.Post
Spec.it "contains the correct path" do
mock <- mockRequest
mock.path ?= [ "test" ]
Spec.it "contains the correct query" do
mock <- mockRequest
mock.query ?= Object.singleton "a" "b"
Spec.it "contains the correct headers" do
mock <- mockRequest
mock.headers ?= Headers.headers mockHeaders
Spec.it "contains the correct body" do
mock <- mockRequest
mock.body ?= "body"
Spec.it "contains the correct httpVersion" do
mock <- mockRequest
mock.httpVersion ?= Version.HTTP1_1
fromHTTPRequestSpec =
Spec.describe "fromHTTPRequest" do
Spec.it "contains the correct method" do
mock <- mockRequest
mock.method ?= Method.Post
Spec.it "contains the correct path" do
mock <- mockRequest
mock.path ?= [ "test" ]
Spec.it "contains the correct query" do
mock <- mockRequest
mock.query ?= Object.singleton "a" "b"
Spec.it "contains the correct headers" do
mock <- mockRequest
mock.headers ?= Headers.headers mockHeaders
Spec.it "contains the correct body" do
mock <- mockRequest
mock.body ?= "body"
Spec.it "contains the correct httpVersion" do
mock <- mockRequest
mock.httpVersion ?= Version.HTTP1_1
where
mockHeaders = [ Tuple.Tuple "Test" "test" ]
mockHTTPRequest =
TestHelpers.mockRequest "1.1" "POST" "/test?a=b" "body" mockHeaders
mockRequest = mockHTTPRequest >>= Request.fromHTTPRequest
mockHeaders = [ Tuple.Tuple "Test" "test" ]
mockHTTPRequest = TestHelpers.mockRequest "1.1" "POST" "/test?a=b" "body" mockHeaders
mockRequest = mockHTTPRequest >>= Request.fromHTTPRequest
fullPathSpec :: TestHelpers.Test
fullPathSpec = Spec.describe "fullPath" do
Spec.describe "without query parameters" do
Spec.it "is correct" do
mock <- mockRequest "/foo/bar"
Request.fullPath mock ?= "/foo/bar"
Spec.describe "with empty path segments" do
Spec.it "strips the empty segments" do
mock <- mockRequest "//foo////bar/"
Request.fullPath mock ?= "/foo/bar"
Spec.describe "with only query parameters" do
Spec.it "is correct" do
mock <- mockRequest "?a=b&c=d"
Request.fullPath mock ?= "/?a=b&c=d"
Spec.describe "with only empty query parameters" do
Spec.it "is has the default value of '' for the empty parameters" do
mock <- mockRequest "?a"
Request.fullPath mock ?= "/?a="
Spec.describe "with query parameters that have special characters" do
Spec.it "percent encodes query params" do
mock <- mockRequest "?a=%3Fx%3Dtest"
Request.fullPath mock ?= "/?a=%3Fx%3Dtest"
Spec.describe "with empty query parameters" do
Spec.it "strips out the empty arameters" do
mock <- mockRequest "?a=b&&&"
Request.fullPath mock ?= "/?a=b"
Spec.describe "with a mix of segments and query parameters" do
Spec.it "is correct" do
mock <- mockRequest "/foo///bar/?&a=b&&c"
Request.fullPath mock ?= "/foo/bar?a=b&c="
fullPathSpec =
Spec.describe "fullPath" do
Spec.describe "without query parameters" do
Spec.it "is correct" do
mock <- mockRequest "/foo/bar"
Request.fullPath mock ?= "/foo/bar"
Spec.describe "with empty path segments" do
Spec.it "strips the empty segments" do
mock <- mockRequest "//foo////bar/"
Request.fullPath mock ?= "/foo/bar"
Spec.describe "with only query parameters" do
Spec.it "is correct" do
mock <- mockRequest "?a=b&c=d"
Request.fullPath mock ?= "/?a=b&c=d"
Spec.describe "with only empty query parameters" do
Spec.it "is has the default value of '' for the empty parameters" do
mock <- mockRequest "?a"
Request.fullPath mock ?= "/?a="
Spec.describe "with query parameters that have special characters" do
Spec.it "percent encodes query params" do
mock <- mockRequest "?a=%3Fx%3Dtest"
Request.fullPath mock ?= "/?a=%3Fx%3Dtest"
Spec.describe "with empty query parameters" do
Spec.it "strips out the empty arameters" do
mock <- mockRequest "?a=b&&&"
Request.fullPath mock ?= "/?a=b"
Spec.describe "with a mix of segments and query parameters" do
Spec.it "is correct" do
mock <- mockRequest "/foo///bar/?&a=b&&c"
Request.fullPath mock ?= "/foo/bar?a=b&c="
where
mockHTTPRequest path = TestHelpers.mockRequest "" "POST" path "body" []
mockRequest path = mockHTTPRequest path >>= Request.fromHTTPRequest
mockHTTPRequest path = TestHelpers.mockRequest "" "POST" path "body" []
mockRequest path = mockHTTPRequest path >>= Request.fromHTTPRequest
requestSpec :: TestHelpers.Test
requestSpec = Spec.describe "Request" do
fromHTTPRequestSpec
fullPathSpec
requestSpec =
Spec.describe "Request" do
fromHTTPRequestSpec
fullPathSpec

206
test/Test/HTTPure/ResponseSpec.purs
View File

@ -1,7 +1,6 @@
module Test.HTTPure.ResponseSpec where
import Prelude
import Data.Either as Either
import Effect.Aff as Aff
import Effect.Class as EffectClass
@ -9,125 +8,134 @@ import Node.Encoding as Encoding
import Node.HTTP as HTTP
import Node.Stream as Stream
import Test.Spec as Spec
import HTTPure.Body as Body
import HTTPure.Headers as Headers
import HTTPure.Response as Response
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
sendSpec :: TestHelpers.Test
sendSpec = Spec.describe "send" do
Spec.it "writes the headers" do
header <- do
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseHeader "Test" httpResponse
header ?= "test"
Spec.it "writes the status" do
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 <- do
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseBody httpResponse
body ?= "test"
sendSpec =
Spec.describe "send" do
Spec.it "writes the headers" do
header <- do
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseHeader "Test" httpResponse
header ?= "test"
Spec.it "writes the status" do
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 <- do
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
Response.send httpResponse $ mockResponse unit
pure $ TestHelpers.getResponseBody httpResponse
body ?= "test"
where
mockHeaders = Headers.header "Test" "test"
mockResponse _ =
{ status: 123
, headers: mockHeaders
, 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
}
mockHeaders = Headers.header "Test" "test"
mockResponse _ =
{ status: 123
, headers: mockHeaders
, 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
}
responseFunctionSpec :: TestHelpers.Test
responseFunctionSpec = Spec.describe "response" do
Spec.it "has the right status" do
resp <- Response.response 123 "test"
resp.status ?= 123
Spec.it "has only default headers" do
resp <- Response.response 123 "test"
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders "test"
resp.headers ?= defaultHeaders
Spec.it "has the right writeBody function" do
body <- do
responseFunctionSpec =
Spec.describe "response" do
Spec.it "has the right status" do
resp <- Response.response 123 "test"
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= "test"
resp.status ?= 123
Spec.it "has only default headers" do
resp <- Response.response 123 "test"
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders "test"
resp.headers ?= defaultHeaders
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
Spec.it "has the right status" do
resp <- mockResponse
resp.status ?= 123
Spec.it "has the right headers" do
resp <- mockResponse
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders "test"
resp.headers ?= defaultHeaders <> mockHeaders
Spec.it "has the right writeBody function" do
body <- do
response'Spec =
Spec.describe "response'" do
Spec.it "has the right status" do
resp <- mockResponse
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= "test"
resp.status ?= 123
Spec.it "has the right headers" do
resp <- mockResponse
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders "test"
resp.headers ?= defaultHeaders <> mockHeaders
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"
mockHeaders = Headers.header "Test" "test"
mockResponse = Response.response' 123 mockHeaders "test"
emptyResponseSpec :: TestHelpers.Test
emptyResponseSpec = Spec.describe "emptyResponse" do
Spec.it "has the right status" do
resp <- Response.emptyResponse 123
resp.status ?= 123
Spec.it "has only default headers" do
resp <- Response.emptyResponse 123
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders ""
resp.headers ?= defaultHeaders
Spec.it "has the right writeBody function" do
body <- do
emptyResponseSpec =
Spec.describe "emptyResponse" do
Spec.it "has the right status" do
resp <- Response.emptyResponse 123
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= ""
resp.status ?= 123
Spec.it "has only default headers" do
resp <- Response.emptyResponse 123
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders ""
resp.headers ?= defaultHeaders
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
Spec.it "has the right status" do
resp <- mockResponse
resp.status ?= 123
Spec.it "has the right headers" do
resp <- mockResponse
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders ""
resp.headers ?= mockHeaders <> defaultHeaders
Spec.it "has the right writeBody function" do
body <- do
emptyResponse'Spec =
Spec.describe "emptyResponse'" do
Spec.it "has the right status" do
resp <- mockResponse
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
resp.writeBody httpResponse
pure $ TestHelpers.getResponseBody httpResponse
body ?= ""
resp.status ?= 123
Spec.it "has the right headers" do
resp <- mockResponse
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders ""
resp.headers ?= mockHeaders <> defaultHeaders
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
mockHeaders = Headers.header "Test" "test"
mockResponse = Response.emptyResponse' 123 mockHeaders
responseSpec :: TestHelpers.Test
responseSpec = Spec.describe "Response" do
sendSpec
responseFunctionSpec
response'Spec
emptyResponseSpec
emptyResponse'Spec
responseSpec =
Spec.describe "Response" do
sendSpec
responseFunctionSpec
response'Spec
emptyResponseSpec
emptyResponse'Spec

128
test/Test/HTTPure/ServerSpec.purs
View File

@ -1,7 +1,6 @@
module Test.HTTPure.ServerSpec where
import Prelude
import Effect.Class as EffectClass
import Effect.Exception as Exception
import Control.Monad.Except as Except
@ -14,11 +13,9 @@ import Node.HTTP.Secure as HTTPS
import Node.FS.Sync as FSSync
import Test.Spec as Spec
import Test.Spec.Assertions as Assertions
import HTTPure.Request as Request
import HTTPure.Response as Response
import HTTPure.Server as Server
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
@ -29,69 +26,84 @@ errorRouter :: Request.Request -> Response.ResponseM
errorRouter _ = Except.throwError $ Exception.error "fail!"
serveSpec :: TestHelpers.Test
serveSpec = Spec.describe "serve" do
Spec.it "boots a server on the given port" do
close <- EffectClass.liftEffect $ Server.serve 8080 mockRouter $ pure unit
out <- TestHelpers.get 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
Spec.it "responds with a 500 upon unhandled exceptions" do
close <- EffectClass.liftEffect $ Server.serve 8080 errorRouter $ pure unit
status <- TestHelpers.getStatus 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
status ?= 500
serveSpec =
Spec.describe "serve" do
Spec.it "boots a server on the given port" do
close <- EffectClass.liftEffect $ Server.serve 8080 mockRouter $ pure unit
out <- TestHelpers.get 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
Spec.it "responds with a 500 upon unhandled exceptions" do
close <- EffectClass.liftEffect $ Server.serve 8080 errorRouter $ pure unit
status <- TestHelpers.getStatus 8080 Object.empty "/"
EffectClass.liftEffect $ close $ pure unit
status ?= 500
serve'Spec :: TestHelpers.Test
serve'Spec = Spec.describe "serve'" do
Spec.it "boots a server with the given options" do
close <- EffectClass.liftEffect $
Server.serve' options mockRouter $ pure unit
out <- TestHelpers.get 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
serve'Spec =
Spec.describe "serve'" do
Spec.it "boots a server with the given options" do
close <-
EffectClass.liftEffect
$ Server.serve' options mockRouter
$ pure unit
out <- TestHelpers.get 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
where
options = { hostname: "localhost", port: 8080, backlog: Maybe.Nothing }
options = { hostname: "localhost", port: 8080, backlog: Maybe.Nothing }
serveSecureSpec :: TestHelpers.Test
serveSecureSpec = Spec.describe "serveSecure" do
Spec.describe "with valid key and cert files" do
Spec.it "boots a server on the given port" do
close <- EffectClass.liftEffect $
Server.serveSecure 8080 cert key mockRouter $ pure unit
out <- TestHelpers.get' 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
Spec.describe "with invalid key and cert files" do
Spec.it "throws" do
Assertions.expectError $ EffectClass.liftEffect $
Server.serveSecure 8080 "" "" mockRouter $ pure unit
serveSecureSpec =
Spec.describe "serveSecure" do
Spec.describe "with valid key and cert files" do
Spec.it "boots a server on the given port" do
close <-
EffectClass.liftEffect
$ Server.serveSecure 8080 cert key mockRouter
$ pure unit
out <- TestHelpers.get' 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
Spec.describe "with invalid key and cert files" do
Spec.it "throws" do
Assertions.expectError $ EffectClass.liftEffect
$ Server.serveSecure 8080 "" "" mockRouter
$ pure unit
where
cert = "./test/Mocks/Certificate.cer"
key = "./test/Mocks/Key.key"
cert = "./test/Mocks/Certificate.cer"
key = "./test/Mocks/Key.key"
serveSecure'Spec :: TestHelpers.Test
serveSecure'Spec = Spec.describe "serveSecure'" do
Spec.describe "with valid key and cert files" do
Spec.it "boots a server on the given port" do
sslOpts <- EffectClass.liftEffect $ sslOptions
close <- EffectClass.liftEffect $
Server.serveSecure' sslOpts (options 8080) mockRouter $ pure unit
out <- TestHelpers.get' 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
serveSecure'Spec =
Spec.describe "serveSecure'" do
Spec.describe "with valid key and cert files" do
Spec.it "boots a server on the given port" do
sslOpts <- EffectClass.liftEffect $ sslOptions
close <-
EffectClass.liftEffect
$ Server.serveSecure' sslOpts (options 8080) mockRouter
$ pure unit
out <- TestHelpers.get' 8080 Object.empty "/test"
EffectClass.liftEffect $ close $ pure unit
out ?= "/test"
where
options port = { hostname: "localhost", port, backlog: Maybe.Nothing }
sslOptions = do
cert <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Certificate.cer"
key <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Key.key"
pure $
HTTPS.key := HTTPS.keyString key <>
HTTPS.cert := HTTPS.certString cert
options port = { hostname: "localhost", port, backlog: Maybe.Nothing }
sslOptions = do
cert <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Certificate.cer"
key <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Key.key"
pure
$ HTTPS.key
:= HTTPS.keyString key
<> HTTPS.cert
:= HTTPS.certString cert
serverSpec :: TestHelpers.Test
serverSpec = Spec.describe "Server" do
serveSpec
serve'Spec
serveSecureSpec
serveSecure'Spec
serverSpec =
Spec.describe "Server" do
serveSpec
serve'Spec
serveSecureSpec
serveSecure'Spec

24
test/Test/HTTPure/StatusSpec.purs
View File

@ -1,24 +1,24 @@
module Test.HTTPure.StatusSpec where
import Prelude
import Effect.Class as EffectClass
import Test.Spec as Spec
import HTTPure.Status as Status
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
writeSpec :: TestHelpers.Test
writeSpec = Spec.describe "write" do
Spec.it "writes the given status code" do
status <- EffectClass.liftEffect do
mock <- TestHelpers.mockResponse
Status.write mock 123
pure $ TestHelpers.getResponseStatus mock
status ?= 123
writeSpec =
Spec.describe "write" do
Spec.it "writes the given status code" do
status <-
EffectClass.liftEffect do
mock <- TestHelpers.mockResponse
Status.write mock 123
pure $ TestHelpers.getResponseStatus mock
status ?= 123
statusSpec :: TestHelpers.Test
statusSpec = Spec.describe "Status" do
writeSpec
statusSpec =
Spec.describe "Status" do
writeSpec

172
test/Test/HTTPure/TestHelpers.purs
View File

@ -1,7 +1,6 @@
module Test.HTTPure.TestHelpers where
import Prelude
import Effect as Effect
import Effect.Aff as Aff
import Effect.Class as EffectClass
@ -26,47 +25,63 @@ import Unsafe.Coerce as Coerce
infix 1 Assertions.shouldEqual as ?=
-- | The type for integration tests.
type Test = Spec.Spec Unit
type Test
= Spec.Spec Unit
-- | The type for the entire test suite.
type TestSuite = Effect.Effect Unit
type TestSuite
= Effect.Effect Unit
-- | Given a URL, a failure handler, and a success handler, create an HTTP
-- | client request.
request :: Boolean ->
Int ->
String ->
Object.Object String ->
String ->
String ->
Aff.Aff HTTPClient.Response
request secure port method headers path body = Aff.makeAff \done -> do
req <- HTTPClient.request options $ Either.Right >>> done
let stream = HTTPClient.requestAsStream req
_ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
Stream.end stream $ pure unit
pure Aff.nonCanceler
request ::
Boolean ->
Int ->
String ->
Object.Object String ->
String ->
String ->
Aff.Aff HTTPClient.Response
request secure port method headers path body =
Aff.makeAff \done -> do
req <- HTTPClient.request options $ Either.Right >>> done
let
stream = HTTPClient.requestAsStream req
_ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
Stream.end stream $ pure unit
pure Aff.nonCanceler
where
options =
HTTPClient.protocol := (if secure then "https:" else "http:") <>
HTTPClient.method := method <>
HTTPClient.hostname := "localhost" <>
HTTPClient.port := port <>
HTTPClient.path := path <>
HTTPClient.headers := HTTPClient.RequestHeaders headers <>
HTTPClient.rejectUnauthorized := false
options =
HTTPClient.protocol := (if secure then "https:" else "http:")
<> HTTPClient.method
:= method
<> HTTPClient.hostname
:= "localhost"
<> HTTPClient.port
:= port
<> HTTPClient.path
:= path
<> HTTPClient.headers
:= HTTPClient.RequestHeaders headers
<> HTTPClient.rejectUnauthorized
:= false
-- | 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
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
@ -76,35 +91,38 @@ toString resp = do
-- | Run an HTTP GET with the given url and return an Aff that contains the
-- | string with the response body.
get :: Int ->
Object.Object String ->
String ->
Aff.Aff String
get ::
Int ->
Object.Object String ->
String ->
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
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 ->
Object.Object String ->
String ->
Aff.Aff String
get' ::
Int ->
Object.Object String ->
String ->
Aff.Aff String
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.
post :: Int ->
Object.Object String ->
String ->
String ->
Aff.Aff String
post ::
Int ->
Object.Object String ->
String ->
String ->
Aff.Aff String
post port headers path = request false port "POST" headers path >=> toString
-- | Convert a request to an Aff containing the string with the given header
@ -112,25 +130,26 @@ post port headers path = request false port "POST" headers path >=> toString
extractHeader :: String -> HTTPClient.Response -> String
extractHeader header = unmaybe <<< lookup <<< HTTPClient.responseHeaders
where
unmaybe = Maybe.fromMaybe ""
lookup = Object.lookup $ StringUtil.toLower header
unmaybe = Maybe.fromMaybe ""
lookup = Object.lookup $ StringUtil.toLower header
-- | Run an HTTP GET with the given url and return an Aff that contains the
-- | string with the header value for the given header.
getHeader :: Int ->
Object.Object String ->
String ->
String ->
Aff.Aff String
getHeader port headers path header =
extractHeader header <$> request false port "GET" headers path ""
getHeader ::
Int ->
Object.Object String ->
String ->
String ->
Aff.Aff String
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 ::
Int ->
Object.Object String ->
String ->
Aff.Aff Int
getStatus port headers path = HTTPClient.statusCode <$> request false port "GET" headers path ""
-- | Mock an HTTP Request object
foreign import mockRequestImpl ::
@ -142,14 +161,14 @@ foreign import mockRequestImpl ::
Effect.Effect HTTP.Request
-- | Mock an HTTP Request object
mockRequest :: String ->
String ->
String ->
String ->
Array (Tuple.Tuple String String) ->
Aff.Aff HTTP.Request
mockRequest httpVersion method url body =
EffectClass.liftEffect <<< mockRequestImpl httpVersion method url body <<< Object.fromFoldable
mockRequest ::
String ->
String ->
String ->
String ->
Array (Tuple.Tuple String String) ->
Aff.Aff HTTP.Request
mockRequest httpVersion method url body = EffectClass.liftEffect <<< mockRequestImpl httpVersion method url body <<< Object.fromFoldable
-- | Mock an HTTP Response object
foreign import mockResponse :: Effect.Effect HTTP.Response
@ -169,8 +188,7 @@ getResponseHeaders = Coerce.unsafeCoerce <<< _.headers <<< Coerce.unsafeCoerce
-- | Get the current value for the header on the HTTP Response object.
getResponseHeader :: String -> HTTP.Response -> String
getResponseHeader header =
Maybe.fromMaybe "" <<< Object.lookup header <<< getResponseHeaders
getResponseHeader header = Maybe.fromMaybe "" <<< Object.lookup header <<< getResponseHeaders
-- | Create a stream out of a string.
foreign import stringToStream :: String -> Stream.Readable ()

12
test/Test/HTTPure/UtilsSpec.purs
View File

@ -1,19 +1,17 @@
module Test.HTTPure.UtilsSpec where
import Prelude
import Data.Tuple as Tuple
import Foreign.Object as Object
import Test.Spec as Spec
import HTTPure.Query as Query
import HTTPure.Utils as Utils
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
utilsSpec :: TestHelpers.Test
utilsSpec = Spec.describe "replacePlus" do
Spec.it "should replace all pluses" do
Utils.replacePlus "HTTPPure+is+A+purescript+HTTP+server+framework" ?=
"HTTPPure%20is%20A%20purescript%20HTTP%20server%20framework"
utilsSpec =
Spec.describe "replacePlus" do
Spec.it "should replace all pluses" do
Utils.replacePlus "HTTPPure+is+A+purescript+HTTP+server+framework"
?= "HTTPPure%20is%20A%20purescript%20HTTP%20server%20framework"

100
test/Test/HTTPure/VersionSpec.purs
View File

@ -1,63 +1,63 @@
module Test.HTTPure.VersionSpec where
import Prelude
import Test.Spec as Spec
import HTTPure.Version as Version
import Test.HTTPure.TestHelpers as TestHelpers
import Test.HTTPure.TestHelpers ((?=))
showSpec :: TestHelpers.Test
showSpec = Spec.describe "show" do
Spec.describe "with an HTTP0_9" do
Spec.it "is 'HTTP0_9'" do
show Version.HTTP0_9 ?= "HTTP/0.9"
Spec.describe "with an HTTP1_0" do
Spec.it "is 'HTTP1_0'" do
show Version.HTTP1_0 ?= "HTTP/1.0"
Spec.describe "with an HTTP1_1" do
Spec.it "is 'HTTP1_1'" do
show Version.HTTP1_1 ?= "HTTP/1.1"
Spec.describe "with an HTTP2_0" do
Spec.it "is 'HTTP2_0'" do
show Version.HTTP2_0 ?= "HTTP/2.0"
Spec.describe "with an HTTP3_0" do
Spec.it "is 'HTTP3_0'" do
show Version.HTTP3_0 ?= "HTTP/3.0"
Spec.describe "with an Other" do
Spec.it "is 'Other'" do
show (Version.Other "version") ?= "HTTP/version"
showSpec =
Spec.describe "show" do
Spec.describe "with an HTTP0_9" do
Spec.it "is 'HTTP0_9'" do
show Version.HTTP0_9 ?= "HTTP/0.9"
Spec.describe "with an HTTP1_0" do
Spec.it "is 'HTTP1_0'" do
show Version.HTTP1_0 ?= "HTTP/1.0"
Spec.describe "with an HTTP1_1" do
Spec.it "is 'HTTP1_1'" do
show Version.HTTP1_1 ?= "HTTP/1.1"
Spec.describe "with an HTTP2_0" do
Spec.it "is 'HTTP2_0'" do
show Version.HTTP2_0 ?= "HTTP/2.0"
Spec.describe "with an HTTP3_0" do
Spec.it "is 'HTTP3_0'" do
show Version.HTTP3_0 ?= "HTTP/3.0"
Spec.describe "with an Other" do
Spec.it "is 'Other'" do
show (Version.Other "version") ?= "HTTP/version"
readSpec :: TestHelpers.Test
readSpec = Spec.describe "read" do
Spec.describe "with an 'HTTP0_9' Request" do
Spec.it "is HTTP0_9" do
request <- TestHelpers.mockRequest "0.9" "" "" "" []
Version.read request ?= Version.HTTP0_9
Spec.describe "with an 'HTTP1_0' Request" do
Spec.it "is HTTP1_0" do
request <- TestHelpers.mockRequest "1.0" "" "" "" []
Version.read request ?= Version.HTTP1_0
Spec.describe "with an 'HTTP1_1' Request" do
Spec.it "is HTTP1_1" do
request <- TestHelpers.mockRequest "1.1" "" "" "" []
Version.read request ?= Version.HTTP1_1
Spec.describe "with an 'HTTP2_0' Request" do
Spec.it "is HTTP2_0" do
request <- TestHelpers.mockRequest "2.0" "" "" "" []
Version.read request ?= Version.HTTP2_0
Spec.describe "with an 'HTTP3_0' Request" do
Spec.it "is HTTP3_0" do
request <- TestHelpers.mockRequest "3.0" "" "" "" []
Version.read request ?= Version.HTTP3_0
Spec.describe "with an 'Other' Request" do
Spec.it "is Other" do
request <- TestHelpers.mockRequest "version" "" "" "" []
Version.read request ?= Version.Other "version"
readSpec =
Spec.describe "read" do
Spec.describe "with an 'HTTP0_9' Request" do
Spec.it "is HTTP0_9" do
request <- TestHelpers.mockRequest "0.9" "" "" "" []
Version.read request ?= Version.HTTP0_9
Spec.describe "with an 'HTTP1_0' Request" do
Spec.it "is HTTP1_0" do
request <- TestHelpers.mockRequest "1.0" "" "" "" []
Version.read request ?= Version.HTTP1_0
Spec.describe "with an 'HTTP1_1' Request" do
Spec.it "is HTTP1_1" do
request <- TestHelpers.mockRequest "1.1" "" "" "" []
Version.read request ?= Version.HTTP1_1
Spec.describe "with an 'HTTP2_0' Request" do
Spec.it "is HTTP2_0" do
request <- TestHelpers.mockRequest "2.0" "" "" "" []
Version.read request ?= Version.HTTP2_0
Spec.describe "with an 'HTTP3_0' Request" do
Spec.it "is HTTP3_0" do
request <- TestHelpers.mockRequest "3.0" "" "" "" []
Version.read request ?= Version.HTTP3_0
Spec.describe "with an 'Other' Request" do
Spec.it "is Other" do
request <- TestHelpers.mockRequest "version" "" "" "" []
Version.read request ?= Version.Other "version"
versionSpec :: TestHelpers.Test
versionSpec = Spec.describe "Version" do
showSpec
readSpec
versionSpec =
Spec.describe "Version" do
showSpec
readSpec

33
test/Test/Main.purs
View File

@ -1,12 +1,10 @@
module Test.Main where
import Prelude
import Effect.Aff as Aff
import Test.Spec as Spec
import Test.Spec.Reporter as Reporter
import Test.Spec.Runner as Runner
import Test.HTTPure.BodySpec as BodySpec
import Test.HTTPure.HeadersSpec as HeadersSpec
import Test.HTTPure.LookupSpec as LookupSpec
@ -20,21 +18,22 @@ import Test.HTTPure.StatusSpec as StatusSpec
import Test.HTTPure.UtilsSpec as UtilsSpec
import Test.HTTPure.VersionSpec as VersionSpec
import Test.HTTPure.IntegrationSpec as IntegrationSpec
import Test.HTTPure.TestHelpers as TestHelpers
main :: TestHelpers.TestSuite
main = Aff.launchAff_ $ Runner.runSpec [ Reporter.specReporter ] $ Spec.describe "HTTPure" do
BodySpec.bodySpec
HeadersSpec.headersSpec
LookupSpec.lookupSpec
MethodSpec.methodSpec
PathSpec.pathSpec
QuerySpec.querySpec
RequestSpec.requestSpec
ResponseSpec.responseSpec
ServerSpec.serverSpec
StatusSpec.statusSpec
UtilsSpec.utilsSpec
VersionSpec.versionSpec
IntegrationSpec.integrationSpec
main =
Aff.launchAff_ $ Runner.runSpec [ Reporter.specReporter ]
$ Spec.describe "HTTPure" do
BodySpec.bodySpec
HeadersSpec.headersSpec
LookupSpec.lookupSpec
MethodSpec.methodSpec
PathSpec.pathSpec
QuerySpec.querySpec
RequestSpec.requestSpec
ResponseSpec.responseSpec
ServerSpec.serverSpec
StatusSpec.statusSpec
UtilsSpec.utilsSpec
VersionSpec.versionSpec
IntegrationSpec.integrationSpec

5
yarn.lock
View File

@ -945,6 +945,11 @@ purescript-psa@^0.8.2:
resolved "https://registry.yarnpkg.com/purescript-psa/-/purescript-psa-0.8.2.tgz#ee20c40f02cd0c5ed6dd3dd93ef02d9c466f17bc"
integrity sha512-4Olf0aQQrNCfcDLXQI3gJgINEQ+3U+4QPLmQ2LHX2L/YOXSwM7fOGIUs/wMm/FQnwERUyQmHKQTJKB4LIjE2fg==
purty@^7.0.0:
version "7.0.0"
resolved "https://registry.yarnpkg.com/purty/-/purty-7.0.0.tgz#3a714a2155f543118c6831e1fb41b84d17de2b59"
integrity sha512-gHHghPEjRY39GUJ8KnOMRfPArJILGCXwEhX6BmEdNiLgZuCjLLBLyawGiKFjYMfy8H5Dsk5NbgwIGslrPrernA==
querystring-es3@~0.2.0:
version "0.2.1"
resolved "https://registry.yarnpkg.com/querystring-es3/-/querystring-es3-0.2.1.tgz#9ec61f79049875707d69414596fd907a4d711e73"