├── .envrc ├── docs ├── Examples │ ├── AsyncResponse │ │ ├── Hello │ │ ├── Readme.md │ │ └── Main.purs │ ├── BinaryResponse │ │ ├── circle.png │ │ ├── Readme.md │ │ └── Main.purs │ ├── BinaryRequest │ │ ├── Main.js │ │ ├── Readme.md │ │ └── Main.purs │ ├── HelloWorld │ │ ├── Readme.md │ │ └── Main.purs │ ├── Post │ │ ├── Readme.md │ │ └── Main.purs │ ├── Chunked │ │ ├── Readme.md │ │ └── Main.purs │ ├── CustomStack │ │ ├── Readme.md │ │ └── Main.purs │ ├── SSL │ │ ├── Readme.md │ │ ├── Main.purs │ │ ├── Certificate.cer │ │ └── Key.key │ ├── MultiRoute │ │ ├── Readme.md │ │ └── Main.purs │ ├── PathSegments │ │ ├── Readme.md │ │ └── Main.purs │ ├── QueryParameters │ │ ├── Readme.md │ │ └── Main.purs │ ├── Middleware │ │ ├── Readme.md │ │ └── Main.purs │ ├── MultiHeaders │ │ ├── Readme.md │ │ └── Main.purs │ └── Headers │ │ ├── Readme.md │ │ └── Main.purs ├── Basics.md ├── Responses.md ├── Middleware.md └── Routing.md ├── .gitignore ├── .tidyrc.json ├── packages.dhall ├── sources.nix ├── test.dhall ├── test ├── Test │ ├── HTTPure │ │ ├── UtilsSpec.purs │ │ ├── StatusSpec.purs │ │ ├── TestHelpers.js │ │ ├── PathSpec.purs │ │ ├── MethodSpec.purs │ │ ├── LookupSpec.purs │ │ ├── VersionSpec.purs │ │ ├── QuerySpec.purs │ │ ├── RequestSpec.purs │ │ ├── ServerSpec.purs │ │ ├── BodySpec.purs │ │ ├── ResponseSpec.purs │ │ ├── HeadersSpec.purs │ │ ├── IntegrationSpec.purs │ │ ├── MultiHeadersSpec.purs │ │ └── TestHelpers.purs │ └── Main.purs └── Mocks │ ├── Certificate.cer │ └── Key.key ├── src ├── HTTPure │ ├── MultiHeaders.js │ ├── Utils.purs │ ├── Path.purs │ ├── Method.purs │ ├── Version.purs │ ├── Query.purs │ ├── Request.purs │ ├── Lookup.purs │ ├── Headers.purs │ ├── Server.purs │ ├── Body.purs │ ├── MultiHeaders.purs │ ├── Status.purs │ └── Response.purs └── HTTPure.purs ├── spago.dhall ├── Releasing.md ├── License ├── bower.json ├── sources.json ├── .github └── workflows │ └── check.yaml ├── Contributing.md ├── shell.nix ├── Readme.md └── History.md /.envrc: -------------------------------------------------------------------------------- 1 | eval "$(lorri direnv)" 2 | -------------------------------------------------------------------------------- /docs/Examples/AsyncResponse/Hello: -------------------------------------------------------------------------------- 1 | hello world! -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.psci_modules 2 | /.spago/ 3 | /generated-docs 4 | /output 5 | /bower_components 6 | /.psc-ide-port 7 | /.psa-stash 8 | -------------------------------------------------------------------------------- /docs/Examples/BinaryResponse/circle.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/citizennet/purescript-httpure/HEAD/docs/Examples/BinaryResponse/circle.png -------------------------------------------------------------------------------- /docs/Examples/BinaryRequest/Main.js: -------------------------------------------------------------------------------- 1 | import crypto from 'crypto'; 2 | 3 | export const sha256sum = buffer => 4 | crypto.createHash('sha256').update(buffer).digest('hex'); 5 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importSort": "ide", 3 | "importWrap": "source", 4 | "indent": 2, 5 | "operatorsFile": null, 6 | "ribbon": 1, 7 | "typeArrowPlacement": "last", 8 | "unicode": "never", 9 | "width": null 10 | } 11 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220502/packages.dhall 3 | sha256:38d347aeba9fe6359c208abe87a5cecf1ffb14294f11ad19664ae35c59b6e29a 4 | 5 | in upstream 6 | -------------------------------------------------------------------------------- /sources.nix: -------------------------------------------------------------------------------- 1 | let 2 | nivSrc = fetchTarball { 3 | url = "https://github.com/nmattia/niv/tarball/df49d53b71ad5b6b5847b32e5254924d60703c46"; 4 | sha256 = "1j5p8mi1wi3pdcq0lfb881p97i232si07nb605dl92cjwnira88c"; 5 | }; 6 | in 7 | import "${nivSrc}/nix/sources.nix" { 8 | sourcesFile = ./sources.json; 9 | } 10 | -------------------------------------------------------------------------------- /test.dhall: -------------------------------------------------------------------------------- 1 | let conf = ./spago.dhall 2 | 3 | in conf // { 4 | sources = conf.sources # [ "test/**/*.purs", "docs/Examples/**/*.purs" ], 5 | dependencies = conf.dependencies # [ 6 | , "exceptions" 7 | , "lists" 8 | , "node-child-process" 9 | , "node-fs-aff" 10 | , "spec" 11 | , "transformers" 12 | , "unsafe-coerce" 13 | ] 14 | } 15 | -------------------------------------------------------------------------------- /docs/Examples/HelloWorld/Readme.md: -------------------------------------------------------------------------------- 1 | # Hello World Example 2 | 3 | This is a basic 'hello world' example. It simply returns 'hello world!' when 4 | making any request. 5 | 6 | To run the example server, run: 7 | 8 | ```bash 9 | nix-shell --run 'example HelloWorld' 10 | ``` 11 | 12 | Or, without nix: 13 | 14 | ```bash 15 | spago -x test.dhall run --main Examples.HelloWorld.Main 16 | ``` 17 | -------------------------------------------------------------------------------- /docs/Examples/Post/Readme.md: -------------------------------------------------------------------------------- 1 | # Post Example 2 | 3 | This is a basic example of handling a Post. It will respond to a HTTP POST on 4 | any path with the post body in the response body. 5 | 6 | To run the example server, run: 7 | 8 | ```bash 9 | nix-shell --run 'example Post' 10 | ``` 11 | 12 | Or, without nix: 13 | 14 | ```bash 15 | spago -x test.dhall run --main Examples.Post.Main 16 | ``` 17 | -------------------------------------------------------------------------------- /docs/Examples/BinaryResponse/Readme.md: -------------------------------------------------------------------------------- 1 | # Binary Response Example 2 | 3 | This is a basic example of sending binary response data. It serves an image 4 | file as binary data on any URL. 5 | 6 | To run the server, run: 7 | 8 | ```bash 9 | nix-shell --run 'example BinaryResponse' 10 | ``` 11 | 12 | Or, without nix: 13 | 14 | ```bash 15 | spago -x test.dhall run --main Examples.BinaryResponse.Main 16 | ``` 17 | -------------------------------------------------------------------------------- /docs/Examples/Chunked/Readme.md: -------------------------------------------------------------------------------- 1 | # Chunked Example 2 | 3 | This is a basic example of sending chunked data. It will return 'hello world' 4 | in two separate chunks spaced a second apart on any URL. 5 | 6 | To run the example server, run: 7 | 8 | ```bash 9 | nix-shell --run 'example Chunked' 10 | ``` 11 | 12 | Or, without nix: 13 | 14 | ```bash 15 | spago -x test.dhall run --main Examples.Chunked.Main 16 | ``` 17 | -------------------------------------------------------------------------------- /docs/Examples/BinaryRequest/Readme.md: -------------------------------------------------------------------------------- 1 | # Binary Request Example 2 | 3 | This is a basic example of sending binary request data. It will read in the 4 | binary file and send back the file's sha256 checksum. 5 | 6 | To run the server, run: 7 | 8 | ```bash 9 | nix-shell --run 'example BinaryRequest' 10 | ``` 11 | 12 | Or, without nix: 13 | 14 | ```bash 15 | spago -x test.dhall run --main Examples.BinaryRequest.Main 16 | ``` 17 | -------------------------------------------------------------------------------- /test/Test/HTTPure/UtilsSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.UtilsSpec where 2 | 3 | import HTTPure.Utils (replacePlus) 4 | import Test.HTTPure.TestHelpers (Test, (?=)) 5 | import Test.Spec (describe, it) 6 | 7 | replacePlusSpec :: Test 8 | replacePlusSpec = 9 | describe "replacePlus" do 10 | it "should replace all pluses" do 11 | replacePlus "foo+bar+baz" ?= "foo%20bar%20baz" 12 | 13 | utilsSpec :: Test 14 | utilsSpec = 15 | describe "Utils" do 16 | replacePlusSpec 17 | -------------------------------------------------------------------------------- /docs/Examples/CustomStack/Readme.md: -------------------------------------------------------------------------------- 1 | # CustomStack Example 2 | 3 | This example demonstrates using middleware to introduce a custom monad stack 4 | to your application. Here, we run our router within a `ReaderT` to provide a 5 | globally-available environment during routing. 6 | 7 | To run the example server, run: 8 | 9 | ```bash 10 | nix-shell --run 'example CustomStack' 11 | ``` 12 | 13 | Or, without nix: 14 | 15 | ```bash 16 | spago -x test.dhall run --main Examples.CustomStack.Main 17 | ``` 18 | -------------------------------------------------------------------------------- /docs/Examples/SSL/Readme.md: -------------------------------------------------------------------------------- 1 | # SSL Example 2 | 3 | This is a basic 'hello world' example, that runs over HTTPS. It simply returns 4 | 'hello world!' when making any request. 5 | 6 | Note that it uses self-signed certificates, so you will need to ignore 7 | certificate errors when testing. 8 | 9 | To run the example server, run: 10 | 11 | ```bash 12 | nix-shell --run 'example SSL' 13 | ``` 14 | 15 | Or, without nix: 16 | 17 | ```bash 18 | spago -x test.dhall run --main Examples.SSL.Main 19 | ``` 20 | -------------------------------------------------------------------------------- /docs/Examples/MultiRoute/Readme.md: -------------------------------------------------------------------------------- 1 | # Multi Route Example 2 | 3 | This is a basic example that shows how to create multiple basic routes. It will 4 | return 'hello' when requesting /hello with an HTTP GET, and it will return 5 | 'goodbye' when requesting /goodbye with an HTTP GET. 6 | 7 | To run the example server, run: 8 | 9 | ```bash 10 | nix-shell --run 'example MultiRoute' 11 | ``` 12 | 13 | Or, without nix: 14 | 15 | ```bash 16 | spago -x test.dhall run --main Examples.MultiRoute.Main 17 | ``` 18 | -------------------------------------------------------------------------------- /docs/Examples/PathSegments/Readme.md: -------------------------------------------------------------------------------- 1 | # Path Segments Example 2 | 3 | This is a basic example that demonstrates working with URL segments. It includes 4 | code that fetches the whole set of URL segments as an array of strings, and code 5 | that routes based on the value of specific segments. 6 | 7 | To run the example server, run: 8 | 9 | ```bash 10 | nix-shell --run 'example PathSegments' 11 | ``` 12 | 13 | Or, without nix: 14 | 15 | ```bash 16 | spago -x test.dhall run --main Examples.PathSegments.Main 17 | ``` 18 | -------------------------------------------------------------------------------- /src/HTTPure/MultiHeaders.js: -------------------------------------------------------------------------------- 1 | export const parseRawHeaders = f => headers => { 2 | const result = []; 3 | let key = null, value = null; 4 | 5 | for (const str of headers) { 6 | if (key === null) { 7 | key = str; 8 | } else if (value === null) { 9 | value = str; 10 | } else { 11 | result.push(f(key)(value)); 12 | key = str; 13 | value = null; 14 | } 15 | } 16 | 17 | if (key !== null && value !== null) { 18 | result.push(f(key)(value)); 19 | } 20 | 21 | return result; 22 | }; 23 | -------------------------------------------------------------------------------- /docs/Examples/AsyncResponse/Readme.md: -------------------------------------------------------------------------------- 1 | # Async Response Example 2 | 3 | This is a basic 'hello world' example, that responds by asynchronously reading a 4 | file off the filesystem. It simply returns 'hello world!' when making any 5 | request, but the 'hello world!' text is fetched by reading the contents of the 6 | file [Hello](./Hello). 7 | 8 | To run the example server, run: 9 | 10 | ```bash 11 | nix-shell --run 'example AsyncResponse' 12 | ``` 13 | 14 | Or, without nix: 15 | 16 | ```bash 17 | spago -x test.dhall run --main Examples.AsyncResponse.Main 18 | ``` 19 | -------------------------------------------------------------------------------- /docs/Examples/QueryParameters/Readme.md: -------------------------------------------------------------------------------- 1 | # Query Parameters Example 2 | 3 | This is a basic example that demonstrates working with URL query parameters. It 4 | includes an example of routing based on the _existence_ of a query parameter, an 5 | example of routing based on the _value_ of a given query parameter, and an 6 | example where the response is driven by the contents of a query parameter. 7 | 8 | To run the example server, run: 9 | 10 | ```bash 11 | nix-shell --run 'example QueryParameters' 12 | ``` 13 | 14 | Or, without nix: 15 | 16 | ```bash 17 | spago -x test.dhall run --main Examples.QueryParameters.Main 18 | ``` 19 | -------------------------------------------------------------------------------- /src/HTTPure/Utils.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Utils 2 | ( encodeURIComponent 3 | , replacePlus 4 | , urlDecode 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Data.Maybe (fromMaybe) 10 | import Data.String (Pattern(Pattern), Replacement(Replacement), replaceAll) 11 | import JSURI (decodeURIComponent, encodeURIComponent) as JSURI 12 | 13 | encodeURIComponent :: String -> String 14 | encodeURIComponent s = fromMaybe s $ JSURI.encodeURIComponent s 15 | 16 | replacePlus :: String -> String 17 | replacePlus = replaceAll (Pattern "+") (Replacement "%20") 18 | 19 | urlDecode :: String -> String 20 | urlDecode s = fromMaybe s $ JSURI.decodeURIComponent s 21 | -------------------------------------------------------------------------------- /docs/Examples/HelloWorld/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.HelloWorld.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (ServerM, ok, serve) 7 | 8 | -- | Boot up the server 9 | main :: ServerM 10 | main = 11 | serve 8080 (const $ ok "hello world!") do 12 | log " ┌────────────────────────────────────────────┐" 13 | log " │ Server now up on port 8080 │" 14 | log " │ │" 15 | log " │ To test, run: │" 16 | log " │ > curl localhost:8080 # => hello world! │" 17 | log " └────────────────────────────────────────────┘" 18 | -------------------------------------------------------------------------------- /docs/Examples/Middleware/Readme.md: -------------------------------------------------------------------------------- 1 | # Middleware Example 2 | 3 | HTTPure does not have a `use` function like systems such as `express.js`, but 4 | you can still use middlewares! This example illustrates how purely functional 5 | middlewares in HTTPure work. It includes an example middleware that logs to the 6 | console at the beginning and end of each request, one that injects a header into 7 | the response, and one that handles requests to a given path. 8 | 9 | To run the example server, run: 10 | 11 | ```bash 12 | nix-shell --run 'example Middleware' 13 | ``` 14 | 15 | Or, without nix: 16 | 17 | ```bash 18 | spago -x test.dhall run --main Examples.Middleware.Main 19 | ``` 20 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "httpure" 2 | , dependencies = 3 | [ "aff" 4 | , "arrays" 5 | , "bifunctors" 6 | , "console" 7 | , "effect" 8 | , "either" 9 | , "foldable-traversable" 10 | , "foreign-object" 11 | , "js-uri" 12 | , "maybe" 13 | , "newtype" 14 | , "node-buffer" 15 | , "node-fs" 16 | , "node-http" 17 | , "node-streams" 18 | , "options" 19 | , "ordered-collections" 20 | , "prelude" 21 | , "refs" 22 | , "strings" 23 | , "tuples" 24 | , "type-equality" 25 | ] 26 | , packages = ./packages.dhall 27 | , sources = [ "src/**/*.purs" ] 28 | , license = "MIT" 29 | , repository = "https://github.com/citizennet/purescript-httpure.git" 30 | } 31 | -------------------------------------------------------------------------------- /test/Test/HTTPure/StatusSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.StatusSpec where 2 | 3 | import Prelude 4 | 5 | import Effect.Class (liftEffect) 6 | import HTTPure.Status (write) 7 | import Test.HTTPure.TestHelpers (Test, getResponseStatus, mockResponse, (?=)) 8 | import Test.Spec (describe, it) 9 | 10 | writeSpec :: Test 11 | writeSpec = 12 | describe "write" do 13 | it "writes the given status code" do 14 | status <- 15 | liftEffect do 16 | mock <- mockResponse 17 | write mock 123 18 | pure $ getResponseStatus mock 19 | status ?= 123 20 | 21 | statusSpec :: Test 22 | statusSpec = 23 | describe "Status" do 24 | writeSpec 25 | -------------------------------------------------------------------------------- /docs/Examples/MultiHeaders/Readme.md: -------------------------------------------------------------------------------- 1 | # Multi-Headers Example 2 | 3 | This is a basic example of working with multi-headers. Unlike `HTTPure.Headers`, 4 | the `HTTPure.MultiHeaders` module abstracts headers with potentially multiple 5 | values. 6 | 7 | This example will respond to an HTTP GET on any url and will read the header 8 | 'X-Input' and return the contents in the response body. Try adding multiple, 9 | duplicate 'X-Input' headers to see how it works. It will also return the 10 | 'Set-Cookie' response header with multiple values. 11 | 12 | To run the example server, run: 13 | 14 | ```bash 15 | nix-shell --run 'example MultiHeaders' 16 | ``` 17 | 18 | Or, without nix: 19 | 20 | ```bash 21 | spago -x test.dhall run --main Examples.MultiHeaders.Main 22 | ``` 23 | -------------------------------------------------------------------------------- /docs/Examples/Headers/Readme.md: -------------------------------------------------------------------------------- 1 | # Headers Example 2 | 3 | This is a basic example of working with headers. It will respond to an HTTP GET 4 | on any url and will read the header 'X-Input' and return the contents in the 5 | response body. It will also return the 'X-Example' response header with the 6 | value 'hello world!'. 7 | 8 | Bear in mind that acessing `Set-Cookie` headers through the `headers` interface 9 | will not work because of how node.js represents those headers specifically. For 10 | `Set-Cookie` request headers, please use the `multiHeaders` property of 11 | `HTTPure.Request`. 12 | 13 | To run the example server, run: 14 | 15 | ```bash 16 | nix-shell --run 'example Headers' 17 | ``` 18 | 19 | Or, without nix: 20 | 21 | ```bash 22 | spago -x test.dhall run --main Examples.Headers.Main 23 | ``` 24 | -------------------------------------------------------------------------------- /Releasing.md: -------------------------------------------------------------------------------- 1 | # HTTPure Releasing Guide 2 | 3 | 1. Check out the release series branch (or `main` if you are releasing the next 4 | major/minor version). Ensure all relevant commits and PRs have been merged. 5 | 2. Update [History.md](./History.md) by changing "unreleased" to the new 6 | version/date. Example diff: 7 | ```diff 8 | -unreleased 9 | -========== 10 | +1.0.0 / 2017-07-10 11 | +================== 12 | ``` 13 | 3. Commit your update to [History.md](./History.md). Use the message `Release 14 | notes for v`. 15 | 4. Follow the instructions on 16 | https://github.com/purescript-contrib/governance/blob/main/pursuit-preregistry.md. 17 | 5. If you are pushing a non-patch release, create and push a branch named with 18 | the version series, i.e. `v0.1.x`. 19 | 6. [Create the release on 20 | github](https://github.com/citizennet/purescript-httpure/releases/new). 21 | -------------------------------------------------------------------------------- /docs/Examples/MultiRoute/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.MultiRoute.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Request, ResponseM, ServerM, notFound, ok, serve) 7 | 8 | -- | Specify the routes 9 | router :: Request -> ResponseM 10 | router { path: [ "hello" ] } = ok "hello" 11 | router { path: [ "goodbye" ] } = ok "goodbye" 12 | router _ = notFound 13 | 14 | -- | Boot up the server 15 | main :: ServerM 16 | main = 17 | serve 8080 router do 18 | log " ┌────────────────────────────────┐" 19 | log " │ Server now up on port 8080 │" 20 | log " │ │" 21 | log " │ To test, run: │" 22 | log " │ > curl localhost:8080/hello │" 23 | log " │ # => hello │" 24 | log " │ > curl localhost:8080/goodbye │" 25 | log " │ # => goodbye │" 26 | log " └────────────────────────────────┘" 27 | -------------------------------------------------------------------------------- /docs/Examples/Post/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.Post.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure 7 | ( Method(Post) 8 | , Request 9 | , ResponseM 10 | , ServerM 11 | , notFound 12 | , ok 13 | , serve 14 | , toString 15 | ) 16 | 17 | -- | Route to the correct handler 18 | router :: Request -> ResponseM 19 | router { body, method: Post } = toString body >>= ok 20 | router _ = notFound 21 | 22 | -- | Boot up the server 23 | main :: ServerM 24 | main = 25 | serve 8080 router do 26 | log " ┌───────────────────────────────────────────┐" 27 | log " │ Server now up on port 8080 │" 28 | log " │ │" 29 | log " │ To test, run: │" 30 | log " │ > curl -XPOST --data test localhost:8080 │" 31 | log " │ # => test │" 32 | log " └───────────────────────────────────────────┘" 33 | -------------------------------------------------------------------------------- /docs/Examples/AsyncResponse/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.AsyncResponse.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Request, ResponseM, ServerM, ok, serve) 7 | import Node.Encoding (Encoding(UTF8)) 8 | import Node.FS.Aff (readTextFile) 9 | 10 | -- | The path to the file containing the response to send 11 | filePath :: String 12 | filePath = "./docs/Examples/AsyncResponse/Hello" 13 | 14 | -- | Say 'hello world!' when run 15 | sayHello :: Request -> ResponseM 16 | sayHello = const $ readTextFile UTF8 filePath >>= ok 17 | 18 | -- | Boot up the server 19 | main :: ServerM 20 | main = 21 | serve 8080 sayHello do 22 | log " ┌────────────────────────────────────────────┐" 23 | log " │ Server now up on port 8080 │" 24 | log " │ │" 25 | log " │ To test, run: │" 26 | log " │ > curl localhost:8080 # => hello world! │" 27 | log " └────────────────────────────────────────────┘" 28 | -------------------------------------------------------------------------------- /docs/Examples/BinaryRequest/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.BinaryRequest.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Request, ResponseM, ServerM, ok, serve, toBuffer) 7 | import Node.Buffer (Buffer) 8 | 9 | foreign import sha256sum :: Buffer -> String 10 | 11 | -- | Respond with file's sha256sum 12 | router :: Request -> ResponseM 13 | router { body } = toBuffer body >>= sha256sum >>> ok 14 | 15 | -- | Boot up the server 16 | main :: ServerM 17 | main = 18 | serve 8080 router do 19 | log " ┌─────────────────────────────────────────────────────────┐" 20 | log " │ Server now up on port 8080 │" 21 | log " │ │" 22 | log " │ To test, run: │" 23 | log " │ > curl -XPOST --data-binary @circle.png localhost:8080 │" 24 | log " │ # => d5e776724dd5... │" 25 | log " └─────────────────────────────────────────────────────────┘" 26 | -------------------------------------------------------------------------------- /docs/Examples/PathSegments/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.PathSegments.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Request, ResponseM, ServerM, ok, serve, (!@)) 7 | 8 | -- | Specify the routes 9 | router :: Request -> ResponseM 10 | router { path } 11 | | path !@ 0 == "segment" = ok $ path !@ 1 12 | | otherwise = ok $ show path 13 | 14 | -- | Boot up the server 15 | main :: ServerM 16 | main = 17 | serve 8080 router do 18 | log " ┌───────────────────────────────────────────────┐" 19 | log " │ Server now up on port 8080 │" 20 | log " │ │" 21 | log " │ To test, run: │" 22 | log " │ > curl localhost:8080/segment/ │" 23 | log " │ # => │" 24 | log " │ > curl localhost:8080///... │" 25 | log " │ # => [ , , ... ] │" 26 | log " └───────────────────────────────────────────────┘" 27 | -------------------------------------------------------------------------------- /docs/Examples/SSL/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.SSL.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Request, ResponseM, ServerM, ok, serveSecure) 7 | 8 | -- | The path to the certificate file 9 | cert :: String 10 | cert = "./docs/Examples/SSL/Certificate.cer" 11 | 12 | -- | The path to the key file 13 | key :: String 14 | key = "./docs/Examples/SSL/Key.key" 15 | 16 | -- | Say 'hello world!' when run 17 | sayHello :: Request -> ResponseM 18 | sayHello _ = ok "hello world!" 19 | 20 | -- | Boot up the server 21 | main :: ServerM 22 | main = 23 | serveSecure 8080 cert key sayHello do 24 | log " ┌───────────────────────────────────────────┐" 25 | log " │ Server now up on port 8080 │" 26 | log " │ │" 27 | log " │ To test, run: │" 28 | log " │ > curl --insecure https://localhost:8080 │" 29 | log " │ # => hello world! │" 30 | log " └───────────────────────────────────────────┘" 31 | -------------------------------------------------------------------------------- /docs/Examples/BinaryResponse/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.BinaryResponse.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Headers, Request, ResponseM, ServerM, header, ok', serve) 7 | import Node.FS.Aff (readFile) 8 | 9 | -- | The path to the file containing the response to send 10 | filePath :: String 11 | filePath = "./docs/Examples/BinaryResponse/circle.png" 12 | 13 | responseHeaders :: Headers 14 | responseHeaders = header "Content-Type" "image/png" 15 | 16 | -- | Respond with image data when run 17 | image :: Request -> ResponseM 18 | image = const $ readFile filePath >>= ok' responseHeaders 19 | 20 | -- | Boot up the server 21 | main :: ServerM 22 | main = 23 | serve 8080 image do 24 | log " ┌──────────────────────────────────────┐" 25 | log " │ Server now up on port 8080 │" 26 | log " │ │" 27 | log " │ To test, run: │" 28 | log " │ > curl -o circle.png localhost:8080 │" 29 | log " └──────────────────────────────────────┘" 30 | -------------------------------------------------------------------------------- /src/HTTPure/Path.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Path 2 | ( Path 3 | , read 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Data.Array (filter, head) 9 | import Data.Maybe (fromMaybe) 10 | import Data.String (Pattern(Pattern), split) 11 | import HTTPure.Utils (urlDecode) 12 | import Node.HTTP (Request, requestURL) 13 | 14 | -- | The `Path` type is just sugar for an `Array` of `String` segments that are 15 | -- | sent in a request and indicates the path of the resource being requested. 16 | -- | Note that this type has an implementation of `Lookup` for `Int` keys 17 | -- | defined by `lookupArray` in [Lookup.purs](./Lookup.purs) because 18 | -- | `lookupArray` is defined for any `Array` of `Monoids`. So you can do 19 | -- | something like `path !! 2` to get the path segment at index 2. 20 | type Path = Array String 21 | 22 | -- | Given an HTTP `Request` object, extract the `Path`. 23 | read :: Request -> Path 24 | read = requestURL >>> split' "?" >>> first >>> split' "/" >>> nonempty >>> map urlDecode 25 | where 26 | nonempty = filter ((/=) "") 27 | split' = Pattern >>> split 28 | first = head >>> fromMaybe "" 29 | -------------------------------------------------------------------------------- /docs/Examples/QueryParameters/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.QueryParameters.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Request, ResponseM, ServerM, ok, serve, (!?), (!@)) 7 | 8 | -- | Specify the routes 9 | router :: Request -> ResponseM 10 | router { query } 11 | | query !? "foo" = ok "foo" 12 | | query !@ "bar" == "test" = ok "bar" 13 | | otherwise = ok $ query !@ "baz" 14 | 15 | -- | Boot up the server 16 | main :: ServerM 17 | main = 18 | serve 8080 router do 19 | log " ┌───────────────────────────────────────┐" 20 | log " │ Server now up on port 8080 │" 21 | log " │ │" 22 | log " │ To test, run: │" 23 | log " │ > curl localhost:8080?foo │" 24 | log " │ # => foo │" 25 | log " │ > curl localhost:8080?bar=test │" 26 | log " │ # => bar │" 27 | log " │ > curl localhost:8080?baz= │" 28 | log " │ # => │" 29 | log " └───────────────────────────────────────┘" 30 | -------------------------------------------------------------------------------- /License: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017 Connor Prussin 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /src/HTTPure/Method.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Method 2 | ( Method(..) 3 | , read 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Node.HTTP (Request, requestMethod) 9 | 10 | -- | These are the HTTP methods that HTTPure understands. 11 | data Method 12 | = Get 13 | | Post 14 | | Put 15 | | Delete 16 | | Head 17 | | Connect 18 | | Options 19 | | Trace 20 | | Patch 21 | 22 | -- | If two `Methods` are the same constructor, they are equal. 23 | derive instance eqMethod :: Eq Method 24 | 25 | -- | Convert a constructor to a `String`. 26 | instance showMethod :: Show Method where 27 | show Get = "Get" 28 | show Post = "Post" 29 | show Put = "Put" 30 | show Delete = "Delete" 31 | show Head = "Head" 32 | show Connect = "Connect" 33 | show Options = "Options" 34 | show Trace = "Trace" 35 | show Patch = "Patch" 36 | 37 | -- | Take an HTTP `Request` and extract the `Method` for that request. 38 | read :: Request -> Method 39 | read = requestMethod >>> case _ of 40 | "POST" -> Post 41 | "PUT" -> Put 42 | "DELETE" -> Delete 43 | "HEAD" -> Head 44 | "CONNECT" -> Connect 45 | "OPTIONS" -> Options 46 | "TRACE" -> Trace 47 | "PATCH" -> Patch 48 | _ -> Get 49 | -------------------------------------------------------------------------------- /docs/Examples/Headers/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.Headers.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Console (log) 6 | import HTTPure (Headers, Request, ResponseM, ServerM, header, ok', serve, (!@)) 7 | 8 | -- | The headers that will be included in every response. 9 | responseHeaders :: Headers 10 | responseHeaders = header "X-Example" "hello world!" 11 | 12 | -- | Route to the correct handler 13 | router :: Request -> ResponseM 14 | router { headers } = ok' responseHeaders $ headers !@ "X-Input" 15 | 16 | -- | Boot up the server 17 | main :: ServerM 18 | main = 19 | serve 8080 router do 20 | log " ┌──────────────────────────────────────────────┐" 21 | log " │ Server now up on port 8080 │" 22 | log " │ │" 23 | log " │ To test, run: │" 24 | log " │ > curl -H 'X-Input: test' -v localhost:8080 │" 25 | log " │ # => ... │" 26 | log " │ # => ...< X-Example: hello world! │" 27 | log " │ # => ... │" 28 | log " │ # => test │" 29 | log " └──────────────────────────────────────────────┘" 30 | -------------------------------------------------------------------------------- /src/HTTPure/Version.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Version 2 | ( Version(..) 3 | , read 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Node.HTTP (Request, httpVersion) 9 | 10 | -- | These are the HTTP versions that HTTPure understands. There are five 11 | -- | commonly known versions which are explicitly named. 12 | data Version 13 | = HTTP0_9 14 | | HTTP1_0 15 | | HTTP1_1 16 | | HTTP2_0 17 | | HTTP3_0 18 | | Other String 19 | 20 | -- | If two `Versions` are the same constructor, they are equal. 21 | derive instance eqVersion :: Eq Version 22 | 23 | -- | Allow a `Version` to be represented as a string. This string is formatted 24 | -- | as it would be in an HTTP request/response. 25 | instance showVersion :: Show Version where 26 | show HTTP0_9 = "HTTP/0.9" 27 | show HTTP1_0 = "HTTP/1.0" 28 | show HTTP1_1 = "HTTP/1.1" 29 | show HTTP2_0 = "HTTP/2.0" 30 | show HTTP3_0 = "HTTP/3.0" 31 | show (Other version) = "HTTP/" <> version 32 | 33 | -- | Take an HTTP `Request` and extract the `Version` for that request. 34 | read :: Request -> Version 35 | read = httpVersion >>> case _ of 36 | "0.9" -> HTTP0_9 37 | "1.0" -> HTTP1_0 38 | "1.1" -> HTTP1_1 39 | "2.0" -> HTTP2_0 40 | "3.0" -> HTTP3_0 41 | version -> Other version 42 | -------------------------------------------------------------------------------- /test/Mocks/Certificate.cer: -------------------------------------------------------------------------------- 1 | -----BEGIN CERTIFICATE----- 2 | MIIDWDCCAkCgAwIBAgIJAKm4yWuzx7UpMA0GCSqGSIb3DQEBCwUAMEExCzAJBgNV 3 | BAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2NyaXB0 4 | LW5vZGUtaHR0cDAeFw0xNzA3MjMwMTM4MThaFw0xNzA4MjIwMTM4MThaMEExCzAJ 5 | BgNVBAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2Ny 6 | aXB0LW5vZGUtaHR0cDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMrI 7 | 7YGwOVZJGemgeGm8e6MTydSQozxlHYwshHDb83pB2LUhkguSRHoUe9CO+uDGemKP 8 | BHMHFCS1Nuhgal3mnCPNbY/57mA8LDIpjJ/j9UD85Aw5c89yEd8MuLoM1T0q/APa 9 | LOmKMgzvfpA0S1/6Hr5Ef/tGdE1gFluVirhgUqvbIBJzqTraQq89jwf+4YmzjCO7 10 | /6FIY0pn4xgcSGyd3i2r/DGbL42QlNmq2MarxxdFJo1llK6YIBhS/fAJCp6hsAnX 11 | +m4hClvJ17Rt+46q4C7KCP6J1U5jFIMtDF7jw6uBr/macenF/ApAHUW0dAiBP9qG 12 | fI2l64syxNSUS3of9p0CAwEAAaNTMFEwHQYDVR0OBBYEFPlsFrLCVM6zgXzKMkDN 13 | lzkLLoCfMB8GA1UdIwQYMBaAFPlsFrLCVM6zgXzKMkDNlzkLLoCfMA8GA1UdEwEB 14 | /wQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKvNsmnuO65CUnU1U85UlXYSpyA2 15 | f1SVCwKsRB9omFCbtJv8nZOrFSfooxdNJ0LiS7t4cs6v1+441+Sg4aLA14qy4ezv 16 | Fmjt/0qfS3GNjJRr9KU9ZdZ3oxu7qf2ILUneSJOuU/OjP42rZUV6ruyauZB79PvB 17 | 25ENUhpA9z90REYjHuZzUeI60/aRwqQgCCwu5XYeIIxkD+WBPh2lxCfASwQ6/1Iq 18 | fEkZtgzKvcprF8csbb2RNu2AVF2jdxChtl/FCUlSSX13VCROf6dOYJPid9s/wKpE 19 | nN+b2NNE8OJeuskvEckzDe/hbkVptUNi4q2G8tBoKjPPTjdiLjtxuNz7OT0= 20 | -----END CERTIFICATE----- 21 | -------------------------------------------------------------------------------- /docs/Examples/SSL/Certificate.cer: -------------------------------------------------------------------------------- 1 | -----BEGIN CERTIFICATE----- 2 | MIIDWDCCAkCgAwIBAgIJAKm4yWuzx7UpMA0GCSqGSIb3DQEBCwUAMEExCzAJBgNV 3 | BAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2NyaXB0 4 | LW5vZGUtaHR0cDAeFw0xNzA3MjMwMTM4MThaFw0xNzA4MjIwMTM4MThaMEExCzAJ 5 | BgNVBAYTAlVTMRMwEQYDVQQIDApDYWxpZm9ybmlhMR0wGwYDVQQKDBRwdXJlc2Ny 6 | aXB0LW5vZGUtaHR0cDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMrI 7 | 7YGwOVZJGemgeGm8e6MTydSQozxlHYwshHDb83pB2LUhkguSRHoUe9CO+uDGemKP 8 | BHMHFCS1Nuhgal3mnCPNbY/57mA8LDIpjJ/j9UD85Aw5c89yEd8MuLoM1T0q/APa 9 | LOmKMgzvfpA0S1/6Hr5Ef/tGdE1gFluVirhgUqvbIBJzqTraQq89jwf+4YmzjCO7 10 | /6FIY0pn4xgcSGyd3i2r/DGbL42QlNmq2MarxxdFJo1llK6YIBhS/fAJCp6hsAnX 11 | +m4hClvJ17Rt+46q4C7KCP6J1U5jFIMtDF7jw6uBr/macenF/ApAHUW0dAiBP9qG 12 | fI2l64syxNSUS3of9p0CAwEAAaNTMFEwHQYDVR0OBBYEFPlsFrLCVM6zgXzKMkDN 13 | lzkLLoCfMB8GA1UdIwQYMBaAFPlsFrLCVM6zgXzKMkDNlzkLLoCfMA8GA1UdEwEB 14 | /wQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKvNsmnuO65CUnU1U85UlXYSpyA2 15 | f1SVCwKsRB9omFCbtJv8nZOrFSfooxdNJ0LiS7t4cs6v1+441+Sg4aLA14qy4ezv 16 | Fmjt/0qfS3GNjJRr9KU9ZdZ3oxu7qf2ILUneSJOuU/OjP42rZUV6ruyauZB79PvB 17 | 25ENUhpA9z90REYjHuZzUeI60/aRwqQgCCwu5XYeIIxkD+WBPh2lxCfASwQ6/1Iq 18 | fEkZtgzKvcprF8csbb2RNu2AVF2jdxChtl/FCUlSSX13VCROf6dOYJPid9s/wKpE 19 | nN+b2NNE8OJeuskvEckzDe/hbkVptUNi4q2G8tBoKjPPTjdiLjtxuNz7OT0= 20 | -----END CERTIFICATE----- 21 | -------------------------------------------------------------------------------- /test/Test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Aff (launchAff_) 6 | import Test.HTTPure.BodySpec (bodySpec) 7 | import Test.HTTPure.HeadersSpec (headersSpec) 8 | import Test.HTTPure.IntegrationSpec (integrationSpec) 9 | import Test.HTTPure.LookupSpec (lookupSpec) 10 | import Test.HTTPure.MethodSpec (methodSpec) 11 | import Test.HTTPure.MultiHeadersSpec (multiHeadersSpec) 12 | import Test.HTTPure.PathSpec (pathSpec) 13 | import Test.HTTPure.QuerySpec (querySpec) 14 | import Test.HTTPure.RequestSpec (requestSpec) 15 | import Test.HTTPure.ResponseSpec (responseSpec) 16 | import Test.HTTPure.ServerSpec (serverSpec) 17 | import Test.HTTPure.StatusSpec (statusSpec) 18 | import Test.HTTPure.TestHelpers (TestSuite) 19 | import Test.HTTPure.UtilsSpec (utilsSpec) 20 | import Test.HTTPure.VersionSpec (versionSpec) 21 | import Test.Spec (describe) 22 | import Test.Spec.Reporter (specReporter) 23 | import Test.Spec.Runner (runSpec) 24 | 25 | main :: TestSuite 26 | main = launchAff_ $ runSpec [ specReporter ] $ describe "HTTPure" do 27 | bodySpec 28 | headersSpec 29 | lookupSpec 30 | methodSpec 31 | multiHeadersSpec 32 | pathSpec 33 | querySpec 34 | requestSpec 35 | responseSpec 36 | serverSpec 37 | statusSpec 38 | utilsSpec 39 | versionSpec 40 | integrationSpec 41 | -------------------------------------------------------------------------------- /test/Test/HTTPure/TestHelpers.js: -------------------------------------------------------------------------------- 1 | import { Readable } from "stream"; 2 | 3 | export const mockRequestImpl = httpVersion => method => url => body => headers => rawHeaders => () => { 4 | const stream = new Readable({ 5 | read: function (size) { 6 | this.push(body); 7 | this.push(null); 8 | } 9 | }); 10 | stream.method = method; 11 | stream.url = url; 12 | stream.headers = headers; 13 | stream.rawHeaders = rawHeaders; 14 | stream.httpVersion = httpVersion; 15 | 16 | return stream; 17 | }; 18 | 19 | export const mockResponse = () => ({ 20 | body: "", 21 | headers: {}, 22 | 23 | write: function (str, encoding, callback) { 24 | this.body = this.body + str; 25 | if (callback) { 26 | callback(); 27 | } 28 | }, 29 | 30 | end: function (str, encoding, callback) { 31 | if (callback) { 32 | callback(); 33 | } 34 | }, 35 | 36 | on: function () {}, 37 | once: function () {}, 38 | emit: function () {}, 39 | 40 | setHeader: function (header, val) { 41 | this.headers[header] = val; 42 | }, 43 | }); 44 | 45 | export const stringToStream = str => { 46 | const stream = new Readable(); 47 | stream._read = function () {}; 48 | stream.push(str); 49 | stream.push(null); 50 | return stream; 51 | } 52 | -------------------------------------------------------------------------------- /docs/Examples/CustomStack/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.CustomStack.Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Reader (class MonadAsk, ReaderT, asks, runReaderT) 6 | import Effect.Aff (Aff) 7 | import Effect.Aff.Class (class MonadAff) 8 | import Effect.Console (log) 9 | import HTTPure (Request, Response, ResponseM, ServerM, ok, serve) 10 | 11 | -- | A type to hold the environment for our ReaderT 12 | type Env = { name :: String } 13 | 14 | -- | A middleware that introduces a ReaderT 15 | readerMiddleware :: 16 | (Request -> ReaderT Env Aff Response) -> 17 | Request -> 18 | ResponseM 19 | readerMiddleware router request = do 20 | runReaderT (router request) { name: "joe" } 21 | 22 | -- | Say 'hello, joe' when run 23 | sayHello :: forall m. MonadAff m => MonadAsk Env m => Request -> m Response 24 | sayHello _ = do 25 | name <- asks _.name 26 | ok $ "hello, " <> name 27 | 28 | -- | Boot up the server 29 | main :: ServerM 30 | main = 31 | serve 8080 (readerMiddleware sayHello) do 32 | log " ┌───────────────────────────────────────┐" 33 | log " │ Server now up on port 8080 │" 34 | log " │ │" 35 | log " │ To test, run: │" 36 | log " │ > curl -v localhost:8080 │" 37 | log " │ # => hello, joe │" 38 | log " └───────────────────────────────────────┘" 39 | -------------------------------------------------------------------------------- /docs/Examples/Chunked/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.Chunked.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Aff (Aff) 6 | import Effect.Class (liftEffect) 7 | import Effect.Console (log) 8 | import HTTPure (Request, ResponseM, ServerM, ok, serve) 9 | import Node.ChildProcess (defaultSpawnOptions, spawn, stdout) 10 | import Node.Stream (Readable) 11 | 12 | -- | Run a script and return it's stdout stream 13 | runScript :: String -> Aff (Readable ()) 14 | runScript script = 15 | liftEffect $ stdout <$> spawn "sh" [ "-c", script ] defaultSpawnOptions 16 | 17 | -- | Say 'hello world!' in chunks when run 18 | sayHello :: Request -> ResponseM 19 | sayHello = const $ runScript "echo 'hello '; sleep 1; echo 'world!'" >>= ok 20 | 21 | -- | Boot up the server 22 | main :: ServerM 23 | main = 24 | serve 8080 sayHello do 25 | log " ┌──────────────────────────────────────┐" 26 | log " │ Server now up on port 8080 │" 27 | log " │ │" 28 | log " │ To test, run: │" 29 | log " │ > curl -Nv localhost:8080 │" 30 | log " │ # => ... │" 31 | log " │ # => < Transfer-Encoding: chunked │" 32 | log " │ # => ... │" 33 | log " │ # => hello │" 34 | log " │ (1 second pause) │" 35 | log " │ # => world! │" 36 | log " └──────────────────────────────────────┘" 37 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-httpure", 3 | "license": [ 4 | "MIT" 5 | ], 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/citizennet/purescript-httpure.git" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "node_modules", 13 | "bower_components", 14 | "output" 15 | ], 16 | "dependencies": { 17 | "purescript-aff": "^v7.0.0", 18 | "purescript-arrays": "^v7.0.0", 19 | "purescript-bifunctors": "^v6.0.0", 20 | "purescript-console": "^v6.0.0", 21 | "purescript-effect": "^v4.0.0", 22 | "purescript-either": "^v6.0.0", 23 | "purescript-foldable-traversable": "^v6.0.0", 24 | "purescript-foreign-object": "^v4.0.0", 25 | "purescript-js-uri": "https://github.com/purescript-contrib/purescript-js-uri.git#v3.0.0", 26 | "purescript-maybe": "^v6.0.0", 27 | "purescript-newtype": "^v5.0.0", 28 | "purescript-node-buffer": "^v8.0.0", 29 | "purescript-node-fs": "^v8.0.0", 30 | "purescript-node-http": "^v8.0.0", 31 | "purescript-node-streams": "^v7.0.0", 32 | "purescript-options": "^v7.0.0", 33 | "purescript-ordered-collections": "^v3.0.0", 34 | "purescript-prelude": "^v6.0.0", 35 | "purescript-refs": "^v6.0.0", 36 | "purescript-strings": "^v6.0.0", 37 | "purescript-tuples": "^v7.0.0", 38 | "purescript-type-equality": "^v4.0.1" 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /test/Test/HTTPure/PathSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.PathSpec where 2 | 3 | import Prelude 4 | 5 | import HTTPure.Path (read) 6 | import Test.HTTPure.TestHelpers (Test, mockRequest, (?=)) 7 | import Test.Spec (describe, it) 8 | 9 | readSpec :: Test 10 | readSpec = 11 | describe "read" do 12 | describe "with a query string" do 13 | it "is just the path" do 14 | request <- mockRequest "" "GET" "test/path?blabla" "" [] 15 | read request ?= [ "test", "path" ] 16 | describe "with no query string" do 17 | it "is the path" do 18 | request <- mockRequest "" "GET" "test/path" "" [] 19 | read request ?= [ "test", "path" ] 20 | describe "with no segments" do 21 | it "is an empty array" do 22 | request <- mockRequest "" "GET" "" "" [] 23 | read request ?= [] 24 | describe "with empty segments" do 25 | it "strips the empty segments" do 26 | request <- mockRequest "" "GET" "//test//path///?query" "" [] 27 | read request ?= [ "test", "path" ] 28 | describe "with percent encoded segments" do 29 | it "decodes percent encoding" do 30 | request <- mockRequest "" "GET" "/test%20path/%2Fthis" "" [] 31 | read request ?= [ "test path", "/this" ] 32 | it "does not decode a plus sign" do 33 | request <- mockRequest "" "GET" "/test+path/this" "" [] 34 | read request ?= [ "test+path", "this" ] 35 | 36 | pathSpec :: Test 37 | pathSpec = 38 | describe "Path" do 39 | readSpec 40 | -------------------------------------------------------------------------------- /test/Test/HTTPure/MethodSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.MethodSpec where 2 | 3 | import Prelude 4 | 5 | import HTTPure.Method 6 | ( Method(Get, Post, Put, Delete, Head, Connect, Options, Trace, Patch) 7 | , read 8 | ) 9 | import Test.HTTPure.TestHelpers (Test, mockRequest, (?=)) 10 | import Test.Spec (describe, it) 11 | 12 | showSpec :: Test 13 | showSpec = 14 | describe "show" do 15 | describe "with a Get" do 16 | it "is 'Get'" do 17 | show Get ?= "Get" 18 | describe "with a Post" do 19 | it "is 'Post'" do 20 | show Post ?= "Post" 21 | describe "with a Put" do 22 | it "is 'Put'" do 23 | show Put ?= "Put" 24 | describe "with a Delete" do 25 | it "is 'Delete'" do 26 | show Delete ?= "Delete" 27 | describe "with a Head" do 28 | it "is 'Head'" do 29 | show Head ?= "Head" 30 | describe "with a Connect" do 31 | it "is 'Connect'" do 32 | show Connect ?= "Connect" 33 | describe "with a Options" do 34 | it "is 'Options'" do 35 | show Options ?= "Options" 36 | describe "with a Trace" do 37 | it "is 'Trace'" do 38 | show Trace ?= "Trace" 39 | describe "with a Patch" do 40 | it "is 'Patch'" do 41 | show Patch ?= "Patch" 42 | 43 | readSpec :: Test 44 | readSpec = 45 | describe "read" do 46 | describe "with a 'GET' Request" do 47 | it "is Get" do 48 | request <- mockRequest "" "GET" "" "" [] 49 | read request ?= Get 50 | 51 | methodSpec :: Test 52 | methodSpec = 53 | describe "Method" do 54 | showSpec 55 | readSpec 56 | -------------------------------------------------------------------------------- /src/HTTPure/Query.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Query 2 | ( Query 3 | , read 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Data.Array (filter, head, tail) 9 | import Data.Bifunctor (bimap) 10 | import Data.Maybe (fromMaybe) 11 | import Data.String (Pattern(Pattern), joinWith, split) 12 | import Data.Tuple (Tuple(Tuple)) 13 | import Foreign.Object (Object, fromFoldable) 14 | import HTTPure.Utils (replacePlus, urlDecode) 15 | import Node.HTTP (Request, requestURL) 16 | 17 | -- | The `Query` type is a `Object` of `Strings`, with one entry per query 18 | -- | parameter in the request. For any query parameters that don't have values 19 | -- | (`/some/path?query` or `/some/path?query=`), the value in the `Object` for 20 | -- | that parameter will be the an empty string. Note that this type has an 21 | -- | implementation of `Lookup` for `String` keys defined by `lookupObject` in 22 | -- | [Lookup.purs](./Lookup.purs) because `lookupObject` is defined for any 23 | -- | `Object` of `Monoids`. So you can do something like `query !! "foo"` to get 24 | -- | the value of the query parameter "foo". 25 | type Query = Object String 26 | 27 | -- | The `Map` of query segments in the given HTTP `Request`. 28 | read :: Request -> Query 29 | read = requestURL >>> split' "?" >>> last >>> split' "&" >>> nonempty >>> toObject 30 | where 31 | toObject = map toTuple >>> fromFoldable 32 | nonempty = filter ((/=) "") 33 | split' = Pattern >>> split 34 | first = head >>> fromMaybe "" 35 | last = tail >>> fromMaybe [] >>> joinWith "" 36 | decode = replacePlus >>> urlDecode 37 | decodeKeyValue = bimap decode decode 38 | toTuple item = decodeKeyValue $ Tuple (first itemParts) (last itemParts) 39 | where 40 | itemParts = split' "=" item 41 | -------------------------------------------------------------------------------- /test/Mocks/Key.key: -------------------------------------------------------------------------------- 1 | -----BEGIN PRIVATE KEY----- 2 | MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDKyO2BsDlWSRnp 3 | oHhpvHujE8nUkKM8ZR2MLIRw2/N6Qdi1IZILkkR6FHvQjvrgxnpijwRzBxQktTbo 4 | YGpd5pwjzW2P+e5gPCwyKYyf4/VA/OQMOXPPchHfDLi6DNU9KvwD2izpijIM736Q 5 | NEtf+h6+RH/7RnRNYBZblYq4YFKr2yASc6k62kKvPY8H/uGJs4wju/+hSGNKZ+MY 6 | HEhsnd4tq/wxmy+NkJTZqtjGq8cXRSaNZZSumCAYUv3wCQqeobAJ1/puIQpbyde0 7 | bfuOquAuygj+idVOYxSDLQxe48Orga/5mnHpxfwKQB1FtHQIgT/ahnyNpeuLMsTU 8 | lEt6H/adAgMBAAECggEBALSe/54SXx/SAPitbFOSBPYefBmPszXqQsVGKbl00IvG 9 | 9sVvX2xbHg83C4masS9g2kXLaYUjevevSXb12ghFjjH9mmcxkPe64QrVI2KPYzY9 10 | isqwqczOp8hqxmdBYvYWwV6VCIgEBcyrzamYSsL0QEntLamc+Z6pxYBR1LuhYEGd 11 | Vq0A+YL/4CZi320+pt05u/635Daon33JqhvDa0QK5xvFYKEcB+IY5eqByOx7nJl8 12 | A55oVagBVjpi//rwoge5aCfbcdyHUmBFYkuCI6SJhvwDmfSHWDkyWWsZAJY5sosN 13 | a824N7XX5ZiBYir+E4ldC6ZlFOnQK5f6Fr0MJeM8uikCgYEA+HAgYgKBpezCrJ0B 14 | I/inIfynaW8k3SCSQhYvqPK591cBKXwghCG2vpUwqIVO/ROP070L9/EtNrFs5fPv 15 | xHQA8P3Weeail6gl9UR5oKNU3bcbIFunUtWi1ua86g/aaofub/hBq2xR+HSnV91W 16 | Ycwewyfc/0j94kDOAFgSGOz0BscCgYEA0PUQXtuu05YTmz2TDtknCcQOVm/UnEg6 17 | 1FsKPzmoxWsAMtHXf3FbD3vHql1JfPTJPNcxEEL6fhA1l7ntailHltx8dt9bXmYJ 18 | ANM0n8uSKde5MoFbMhmyYTcRxJW9EC2ivqLotd5iL1mbfvdF02cWmr/5KNxUO1Hk 19 | 7TkJturwo3sCgYBc/gNxDEUhKX05BU/O+hz9QMgdVAf1aWK1r/5I/AoWBhAeSiMV 20 | slToA4oCGlwVqMPWWtXnCfSFm2YKsQNXgqBzlGA6otTLdZo3s1jfgyOaFhbmRshb 21 | 3jGkxRuDdUmpRJZAfSl/k/0exfN5lRTnaHM/U2WKfPTjQqSZRl4HzHIPMwKBgFVE 22 | W0zKClou+Is1oifB9wsmJM+izLiFRPRYviK0raj5k9gpBu3rXMRBt2VOsek6nk+k 23 | ZFIFcuA0Txo99aKHe74U9PkxBcDMlEnw5Z17XYaTj/ALFyKnl8HRzf9RNxg99xYh 24 | tiJYv+ogf7JcxvKQM4osYkkJN5oJPgiLaOpqjo23AoGBAN3g5kvsYj3OKGh89pGk 25 | osLeL+NNUBDvFsrvFzPMwPGDup6AB1qX1pc4RfyQGzDJqUSTpioWI5v1O6Pmoiak 26 | FO0u08Tb/091Bir5kgglUSi7VnFD3v8ffeKpkkJvtYUj7S9yoH9NQPVhKVCq6mna 27 | TbGfXbnVfNmqgQh71+k02p6S 28 | -----END PRIVATE KEY----- -------------------------------------------------------------------------------- /docs/Examples/SSL/Key.key: -------------------------------------------------------------------------------- 1 | -----BEGIN PRIVATE KEY----- 2 | MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDKyO2BsDlWSRnp 3 | oHhpvHujE8nUkKM8ZR2MLIRw2/N6Qdi1IZILkkR6FHvQjvrgxnpijwRzBxQktTbo 4 | YGpd5pwjzW2P+e5gPCwyKYyf4/VA/OQMOXPPchHfDLi6DNU9KvwD2izpijIM736Q 5 | NEtf+h6+RH/7RnRNYBZblYq4YFKr2yASc6k62kKvPY8H/uGJs4wju/+hSGNKZ+MY 6 | HEhsnd4tq/wxmy+NkJTZqtjGq8cXRSaNZZSumCAYUv3wCQqeobAJ1/puIQpbyde0 7 | bfuOquAuygj+idVOYxSDLQxe48Orga/5mnHpxfwKQB1FtHQIgT/ahnyNpeuLMsTU 8 | lEt6H/adAgMBAAECggEBALSe/54SXx/SAPitbFOSBPYefBmPszXqQsVGKbl00IvG 9 | 9sVvX2xbHg83C4masS9g2kXLaYUjevevSXb12ghFjjH9mmcxkPe64QrVI2KPYzY9 10 | isqwqczOp8hqxmdBYvYWwV6VCIgEBcyrzamYSsL0QEntLamc+Z6pxYBR1LuhYEGd 11 | Vq0A+YL/4CZi320+pt05u/635Daon33JqhvDa0QK5xvFYKEcB+IY5eqByOx7nJl8 12 | A55oVagBVjpi//rwoge5aCfbcdyHUmBFYkuCI6SJhvwDmfSHWDkyWWsZAJY5sosN 13 | a824N7XX5ZiBYir+E4ldC6ZlFOnQK5f6Fr0MJeM8uikCgYEA+HAgYgKBpezCrJ0B 14 | I/inIfynaW8k3SCSQhYvqPK591cBKXwghCG2vpUwqIVO/ROP070L9/EtNrFs5fPv 15 | xHQA8P3Weeail6gl9UR5oKNU3bcbIFunUtWi1ua86g/aaofub/hBq2xR+HSnV91W 16 | Ycwewyfc/0j94kDOAFgSGOz0BscCgYEA0PUQXtuu05YTmz2TDtknCcQOVm/UnEg6 17 | 1FsKPzmoxWsAMtHXf3FbD3vHql1JfPTJPNcxEEL6fhA1l7ntailHltx8dt9bXmYJ 18 | ANM0n8uSKde5MoFbMhmyYTcRxJW9EC2ivqLotd5iL1mbfvdF02cWmr/5KNxUO1Hk 19 | 7TkJturwo3sCgYBc/gNxDEUhKX05BU/O+hz9QMgdVAf1aWK1r/5I/AoWBhAeSiMV 20 | slToA4oCGlwVqMPWWtXnCfSFm2YKsQNXgqBzlGA6otTLdZo3s1jfgyOaFhbmRshb 21 | 3jGkxRuDdUmpRJZAfSl/k/0exfN5lRTnaHM/U2WKfPTjQqSZRl4HzHIPMwKBgFVE 22 | W0zKClou+Is1oifB9wsmJM+izLiFRPRYviK0raj5k9gpBu3rXMRBt2VOsek6nk+k 23 | ZFIFcuA0Txo99aKHe74U9PkxBcDMlEnw5Z17XYaTj/ALFyKnl8HRzf9RNxg99xYh 24 | tiJYv+ogf7JcxvKQM4osYkkJN5oJPgiLaOpqjo23AoGBAN3g5kvsYj3OKGh89pGk 25 | osLeL+NNUBDvFsrvFzPMwPGDup6AB1qX1pc4RfyQGzDJqUSTpioWI5v1O6Pmoiak 26 | FO0u08Tb/091Bir5kgglUSi7VnFD3v8ffeKpkkJvtYUj7S9yoH9NQPVhKVCq6mna 27 | TbGfXbnVfNmqgQh71+k02p6S 28 | -----END PRIVATE KEY----- -------------------------------------------------------------------------------- /docs/Examples/MultiHeaders/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.MultiHeaders.Main where 2 | 3 | import Prelude 4 | 5 | import Data.Foldable as Data.Foldable 6 | import Data.Maybe (maybe) 7 | import Data.Tuple (Tuple(..)) 8 | import Effect.Console (log) 9 | import HTTPure (MultiHeaders, Request, ResponseM, ServerM, ok, serve, (!!)) 10 | import HTTPure.MultiHeaders as HTTPure.MultiHeaders 11 | 12 | -- | The headers that will be included in every response. 13 | responseHeaders :: MultiHeaders 14 | responseHeaders = 15 | HTTPure.MultiHeaders.headers 16 | [ Tuple "Set-Cookie" "id=123456" 17 | , Tuple "Set-Cookie" "domain=foo.example.com" 18 | ] 19 | 20 | -- | Route to the correct handler 21 | router :: Request -> ResponseM 22 | router { multiHeaders } = ado 23 | response <- 24 | ok 25 | $ maybe "" (Data.Foldable.intercalate ", ") 26 | $ multiHeaders !! "X-Input" 27 | in response { multiHeaders = responseHeaders } 28 | 29 | -- | Boot up the server 30 | main :: ServerM 31 | main = 32 | serve 8080 router do 33 | log " ┌───────────────────────────────────────────────────────────────────┐" 34 | log " │ Server now up on port 8080 │" 35 | log " │ │" 36 | log " │ To test, run: │" 37 | log " │ > curl -H 'X-Input: test1' -H 'X-Input: test2' -v localhost:8080 │" 38 | log " │ # => ... │" 39 | log " │ # => ...< Set-Cookie: id=123456 │" 40 | log " │ # => ...< Set-Cookie: domain=foo.example.com │" 41 | log " │ # => ... │" 42 | log " │ # => test1, test2 │" 43 | log " └───────────────────────────────────────────────────────────────────┘" 44 | -------------------------------------------------------------------------------- /sources.json: -------------------------------------------------------------------------------- 1 | { 2 | "alejandra": { 3 | "branch": "main", 4 | "description": "The Uncompromising Nix Code Formatter", 5 | "homepage": "https://kamadorueda.github.io/alejandra/", 6 | "owner": "kamadorueda", 7 | "repo": "alejandra", 8 | "rev": "00670576da082d85a51a53f58474b627ed7a5e21", 9 | "sha256": "0mnf9yfbz58m9k6x5db808a8byp94yzgmmarz3zabi4xvsdihl8q", 10 | "type": "tarball", 11 | "url": "https://github.com/kamadorueda/alejandra/archive/00670576da082d85a51a53f58474b627ed7a5e21.tar.gz", 12 | "url_template": "https://github.com///archive/.tar.gz" 13 | }, 14 | "easy-purescript-nix": { 15 | "branch": "master", 16 | "description": "Easy PureScript (and other tools) with Nix", 17 | "homepage": "", 18 | "owner": "justinwoo", 19 | "repo": "easy-purescript-nix", 20 | "rev": "0ad5775c1e80cdd952527db2da969982e39ff592", 21 | "sha256": "0x53ads5v8zqsk4r1mfpzf5913byifdpv5shnvxpgw634ifyj1kg", 22 | "type": "tarball", 23 | "url": "https://github.com/justinwoo/easy-purescript-nix/archive/0ad5775c1e80cdd952527db2da969982e39ff592.tar.gz", 24 | "url_template": "https://github.com///archive/.tar.gz" 25 | }, 26 | "nixpkgs": { 27 | "branch": "master", 28 | "description": "A read-only mirror of NixOS/nixpkgs tracking the released channels. Send issues and PRs to", 29 | "homepage": "https://github.com/NixOS/nixpkgs", 30 | "owner": "NixOS", 31 | "repo": "nixpkgs", 32 | "rev": "af911e8452bd05d40674bf603332f37480ceb03d", 33 | "sha256": "1wxx4zdvqxfslqvx17jz1blndybx5jkqsp5rb5qyma1y59jsbpy3", 34 | "type": "tarball", 35 | "url": "https://github.com/NixOS/nixpkgs/archive/af911e8452bd05d40674bf603332f37480ceb03d.tar.gz", 36 | "url_template": "https://github.com///archive/.tar.gz" 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /test/Test/HTTPure/LookupSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.LookupSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(Nothing, Just)) 6 | import Foreign.Object (singleton) 7 | import HTTPure.Lookup ((!!), (!?), (!@)) 8 | import Test.HTTPure.TestHelpers (Test, (?=)) 9 | import Test.Spec (describe, it) 10 | 11 | atSpec :: Test 12 | atSpec = 13 | describe "at" do 14 | describe "when the lookup returns a Just" do 15 | it "is the value inside the Just" do 16 | [ "one", "two", "three" ] !@ 1 ?= "two" 17 | describe "when the lookup returns a Nothing" do 18 | it "is mempty" do 19 | [ "one", "two", "three" ] !@ 4 ?= "" 20 | 21 | hasSpec :: Test 22 | hasSpec = 23 | describe "has" do 24 | describe "when the lookup returns a Just" do 25 | it "is true" do 26 | [ "one", "two", "three" ] !? 1 ?= true 27 | describe "when the lookup returns a Nothing" do 28 | it "is false" do 29 | [ "one", "two", "three" ] !? 4 ?= false 30 | 31 | lookupFunctionSpec :: Test 32 | lookupFunctionSpec = 33 | describe "lookup" do 34 | describe "Array" do 35 | describe "when the index is in bounds" do 36 | it "is Just the value at the index" do 37 | [ "one", "two", "three" ] !! 1 ?= Just "two" 38 | describe "when the index is out of bounds" do 39 | it "is Nothing" do 40 | (([ "one", "two", "three" ] !! 4) :: Maybe String) ?= Nothing 41 | describe "Map" do 42 | describe "when the key is in the Map" do 43 | it "is Just the value at the given key" do 44 | let mockMap = singleton "foo" "bar" 45 | mockMap !! "foo" ?= Just "bar" 46 | describe "when the key is not in the Map" do 47 | it "is Nothing" do 48 | let mockMap = singleton "foo" "bar" 49 | ((mockMap !! "baz") :: Maybe String) ?= Nothing 50 | 51 | lookupSpec :: Test 52 | lookupSpec = 53 | describe "Lookup" do 54 | atSpec 55 | hasSpec 56 | lookupFunctionSpec 57 | -------------------------------------------------------------------------------- /.github/workflows/check.yaml: -------------------------------------------------------------------------------- 1 | name: Check 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - main 8 | - "v[0-9]*.[0-9]*.x" 9 | 10 | jobs: 11 | Test: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - name: Check out codebase 15 | uses: actions/checkout@v3 16 | 17 | - name: Install nix 18 | uses: cachix/install-nix-action@v15 19 | with: 20 | nix_path: nixpkgs=channel:nixpkgs-unstable 21 | 22 | - name: Install environment 23 | run: nix-shell 24 | 25 | - name: Build 26 | run: nix-shell --run "build test" 27 | 28 | - name: Test 29 | run: nix-shell --run check-code 30 | 31 | Validate_Purescript_Format: 32 | runs-on: ubuntu-latest 33 | steps: 34 | - name: Check out codebase 35 | uses: actions/checkout@v3 36 | 37 | - name: Install nix 38 | uses: cachix/install-nix-action@v15 39 | with: 40 | nix_path: nixpkgs=channel:nixpkgs-unstable 41 | 42 | - name: Install environment 43 | run: nix-shell 44 | 45 | - name: Validate Format 46 | run: nix-shell --run check-format-purescript 47 | 48 | Validate_Nix_Format: 49 | runs-on: ubuntu-latest 50 | steps: 51 | - name: Check out codebase 52 | uses: actions/checkout@v3 53 | 54 | - name: Install nix 55 | uses: cachix/install-nix-action@v15 56 | with: 57 | nix_path: nixpkgs=channel:nixpkgs-unstable 58 | 59 | - name: Install environment 60 | run: nix-shell 61 | 62 | - name: Validate Format 63 | run: nix-shell --run check-format-nix 64 | 65 | Validate_Pulp: 66 | runs-on: ubuntu-latest 67 | steps: 68 | - name: Check out codebase 69 | uses: actions/checkout@v3 70 | 71 | - name: Install nix 72 | uses: cachix/install-nix-action@v15 73 | with: 74 | nix_path: nixpkgs=channel:nixpkgs-unstable 75 | 76 | - name: Install environment 77 | run: nix-shell 78 | 79 | - name: Verify Pulp and bower 80 | run: nix-shell --run check-pulp 81 | -------------------------------------------------------------------------------- /test/Test/HTTPure/VersionSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.VersionSpec where 2 | 3 | import Prelude 4 | 5 | import HTTPure.Version 6 | ( Version(HTTP0_9, HTTP1_0, HTTP1_1, HTTP2_0, HTTP3_0, Other) 7 | , read 8 | ) 9 | import Test.HTTPure.TestHelpers (Test, mockRequest, (?=)) 10 | import Test.Spec (describe, it) 11 | 12 | showSpec :: Test 13 | showSpec = 14 | describe "show" do 15 | describe "with an HTTP0_9" do 16 | it "is 'HTTP0_9'" do 17 | show HTTP0_9 ?= "HTTP/0.9" 18 | describe "with an HTTP1_0" do 19 | it "is 'HTTP1_0'" do 20 | show HTTP1_0 ?= "HTTP/1.0" 21 | describe "with an HTTP1_1" do 22 | it "is 'HTTP1_1'" do 23 | show HTTP1_1 ?= "HTTP/1.1" 24 | describe "with an HTTP2_0" do 25 | it "is 'HTTP2_0'" do 26 | show HTTP2_0 ?= "HTTP/2.0" 27 | describe "with an HTTP3_0" do 28 | it "is 'HTTP3_0'" do 29 | show HTTP3_0 ?= "HTTP/3.0" 30 | describe "with an Other" do 31 | it "is 'Other'" do 32 | show (Other "version") ?= "HTTP/version" 33 | 34 | readSpec :: Test 35 | readSpec = 36 | describe "read" do 37 | describe "with an 'HTTP0_9' Request" do 38 | it "is HTTP0_9" do 39 | request <- mockRequest "0.9" "" "" "" [] 40 | read request ?= HTTP0_9 41 | describe "with an 'HTTP1_0' Request" do 42 | it "is HTTP1_0" do 43 | request <- mockRequest "1.0" "" "" "" [] 44 | read request ?= HTTP1_0 45 | describe "with an 'HTTP1_1' Request" do 46 | it "is HTTP1_1" do 47 | request <- mockRequest "1.1" "" "" "" [] 48 | read request ?= HTTP1_1 49 | describe "with an 'HTTP2_0' Request" do 50 | it "is HTTP2_0" do 51 | request <- mockRequest "2.0" "" "" "" [] 52 | read request ?= HTTP2_0 53 | describe "with an 'HTTP3_0' Request" do 54 | it "is HTTP3_0" do 55 | request <- mockRequest "3.0" "" "" "" [] 56 | read request ?= HTTP3_0 57 | describe "with an 'Other' Request" do 58 | it "is Other" do 59 | request <- mockRequest "version" "" "" "" [] 60 | read request ?= Other "version" 61 | 62 | versionSpec :: Test 63 | versionSpec = 64 | describe "Version" do 65 | showSpec 66 | readSpec 67 | -------------------------------------------------------------------------------- /test/Test/HTTPure/QuerySpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.QuerySpec where 2 | 3 | import Prelude 4 | 5 | import Data.Tuple (Tuple(Tuple)) 6 | import Foreign.Object (empty, fromFoldable, singleton) 7 | import HTTPure.Query (read) 8 | import Test.HTTPure.TestHelpers (Test, mockRequest, (?=)) 9 | import Test.Spec (describe, it) 10 | 11 | readSpec :: Test 12 | readSpec = 13 | describe "read" do 14 | describe "with no query string" do 15 | it "is an empty Map" do 16 | req <- mockRequest "" "" "/test" "" [] 17 | read req ?= empty 18 | describe "with an empty query string" do 19 | it "is an empty Map" do 20 | req <- mockRequest "" "" "/test?" "" [] 21 | read req ?= empty 22 | describe "with a query parameter in the query string" do 23 | it "is a correct Map" do 24 | req <- mockRequest "" "" "/test?a=b" "" [] 25 | read req ?= singleton "a" "b" 26 | describe "with empty fields in the query string" do 27 | it "ignores the empty fields" do 28 | req <- mockRequest "" "" "/test?&&a=b&&" "" [] 29 | read req ?= singleton "a" "b" 30 | describe "with duplicated params" do 31 | it "takes the last param value" do 32 | req <- mockRequest "" "" "/test?a=b&a=c" "" [] 33 | read req ?= singleton "a" "c" 34 | describe "with empty params" do 35 | it "uses '' as the value" do 36 | req <- mockRequest "" "" "/test?a" "" [] 37 | read req ?= singleton "a" "" 38 | describe "with complex params" do 39 | it "is the correct Map" do 40 | req <- mockRequest "" "" "/test?&&a&b=c&b=d&&&e=f&g=&" "" [] 41 | let 42 | expectedComplexResult = 43 | fromFoldable 44 | [ Tuple "a" "" 45 | , Tuple "b" "d" 46 | , Tuple "e" "f" 47 | , Tuple "g" "" 48 | ] 49 | read req ?= expectedComplexResult 50 | describe "with urlencoded params" do 51 | it "decodes valid keys and values" do 52 | req <- mockRequest "" "" "/test?foo%20bar=%3Fx%3Dtest" "" [] 53 | read req ?= singleton "foo bar" "?x=test" 54 | it "passes invalid keys and values through" do 55 | req <- mockRequest "" "" "/test?%%=%C3" "" [] 56 | read req ?= singleton "%%" "%C3" 57 | it "converts + to a space" do 58 | req <- mockRequest "" "" "/test?foo=bar+baz" "" [] 59 | read req ?= singleton "foo" "bar baz" 60 | 61 | querySpec :: Test 62 | querySpec = 63 | describe "Query" do 64 | readSpec 65 | -------------------------------------------------------------------------------- /src/HTTPure/Request.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Request 2 | ( Request 3 | , fromHTTPRequest 4 | , fullPath 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Data.String (joinWith) 10 | import Effect.Aff (Aff) 11 | import Effect.Class (liftEffect) 12 | import Foreign.Object (isEmpty, toArrayWithKey) 13 | import HTTPure.Body (RequestBody) 14 | import HTTPure.Body (read) as Body 15 | import HTTPure.Headers (Headers) 16 | import HTTPure.Headers (read) as Headers 17 | import HTTPure.Method (Method) 18 | import HTTPure.Method (read) as Method 19 | import HTTPure.MultiHeaders (MultiHeaders) 20 | import HTTPure.MultiHeaders as HTTPure.MultiHeaders 21 | import HTTPure.Path (Path) 22 | import HTTPure.Path (read) as Path 23 | import HTTPure.Query (Query) 24 | import HTTPure.Query (read) as Query 25 | import HTTPure.Utils (encodeURIComponent) 26 | import HTTPure.Version (Version) 27 | import HTTPure.Version (read) as Version 28 | import Node.HTTP (Request) as HTTP 29 | import Node.HTTP (requestURL) 30 | 31 | -- | The `Request` type is a `Record` type that includes fields for accessing 32 | -- | the different parts of the HTTP request. 33 | type Request = 34 | { method :: Method 35 | , path :: Path 36 | , query :: Query 37 | , headers :: Headers 38 | , multiHeaders :: MultiHeaders 39 | , body :: RequestBody 40 | , httpVersion :: Version 41 | , url :: String 42 | } 43 | 44 | -- | Return the full resolved path, including query parameters. This may not 45 | -- | match the requested path--for instance, if there are empty path segments in 46 | -- | the request--but it is equivalent. 47 | fullPath :: Request -> String 48 | fullPath request = "/" <> path <> questionMark <> queryParams 49 | where 50 | path = joinWith "/" request.path 51 | questionMark = if isEmpty request.query then "" else "?" 52 | queryParams = joinWith "&" queryParamsArr 53 | queryParamsArr = toArrayWithKey stringifyQueryParam request.query 54 | stringifyQueryParam key value = encodeURIComponent key <> "=" <> encodeURIComponent value 55 | 56 | -- | Given an HTTP `Request` object, this method will convert it to an HTTPure 57 | -- | `Request` object. 58 | fromHTTPRequest :: HTTP.Request -> Aff Request 59 | fromHTTPRequest request = do 60 | body <- liftEffect $ Body.read request 61 | pure 62 | { method: Method.read request 63 | , path: Path.read request 64 | , query: Query.read request 65 | , headers: Headers.read request 66 | , multiHeaders: HTTPure.MultiHeaders.read request 67 | , body 68 | , httpVersion: Version.read request 69 | , url: requestURL request 70 | } 71 | -------------------------------------------------------------------------------- /Contributing.md: -------------------------------------------------------------------------------- 1 | # HTTPure Contributing Guide 2 | 3 | Welcome to HTTPure! We would love contributions from the community. Please 4 | follow this guide when creating contributions to help make the project better! 5 | 6 | ## Logging Issues 7 | 8 | If you find a bug or a place where documentation needs to be improved, or if you 9 | have a feature request, 10 | please 11 | [submit an issue](https://github.com/citizennet/purescript-httpure/issues/new)! In 12 | issues you submit, please be clear, and preferably have code examples indicating 13 | what is broken, needs improvement, or what your requested API should look like. 14 | 15 | ## Contributions 16 | 17 | All contributions to this repository should come in the form of pull requests. 18 | All pull requests must be reviewed before being merged. Please follow these 19 | steps for creating a successful PR: 20 | 21 | 1. [Create an issue](https://github.com/citizennet/purescript-httpure/issues/new) 22 | for your contribution. 23 | 2. [Create a fork](https://github.com/citizennet/purescript-httpure) on github. 24 | 3. Create a branch in your fork for your contribution. 25 | 4. Add your contribution to the source tree. 26 | 5. Run the test suite. All tests MUST pass for a PR to be accepted. 27 | 6. Push your code and create a PR on github. Please make sure to reference your 28 | issue number in your PR description. 29 | 30 | Branch all work off the `main` branch. 31 | 32 | ### Documentation 33 | 34 | For the most part, HTTPure's documentation is intended to be consumed 35 | through [Pursuit](http://pursuit.purescript.org/packages/purescript-httpure). To 36 | this end, documentation should mostly be provided inline in the codebase, and 37 | should follow the same PR process as other commits. 38 | 39 | We also welcome documentation in the form of guides and examples. These should 40 | live in the [Documentation](./docs) directory. Please ensure all guides are 41 | written in markdown format, and all examples are fully-functional and 42 | implemented as self-contained subdirectories 43 | under [Documentation/Examples](./docs/Examples). 44 | 45 | All examples should have corresponding integration tests, to ensure that 46 | examples we promote remain functional. If you plan to contribute examples, 47 | please take a look at 48 | [IntegrationSpec.purs](./test/Test/HTTPure/IntegrationSpec.purs). 49 | 50 | ### Code 51 | 52 | Code should follow existing styles and all code should be accompanied with 53 | relevant unit/integration tests. If you fix a bug, write a test. If you write a 54 | new feature, write a test. 55 | 56 | All tests MUST pass for your PR to be accepted. If you break a test, either fix 57 | the test or fix the code. 58 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { 2 | sources ? import ./sources.nix, 3 | nixpkgs ? sources.nixpkgs, 4 | easy-purescript-nix ? sources.easy-purescript-nix, 5 | alejandra ? sources.alejandra, 6 | }: let 7 | niv-overlay = self: super: { 8 | niv = self.symlinkJoin { 9 | name = "niv"; 10 | paths = [super.niv]; 11 | buildInputs = [self.makeWrapper]; 12 | postBuild = '' 13 | wrapProgram $out/bin/niv \ 14 | --add-flags "--sources-file ${toString ./sources.json}" 15 | ''; 16 | }; 17 | }; 18 | 19 | easy-purescript-nix-overlay = pkgs: _: { 20 | inherit (import easy-purescript-nix {inherit pkgs;}) purescript purs-tidy spago psa pulp-16_0_0-0; 21 | }; 22 | 23 | alejandra-overlay = self: _: { 24 | alejandra = (import alejandra)."${self.system}"; 25 | }; 26 | 27 | pkgs = import nixpkgs { 28 | overlays = [ 29 | niv-overlay 30 | easy-purescript-nix-overlay 31 | alejandra-overlay 32 | ]; 33 | }; 34 | 35 | scripts = pkgs.symlinkJoin { 36 | name = "scripts"; 37 | paths = pkgs.lib.mapAttrsToList pkgs.writeShellScriptBin { 38 | build = "spago -x \${1:-spago}.dhall build"; 39 | check = "check-format && check-code && check-pulp"; 40 | check-code = "spago -x test.dhall test"; 41 | check-format = "check-format-purescript && check-format-nix"; 42 | check-format-nix = "alejandra --check *.nix"; 43 | check-format-purescript = "purs-tidy check src test docs"; 44 | check-pulp = "bower install && pulp build"; 45 | clean = "rm -rf output .psci_modules .spago"; 46 | example = '' 47 | if [ "$1" ] 48 | then 49 | spago -x test.dhall run --main Examples.$1.Main 50 | else 51 | echo "Which example would you like to run?\n\nAvailable examples:" 52 | ls -1 ./docs/Examples | cat -n 53 | read -rp " > " out 54 | if [ "$out" ] 55 | then 56 | $0 $(ls -1 ./docs/Examples | sed "''${out}q;d") 57 | fi 58 | fi 59 | ''; 60 | format = "format-purescript && format-nix"; 61 | format-nix = "alejandra *.nix"; 62 | format-purescript = "purs-tidy format-in-place src test docs"; 63 | generate-bower = "spago bump-version patch --no-dry-run"; 64 | generate-docs = "spago docs"; 65 | repl = "spago repl"; 66 | }; 67 | }; 68 | in 69 | pkgs.mkShell { 70 | buildInputs = [ 71 | pkgs.alejandra 72 | pkgs.git 73 | pkgs.niv 74 | pkgs.nodePackages.bower 75 | pkgs.nodejs-16_x 76 | pkgs.psa 77 | pkgs.pulp-16_0_0-0 78 | pkgs.purescript 79 | pkgs.purs-tidy 80 | pkgs.spago 81 | scripts 82 | ]; 83 | } 84 | -------------------------------------------------------------------------------- /docs/Examples/Middleware/Main.purs: -------------------------------------------------------------------------------- 1 | module Examples.Middleware.Main where 2 | 3 | import Prelude 4 | 5 | import Effect.Class (liftEffect) 6 | import Effect.Console (log) 7 | import HTTPure (Request, ResponseM, ServerM, fullPath, header, ok, ok', serve) 8 | 9 | -- | A middleware that logs at the beginning and end of each request 10 | loggingMiddleware :: 11 | (Request -> ResponseM) -> 12 | Request -> 13 | ResponseM 14 | loggingMiddleware router request = do 15 | liftEffect $ log $ "Request starting for " <> path 16 | response <- router request 17 | liftEffect $ log $ "Request ending for " <> path 18 | pure response 19 | where 20 | path = fullPath request 21 | 22 | -- | A middleware that adds the X-Middleware header to the response, if it 23 | -- | wasn't already in the response 24 | headerMiddleware :: 25 | (Request -> ResponseM) -> 26 | Request -> 27 | ResponseM 28 | headerMiddleware router request = do 29 | response@{ headers } <- router request 30 | pure $ response { headers = header' <> headers } 31 | where 32 | header' = header "X-Middleware" "middleware" 33 | 34 | -- | A middleware that sends the body "Middleware!" instead of running the 35 | -- | router when requesting /middleware 36 | pathMiddleware :: 37 | (Request -> ResponseM) -> 38 | Request -> 39 | ResponseM 40 | pathMiddleware _ { path: [ "middleware" ] } = ok "Middleware!" 41 | pathMiddleware router request = router request 42 | 43 | -- | Say 'hello' when run, and add a default value to the X-Middleware header 44 | sayHello :: Request -> ResponseM 45 | sayHello _ = ok' (header "X-Middleware" "router") "hello" 46 | 47 | -- | The stack of middlewares to use for the server 48 | middlewareStack :: (Request -> ResponseM) -> Request -> ResponseM 49 | middlewareStack = loggingMiddleware <<< headerMiddleware <<< pathMiddleware 50 | 51 | -- | Boot up the server 52 | main :: ServerM 53 | main = 54 | serve 8080 (middlewareStack sayHello) do 55 | log " ┌───────────────────────────────────────┐" 56 | log " │ Server now up on port 8080 │" 57 | log " │ │" 58 | log " │ To test, run: │" 59 | log " │ > curl -v localhost:8080 │" 60 | log " │ # => ... │" 61 | log " │ # => ...< X-Middleware: router │" 62 | log " │ # => ... │" 63 | log " │ # => hello │" 64 | log " │ > curl -v localhost:8080/middleware │" 65 | log " │ # => ... │" 66 | log " │ # => ...< X-Middleware: middleware │" 67 | log " │ # => ... │" 68 | log " │ # => Middleware! │" 69 | log " └───────────────────────────────────────┘" 70 | -------------------------------------------------------------------------------- /src/HTTPure/Lookup.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Lookup 2 | ( class Lookup 3 | , at 4 | , (!@) 5 | , has 6 | , (!?) 7 | , lookup 8 | , (!!) 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Data.Array (index) 14 | import Data.Map (Map) 15 | import Data.Map (lookup) as Map 16 | import Data.Maybe (Maybe, fromMaybe, isJust) 17 | import Data.String.CaseInsensitive (CaseInsensitiveString(CaseInsensitiveString)) 18 | import Foreign.Object (Object) 19 | import Foreign.Object (lookup) as Object 20 | 21 | -- | Types that implement the `Lookup` class can be looked up by some key to 22 | -- | retrieve some value. For instance, you could have an implementation for 23 | -- | `String Int String` where `lookup s i` returns `Just` a `String` containing 24 | -- | the character in `s` at `i`, or `Nothing` if `i` is out of bounds. 25 | class Lookup c k r | c -> r where 26 | -- | Given some type and a key on that type, extract some value that 27 | -- | corresponds to that key. 28 | lookup :: c -> k -> Maybe r 29 | 30 | -- | `!!` is inspired by `!!` in `Data.Array`, but note that it differs from 31 | -- | `!!` in `Data.Array` in that you can use `!!` for any other instance of 32 | -- | `Lookup`. 33 | infixl 8 lookup as !! 34 | 35 | -- | The instance of `Lookup` for an `Array` is just `!!` as defined in 36 | -- | `Data.Array`. 37 | instance lookupArray :: Lookup (Array t) Int t where 38 | lookup = index 39 | 40 | -- | The instance of `Lookup` for a `Object` just uses `Object.lookup` (but 41 | -- | flipped, because `Object.lookup` expects the key first, which would end up 42 | -- | with a really weird API for `!!`). 43 | instance lookupObject :: Lookup (Object t) String t where 44 | lookup = flip Object.lookup 45 | 46 | -- | The instance of `Lookup` for a `Map CaseInsensitiveString` converts the 47 | -- | `String` to a `CaseInsensitiveString` for lookup. 48 | instance lookupMapCaseInsensitiveString :: 49 | Lookup (Map CaseInsensitiveString t) String t where 50 | lookup set key = Map.lookup (CaseInsensitiveString key) set 51 | 52 | -- | This simple helper works on any `Lookup` instance where the return type is 53 | -- | a `Monoid`, and is the same as `lookup` except that it returns a `t` 54 | -- | instead of a `Maybe t`. If `lookup` would return `Nothing`, then `at` 55 | -- | returns `mempty`. 56 | at :: forall c k r. Monoid r => Lookup c k r => c -> k -> r 57 | at set = fromMaybe mempty <<< lookup set 58 | 59 | -- | Expose `at` as the infix operator `!@` 60 | infixl 8 at as !@ 61 | 62 | -- | This simple helper works on any `Lookup` instance, where the container set 63 | -- | has a single type variable, and returns a `Boolean` indicating if the given 64 | -- | key matches any value in the given container. 65 | has :: forall c k r. Lookup (c r) k r => c r -> k -> Boolean 66 | has set key = isJust ((lookup set key) :: Maybe r) 67 | 68 | -- | Expose `has` as the infix operator `!?` 69 | infixl 8 has as !? 70 | -------------------------------------------------------------------------------- /docs/Basics.md: -------------------------------------------------------------------------------- 1 | # HTTPure Basics 2 | 3 | This guide is a brief overview of the basics of creating a HTTPure server. 4 | 5 | ## Creating a Server 6 | 7 | To create a server, use `HTTPure.serve` (no SSL) or `HTTPure.serveSecure` (SSL). 8 | Both of these functions take a port number, a router function, and an `Effect` 9 | that will run once the server has booted. The signature of the router function 10 | is: 11 | 12 | ```purescript 13 | HTTPure.Request -> HTTPure.ResponseM 14 | ``` 15 | 16 | For more details on routing, see the [Routing guide](./Routing.md). For more 17 | details on responses, see the [Responses guide](./Responses.md). The router can 18 | be composed with middleware; for more details, see the [Middleware 19 | guide](./Middleware.md). 20 | 21 | ## Non-SSL 22 | 23 | You can create an HTTPure server without SSL using `HTTPure.serve`: 24 | 25 | ```purescript 26 | main :: HTTPure.ServerM 27 | main = HTTPure.serve 8080 router $ log "Server up" 28 | ``` 29 | 30 | Most of the [examples](./Examples), besides [the SSL Example](./Examples/SSL), 31 | use this method to create the server. 32 | 33 | You can also create a server using a custom 34 | [`HTTP.ListenOptions`](http://bit.ly/2G42rLd) value: 35 | 36 | ```purescript 37 | main :: HTTPure.ServerM 38 | main = HTTPure.serve' customOptions router $ log "Server up" 39 | ``` 40 | 41 | ## SSL 42 | 43 | You can create an SSL-enabled HTTPure server using `HTTPure.serveSecure`, which 44 | has the same signature as `HTTPure.serve` except that it additionally takes a 45 | path to a cert file and a path to a key file after the port number: 46 | 47 | ```purescript 48 | main :: HTTPure.ServerM 49 | main = 50 | HTTPure.serveSecure 8080 "./Certificate.cer" "./Key.key" router $ 51 | log "Server up" 52 | ``` 53 | 54 | You can look at [the SSL Example](./Examples/SSL/Main.purs), which uses this 55 | method to create the server. 56 | 57 | You can also create a server using a 58 | [`HTTP.ListenOptions`](http://bit.ly/2G42rLd) and a 59 | [`HTTPS.SSLOptions`](http://bit.ly/2G3Aljr): 60 | 61 | ```purescript 62 | main :: HTTPure.ServerM 63 | main = 64 | HTTPure.serveSecure' customSSLOptions customOptions router $ 65 | log "Server up" 66 | ``` 67 | 68 | ## Shutdown hook 69 | 70 | To gracefully shut down a server you can add a shutdown hook. For this you will need to add the following dependencies: 71 | 72 | ``` 73 | posix-types 74 | node-process 75 | ``` 76 | 77 | Then take the closing handler returned by `serve` and create a `SIGINT` and `SIGTERM` hook: 78 | 79 | ```purescript 80 | import Prelude 81 | 82 | import Data.Posix.Signal (Signal(SIGINT, SIGTERM)) 83 | import Effect (Effect) 84 | import Effect.Console (log) 85 | import HTTPure (serve, ok) 86 | import Node.Process (onSignal) 87 | 88 | main :: Effect Unit 89 | main = do 90 | closingHandler <- serve 8080 (const $ ok "hello world!") do 91 | log $ "Server now up on port 8080" 92 | 93 | onSignal SIGINT $ closingHandler $ log "Received SIGINT, stopping service now." 94 | onSignal SIGTERM $ closingHandler $ log "Received SIGTERM, stopping service now." 95 | ``` 96 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | # HTTPure 2 | 3 | [![License](https://img.shields.io/badge/license-MIT-blue.svg)](https://raw.githubusercontent.com/citizennet/purescript-httpure/main/License) 4 | [![Latest release](http://img.shields.io/github/release/citizennet/purescript-httpure.svg)](https://github.com/citizennet/purescript-httpure/releases) 5 | [![purescript-httpure on Pursuit](https://pursuit.purescript.org/packages/purescript-httpure/badge)](https://pursuit.purescript.org/packages/purescript-httpure) 6 | 7 | A purescript HTTP server framework. 8 | 9 | HTTPure is: 10 | 11 | - Well-tested (see our [tests](./test/Test)) 12 | - Well-documented (see our [documentation](./docs)) 13 | - Built to take advantage of PureScript language features for flexible and 14 | extensible routing 15 | - Pure (no `set`, `get`, `use`, etc) 16 | 17 | ## Status 18 | 19 | This project is currently fairly stable, but has not reached it's 1.0 release 20 | yet. You can track what's left before it gets there by looking at our 21 | [roadmap](https://github.com/citizennet/purescript-httpure/projects). The API 22 | signatures are _mostly_ stable, but are subject to change before the 1.0 release 23 | if there's a good reason to change them. 24 | 25 | If you'd like to help us get to 1.0 quicker, please contribute! To get started, 26 | check our [contributing guide](./Contributing.md). 27 | 28 | ## Installation 29 | 30 | ```bash 31 | spago install httpure 32 | ``` 33 | 34 | ## Quick Start 35 | 36 | ```purescript 37 | module Main where 38 | 39 | import Prelude 40 | 41 | import Effect.Console (log) 42 | import HTTPure (ServerM, serve, ok) 43 | 44 | main :: ServerM 45 | main = serve 8080 router $ log "Server now up on port 8080" 46 | where 47 | router _ = ok "hello world!" 48 | ``` 49 | 50 | ## Documentation 51 | 52 | Module documentation is published 53 | on [Pursuit](http://pursuit.purescript.org/packages/purescript-httpure). 54 | 55 | You can also take a look at [our guides](./docs). 56 | 57 | ## Examples 58 | 59 | HTTPure ships with a number of [examples](./docs/Examples). To run an example, 60 | in the project root, run: 61 | 62 | ```bash 63 | nix-shell --run 'example ' 64 | ``` 65 | 66 | Or, without `nix`: 67 | 68 | ```bash 69 | spago -x test.dhall run --main Examples..Main 70 | ``` 71 | 72 | Each example's startup banner will include information on routes available on 73 | the example server. 74 | 75 | ## Testing 76 | 77 | To run the test suite, in the project root run: 78 | 79 | ```bash 80 | nix-shell --run check 81 | ``` 82 | 83 | Or, if `nix` isn't your thing: 84 | 85 | ```bash 86 | purs-tidy check src test docs && spago -x test.dhall test 87 | ``` 88 | 89 | ## Contributing 90 | 91 | We are open to accepting contributions! Please see 92 | the [contributing guide](Contributing.md). 93 | 94 | ## People 95 | 96 | HTTPure is written and maintained 97 | by [Connor Prussin](https://connor.prussin.net) and [Petri 98 | Lehtinen](http://www.digip.org/). 99 | 100 | We are open to accepting contributions! Please see 101 | the [contributing guide](./Contributing.md). 102 | 103 | ## License 104 | 105 | [MIT](./License) 106 | -------------------------------------------------------------------------------- /test/Test/HTTPure/RequestSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.RequestSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Tuple (Tuple(Tuple)) 6 | import Foreign.Object (singleton) 7 | import HTTPure.Body (toString) 8 | import HTTPure.Headers (headers) 9 | import HTTPure.Method (Method(Post)) 10 | import HTTPure.MultiHeaders as HTTPure.MultiHeaders 11 | import HTTPure.Request (fromHTTPRequest, fullPath) 12 | import HTTPure.Version (Version(HTTP1_1)) 13 | import Test.HTTPure.TestHelpers (Test, mockRequest, (?=)) 14 | import Test.Spec (describe, it) 15 | 16 | fromHTTPRequestSpec :: Test 17 | fromHTTPRequestSpec = 18 | describe "fromHTTPRequest" do 19 | it "contains the correct method" do 20 | mock <- mockRequest' 21 | mock.method ?= Post 22 | it "contains the correct path" do 23 | mock <- mockRequest' 24 | mock.path ?= [ "test" ] 25 | it "contains the correct query" do 26 | mock <- mockRequest' 27 | mock.query ?= singleton "a" "b" 28 | it "contains the correct headers" do 29 | mock <- mockRequest' 30 | mock.headers ?= headers mockHeaders 31 | it "contains the correct multi-headers" do 32 | mock <- mockRequest' 33 | mock.multiHeaders ?= HTTPure.MultiHeaders.headers mockHeaders 34 | it "contains the correct body" do 35 | mockBody <- mockRequest' >>= _.body >>> toString 36 | mockBody ?= "body" 37 | it "contains the correct httpVersion" do 38 | mock <- mockRequest' 39 | mock.httpVersion ?= HTTP1_1 40 | where 41 | mockHeaders = 42 | [ Tuple "Test" "test" 43 | , Tuple "TestMulti" "test1" 44 | , Tuple "TestMulti" "test2" 45 | ] 46 | 47 | mockHTTPRequest = mockRequest "1.1" "POST" "/test?a=b" "body" mockHeaders 48 | 49 | mockRequest' = mockHTTPRequest >>= fromHTTPRequest 50 | 51 | fullPathSpec :: Test 52 | fullPathSpec = 53 | describe "fullPath" do 54 | describe "without query parameters" do 55 | it "is correct" do 56 | mock <- mockRequest' "/foo/bar" 57 | fullPath mock ?= "/foo/bar" 58 | describe "with empty path segments" do 59 | it "strips the empty segments" do 60 | mock <- mockRequest' "//foo////bar/" 61 | fullPath mock ?= "/foo/bar" 62 | describe "with only query parameters" do 63 | it "is correct" do 64 | mock <- mockRequest' "?a=b&c=d" 65 | fullPath mock ?= "/?a=b&c=d" 66 | describe "with only empty query parameters" do 67 | it "is has the default value of '' for the empty parameters" do 68 | mock <- mockRequest' "?a" 69 | fullPath mock ?= "/?a=" 70 | describe "with query parameters that have special characters" do 71 | it "percent encodes query params" do 72 | mock <- mockRequest' "?a=%3Fx%3Dtest" 73 | fullPath mock ?= "/?a=%3Fx%3Dtest" 74 | describe "with empty query parameters" do 75 | it "strips out the empty arameters" do 76 | mock <- mockRequest' "?a=b&&&" 77 | fullPath mock ?= "/?a=b" 78 | describe "with a mix of segments and query parameters" do 79 | it "is correct" do 80 | mock <- mockRequest' "/foo///bar/?&a=b&&c" 81 | fullPath mock ?= "/foo/bar?a=b&c=" 82 | where 83 | mockHTTPRequest path = mockRequest "" "POST" path "body" [] 84 | 85 | mockRequest' path = mockHTTPRequest path >>= fromHTTPRequest 86 | 87 | requestSpec :: Test 88 | requestSpec = 89 | describe "Request" do 90 | fromHTTPRequestSpec 91 | fullPathSpec 92 | -------------------------------------------------------------------------------- /test/Test/HTTPure/ServerSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.ServerSpec where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Except (throwError) 6 | import Data.Maybe (Maybe(Nothing)) 7 | import Data.Options ((:=)) 8 | import Data.String (joinWith) 9 | import Effect.Class (liftEffect) 10 | import Effect.Exception (error) 11 | import Foreign.Object (empty) 12 | import HTTPure.Request (Request) 13 | import HTTPure.Response (ResponseM, ok) 14 | import HTTPure.Server (serve, serve', serveSecure, serveSecure') 15 | import Node.Encoding (Encoding(UTF8)) 16 | import Node.FS.Sync (readTextFile) 17 | import Node.HTTP.Secure (cert, certString, key, keyString) 18 | import Test.HTTPure.TestHelpers (Test, get, get', getStatus, (?=)) 19 | import Test.Spec (describe, it) 20 | import Test.Spec.Assertions (expectError) 21 | 22 | mockRouter :: Request -> ResponseM 23 | mockRouter { path } = ok $ "/" <> joinWith "/" path 24 | 25 | serveSpec :: Test 26 | serveSpec = 27 | describe "serve" do 28 | it "boots a server on the given port" do 29 | close <- liftEffect $ serve 8080 mockRouter $ pure unit 30 | out <- get 8080 empty "/test" 31 | liftEffect $ close $ pure unit 32 | out ?= "/test" 33 | it "responds with a 500 upon unhandled exceptions" do 34 | let router _ = throwError $ error "fail!" 35 | close <- liftEffect $ serve 8080 router $ pure unit 36 | status <- getStatus 8080 empty "/" 37 | liftEffect $ close $ pure unit 38 | status ?= 500 39 | 40 | serve'Spec :: Test 41 | serve'Spec = 42 | describe "serve'" do 43 | it "boots a server with the given options" do 44 | let options = { hostname: "localhost", port: 8080, backlog: Nothing } 45 | close <- 46 | liftEffect 47 | $ serve' options mockRouter 48 | $ pure unit 49 | out <- get 8080 empty "/test" 50 | liftEffect $ close $ pure unit 51 | out ?= "/test" 52 | 53 | serveSecureSpec :: Test 54 | serveSecureSpec = 55 | describe "serveSecure" do 56 | describe "with valid key and cert files" do 57 | it "boots a server on the given port" do 58 | close <- 59 | liftEffect 60 | $ serveSecure 8080 "./test/Mocks/Certificate.cer" "./test/Mocks/Key.key" mockRouter 61 | $ pure unit 62 | out <- get' 8080 empty "/test" 63 | liftEffect $ close $ pure unit 64 | out ?= "/test" 65 | describe "with invalid key and cert files" do 66 | it "throws" do 67 | expectError $ liftEffect 68 | $ serveSecure 8080 "" "" mockRouter 69 | $ pure unit 70 | 71 | serveSecure'Spec :: Test 72 | serveSecure'Spec = 73 | describe "serveSecure'" do 74 | describe "with valid key and cert files" do 75 | it "boots a server on the given port" do 76 | let 77 | options = { hostname: "localhost", port: 8080, backlog: Nothing } 78 | sslOptions = do 79 | cert' <- readTextFile UTF8 "./test/Mocks/Certificate.cer" 80 | key' <- readTextFile UTF8 "./test/Mocks/Key.key" 81 | pure $ key := keyString key' <> cert := certString cert' 82 | sslOpts <- liftEffect $ sslOptions 83 | close <- 84 | liftEffect 85 | $ serveSecure' sslOpts options mockRouter 86 | $ pure unit 87 | out <- get' 8080 empty "/test" 88 | liftEffect $ close $ pure unit 89 | out ?= "/test" 90 | 91 | serverSpec :: Test 92 | serverSpec = 93 | describe "Server" do 94 | serveSpec 95 | serve'Spec 96 | serveSecureSpec 97 | serveSecure'Spec 98 | -------------------------------------------------------------------------------- /src/HTTPure/Headers.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Headers 2 | ( Headers(..) 3 | , empty 4 | , headers 5 | , header 6 | , read 7 | , toString 8 | , write 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Data.Foldable (foldMap) 14 | import Data.FoldableWithIndex (foldMapWithIndex) 15 | import Data.Generic.Rep (class Generic) 16 | import Data.Map (Map, singleton, union) 17 | import Data.Map (empty) as Map 18 | import Data.Newtype (class Newtype, unwrap) 19 | import Data.Show.Generic (genericShow) 20 | import Data.String as Data.String 21 | import Data.String.CaseInsensitive (CaseInsensitiveString(CaseInsensitiveString)) 22 | import Data.TraversableWithIndex (traverseWithIndex) 23 | import Data.Tuple (Tuple, uncurry) 24 | import Effect (Effect) 25 | import Foreign.Object as Foreign.Object 26 | import HTTPure.Lookup (class Lookup, (!!)) 27 | import Node.HTTP (Request, Response, requestHeaders, setHeader) 28 | 29 | -- | The `Headers` type is just sugar for a `Object` of `Strings` 30 | -- | that represents the set of headers in an HTTP request or response. 31 | newtype Headers = Headers (Map CaseInsensitiveString String) 32 | 33 | derive instance newtypeHeaders :: Newtype Headers _ 34 | 35 | derive instance genericHeaders :: Generic Headers _ 36 | 37 | -- | Given a string, return a `Maybe` containing the value of the matching 38 | -- | header, if there is any. 39 | instance lookupHeaders :: Lookup Headers String String where 40 | lookup (Headers headers') key = headers' !! key 41 | 42 | instance showHeaders :: Show Headers where 43 | show = genericShow 44 | 45 | -- | Compare two `Headers` objects by comparing the underlying `Objects`. 46 | derive newtype instance eqHeaders :: Eq Headers 47 | 48 | -- | Allow one `Headers` objects to be appended to another. 49 | instance semigroupHeaders :: Semigroup Headers where 50 | append (Headers a) (Headers b) = Headers $ union b a 51 | 52 | instance monoidHeaders :: Monoid Headers where 53 | mempty = Headers Map.empty 54 | 55 | -- | Get the headers out of a HTTP `Request` object. 56 | -- | 57 | -- | We intentionally filter out "Set-Cookie" headers here as according to the 58 | -- | node.js docs, the "set-cookie" header is always represented as an array, 59 | -- | and trying to read it as `String` would cause a runtime type error. 60 | -- | See https://nodejs.org/api/http.html#messageheaders. 61 | read :: Request -> Headers 62 | read = Foreign.Object.foldMap header' <<< requestHeaders 63 | where 64 | header' :: String -> String -> Headers 65 | header' key 66 | | Data.String.toLower key == "set-cookie" = const mempty 67 | | otherwise = header key 68 | 69 | -- | Given an HTTP `Response` and a `Headers` object, return an effect that will 70 | -- | write the `Headers` to the `Response`. 71 | write :: Response -> Headers -> Effect Unit 72 | write response (Headers headers') = void $ traverseWithIndex writeField headers' 73 | where 74 | writeField key value = setHeader response (unwrap key) value 75 | 76 | -- | Return a `Headers` containing nothing. 77 | empty :: Headers 78 | empty = Headers Map.empty 79 | 80 | -- | Convert an `Array` of `Tuples` of 2 `Strings` to a `Headers` object. 81 | headers :: Array (Tuple String String) -> Headers 82 | headers = foldMap (uncurry header) 83 | 84 | -- | Create a singleton header from a key-value pair. 85 | header :: String -> String -> Headers 86 | header key = singleton (CaseInsensitiveString key) >>> Headers 87 | 88 | -- | Allow a `Headers` to be represented as a string. This string is formatted 89 | -- | in HTTP headers format. 90 | toString :: Headers -> String 91 | toString (Headers headersMap) = foldMapWithIndex showField headersMap <> "\n" 92 | where 93 | showField :: CaseInsensitiveString -> String -> String 94 | showField key value = unwrap key <> ": " <> value <> "\n" 95 | -------------------------------------------------------------------------------- /docs/Responses.md: -------------------------------------------------------------------------------- 1 | # Creating HTTPure Responses 2 | 3 | ## The Response Monad 4 | 5 | The `HTTPure.ResponseM` monad is the return type of the router function. It is 6 | an `Aff` type that contains an `HTTPure.Response`. Because it is an `Aff`, it 7 | transparent to add asynchronous behavior when you need. 8 | 9 | To see an example server taking advantage of asynchronous responses, see [the 10 | Async Response example](./Examples/AsyncResponse/Main.purs). 11 | 12 | ## Response Helpers 13 | 14 | HTTPure defines a number of helpers for creating response monads for all 15 | different HTTP response status codes. Some of these helpers take a body, for 16 | instance, `HTTPure.ok` and `HTTPure.partialContent`, and some do not, for 17 | instance `HTTPure.created` or `HTTPure.noContent`. There are prime functions 18 | corresponding to each helper--for instance, `HTTPure.ok'` and 19 | `HTTPure.created'`. The prime versions are the same as the base versions except 20 | they also return response headers--see the [Setting Response 21 | Headers](#setting-response-headers) section below for more details. 22 | 23 | For a full list of helpers, see the [Response](../src/HTTPure/Response.purs) 24 | module. 25 | 26 | In some cases, the defined helpers don't cover your needs--for instance, if 27 | HTTPure doesn't have a helper defined for some HTTP response code you care about 28 | (and you don't want to [contribute it](../Contributing.md)--hint hint, you 29 | should contribute it!), or if you need to specify a body where normally one 30 | wouldn't be sent. For these cases, you can use `HTTPure.response`, which takes a 31 | status code and a body. If you need to specify headers, use `HTTPure.response'`. 32 | If you don't need to specify a body, you can use `HTTPure.emptyResponse` or 33 | `HTTPure.emptyResponse'`. 34 | 35 | ## Raw Responses 36 | 37 | The `HTTPure.ResponseM` monad contains a `HTTPure.Response` value, which is a 38 | `Record` type containing the following fields: 39 | 40 | - `status` - An `Int` HTTP response status code. 41 | - `headers` - A `HTTPure.Headers` containing the HTTP response headers. 42 | - `body` - A `String` containing the HTTP response body. 43 | 44 | You can manually construct a response if you want to: 45 | 46 | ```purescript 47 | router _ = pure $ { status: 200, headers: HTTPure.headers [], body: "foo" } 48 | ``` 49 | 50 | This can be useful in some circumstances, but in the vast majority of cases it's 51 | recommended that you use the response helpers described above -- they are more 52 | explicit and allow you to avoid using magic numbers in your code for HTTP status 53 | codes. 54 | 55 | ## Setting Response Headers 56 | 57 | If you need to return response headers, you can do so using the prime versions 58 | of the response helpers. These functions take an `HTTPure.Headers` object. You 59 | can construct an `HTTPure.Headers` in a few ways: 60 | 61 | - `HTTPure.empty` - Construct an empty `HTTPure.Headers` 62 | - `HTTPure.header` - Given a string with a header name and a string with a 63 | value, construct a singleton `HTTPure.Headers`. For instance: 64 | 65 | ```purescript 66 | headers = HTTPure.header "X-My-Header" "value" 67 | ``` 68 | 69 | - `HTTPure.headers` - Construct a `HTTPure.Headers` from an `Array` of `Tuples` 70 | of two `Strings`, where the first `String` is the header name and the second 71 | `String` is the header value. For instance: 72 | 73 | ```purescript 74 | headers = HTTPure.headers 75 | [ Tuple "X-Header-A" "valueA" 76 | , Tuple "X-Header-B" "valueB" 77 | ] 78 | ``` 79 | 80 | Because `HTTPure.Headers` has an instance of `Semigroup`, you can also append 81 | `HTTPure.Headers` objects: 82 | 83 | ```purescript 84 | headers = 85 | HTTPure.header "X-Header-A" "valueA" <> HTTPure.header "X-Header-B" "valueB" 86 | ``` 87 | 88 | To see an example server that sets response headers, see [the Headers 89 | example](./Examples/Headers/Main.purs). 90 | -------------------------------------------------------------------------------- /src/HTTPure.purs: -------------------------------------------------------------------------------- 1 | module HTTPure 2 | ( module HTTPure.Body 3 | , module HTTPure.Headers 4 | , module HTTPure.Lookup 5 | , module HTTPure.Method 6 | , module HTTPure.MultiHeaders 7 | , module HTTPure.Path 8 | , module HTTPure.Query 9 | , module HTTPure.Request 10 | , module HTTPure.Response 11 | , module HTTPure.Server 12 | , module HTTPure.Status 13 | ) where 14 | 15 | import HTTPure.Body (toBuffer, toStream, toString) 16 | import HTTPure.Headers (Headers, empty, header, headers) 17 | import HTTPure.Lookup (at, has, lookup, (!!), (!?), (!@)) 18 | import HTTPure.Method (Method(..)) 19 | import HTTPure.MultiHeaders (MultiHeaders) 20 | import HTTPure.Path (Path) 21 | import HTTPure.Query (Query) 22 | import HTTPure.Request (Request, fullPath) 23 | import HTTPure.Response 24 | ( Response 25 | , ResponseM 26 | , accepted 27 | , accepted' 28 | , alreadyReported 29 | , alreadyReported' 30 | -- 1xx 31 | , badGateway 32 | , badGateway' 33 | , badRequest 34 | , badRequest' 35 | , conflict 36 | , conflict' 37 | -- 2xx 38 | , continue 39 | , continue' 40 | , created 41 | , created' 42 | , emptyResponse 43 | , emptyResponse' 44 | , expectationFailed 45 | , expectationFailed' 46 | , failedDependency 47 | , failedDependency' 48 | , forbidden 49 | , forbidden' 50 | , found 51 | , found' 52 | , gatewayTimeout 53 | , gatewayTimeout' 54 | , gone 55 | , gone' 56 | , hTTPVersionNotSupported 57 | , hTTPVersionNotSupported' 58 | -- 3xx 59 | , iMUsed 60 | , iMUsed' 61 | , imATeapot 62 | , imATeapot' 63 | , insufficientStorage 64 | , insufficientStorage' 65 | , internalServerError 66 | , internalServerError' 67 | , lengthRequired 68 | , lengthRequired' 69 | , locked 70 | , locked' 71 | , loopDetected 72 | , loopDetected' 73 | , methodNotAllowed 74 | , methodNotAllowed' 75 | -- 4xx 76 | , misdirectedRequest 77 | , misdirectedRequest' 78 | , movedPermanently 79 | , movedPermanently' 80 | , multiStatus 81 | , multiStatus' 82 | , multipleChoices 83 | , multipleChoices' 84 | , networkAuthenticationRequired 85 | , networkAuthenticationRequired' 86 | , noContent 87 | , noContent' 88 | , nonAuthoritativeInformation 89 | , nonAuthoritativeInformation' 90 | , notAcceptable 91 | , notAcceptable' 92 | , notExtended 93 | , notExtended' 94 | , notFound 95 | , notFound' 96 | , notImplemented 97 | , notImplemented' 98 | , notModified 99 | , notModified' 100 | , ok 101 | , ok' 102 | , partialContent 103 | , partialContent' 104 | , payloadTooLarge 105 | , payloadTooLarge' 106 | , paymentRequired 107 | , paymentRequired' 108 | , permanentRedirect 109 | , permanentRedirect' 110 | , preconditionFailed 111 | , preconditionFailed' 112 | , preconditionRequired 113 | , preconditionRequired' 114 | , processing 115 | , processing' 116 | , proxyAuthenticationRequired 117 | , proxyAuthenticationRequired' 118 | , rangeNotSatisfiable 119 | , rangeNotSatisfiable' 120 | , requestHeaderFieldsTooLarge 121 | , requestHeaderFieldsTooLarge' 122 | , requestTimeout 123 | , requestTimeout' 124 | , resetContent 125 | , resetContent' 126 | , response 127 | , response' 128 | , seeOther 129 | , seeOther' 130 | , serviceUnavailable 131 | , serviceUnavailable' 132 | -- 5xx 133 | , switchingProtocols 134 | , switchingProtocols' 135 | , temporaryRedirect 136 | , temporaryRedirect' 137 | , tooManyRequests 138 | , tooManyRequests' 139 | , uRITooLong 140 | , uRITooLong' 141 | , unauthorized 142 | , unauthorized' 143 | , unavailableForLegalReasons 144 | , unavailableForLegalReasons' 145 | , unprocessableEntity 146 | , unprocessableEntity' 147 | , unsupportedMediaType 148 | , unsupportedMediaType' 149 | , upgradeRequired 150 | , upgradeRequired' 151 | , useProxy 152 | , useProxy' 153 | , variantAlsoNegotiates 154 | , variantAlsoNegotiates' 155 | ) 156 | import HTTPure.Server 157 | ( ServerM 158 | , serve 159 | , serve' 160 | , serveSecure 161 | , serveSecure' 162 | ) 163 | import HTTPure.Status (Status) 164 | -------------------------------------------------------------------------------- /docs/Middleware.md: -------------------------------------------------------------------------------- 1 | # Writing and Using Middleware in HTTPure 2 | 3 | Since HTTPure routers are just pure functions, you can write a middleware by 4 | simply creating a function that takes a router and an `HTTPure.Request`, and 5 | returns an `HTTPure.ResponseM`. You can then simply use function composition to 6 | combine middlewares, and pass your router to your composed middleware to 7 | generate the decorated router! 8 | 9 | See [the Middleware example](./Examples/Middleware/Main.purs) to see how you can 10 | build, compose, and consume different types of middleware. 11 | 12 | ## Writing Middleware 13 | 14 | A middleware is a function with the signature: 15 | 16 | ```purescript 17 | (HTTPure.Request -> HTTPure.ResponseM) -> HTTPure.Request -> HTTPure.ResponseM 18 | ``` 19 | 20 | Note that the first argument is just the signature for a router function. So 21 | essentially, your middleware should take a router and return a new router. 22 | That's it! You can do pretty much anything with middlewares. Here are a few 23 | examples of common middleware patterns: 24 | 25 | You can write a middleware that wraps all future work in some behavior, like 26 | logging or timing: 27 | 28 | ```purescript 29 | myMiddleware router request = do 30 | doSomethingBefore 31 | response <- router request 32 | doSomethingAfter 33 | pure response 34 | ``` 35 | 36 | Or perhaps a middleware that injects something into the response: 37 | 38 | ```purescript 39 | myMiddleware router request = do 40 | response <- router request 41 | HTTPure.response' response.status response.headers $ 42 | response.body <> "\n\nGenerated using my super duper middleware!" 43 | ``` 44 | 45 | You could even write a middleware that handles routing for some specific cases: 46 | 47 | ```purescript 48 | myMiddleware _ { path: [ "somepath" ] } = HTTPure.ok "Handled by my middleware!" 49 | myMiddleware router request = router request 50 | ``` 51 | 52 | Or even a middleware that conditionally includes another middleware: 53 | 54 | ```purescript 55 | myMiddleware router = if something then someOtherMiddleware router else router 56 | ``` 57 | 58 | Just make sure your middlewares follow the correct signature, and users will be 59 | able to compose them at will! 60 | 61 | Note that because there is nothing fancy happening here, you could always write 62 | higher order functions that don't follow this signature, if it makes sense. For 63 | instance, you could write a function that takes two routers, and selects which 64 | one to use based on some criteria. There is nothing wrong with this, but you 65 | should try to use the middleware signature mentioned above as much as possible 66 | as it will make your middleware easier to consume and compose. 67 | 68 | ## Consuming Middleware 69 | 70 | Consuming middleware easy: simply compose all the middleware you want, and then 71 | pass your router to the composed middleware. For instance: 72 | 73 | ```purescript 74 | main = HTTPure.serve port composedRouter $ Console.log "Server is up!" 75 | where 76 | composedRouter = middlewareA <<< middlewareB <<< middlewareC $ router 77 | ``` 78 | 79 | Be aware of the ordering of the middleware that you compose--since we used 80 | `<<<`, the middlewares will compose right-to-left. But because middlewares 81 | choose when to apply the router to the request, this is a bit like wrapping the 82 | router in each successive middleware from right to left. So when the router 83 | executes on a request, those middlewares will actually _execute_ 84 | left-to-right--or from the outermost wrapper inwards. 85 | 86 | In other words, say you have the following HTTPure server: 87 | 88 | ```purescript 89 | middleware letter router request = do 90 | EffectClass.liftEffect $ Console.log $ "Starting Middleware " <> letter 91 | response <- router request 92 | EffectClass.liftEffect $ Console.log $ "Ending Middleware " <> letter 93 | pure response 94 | 95 | main = HTTPure.serve port composedRouter $ Console.log "Server is up!" 96 | where 97 | composedRouter = middleware "A" <<< middleware "B" $ router 98 | ``` 99 | 100 | When this HTTPure server receives a request, the logs will include: 101 | 102 | ``` 103 | Starting Middleware A 104 | Starting Middleware B 105 | ... 106 | Ending Middleware B 107 | Ending Middleware A 108 | ``` 109 | -------------------------------------------------------------------------------- /src/HTTPure/Server.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Server 2 | ( ServerM 3 | , serve 4 | , serve' 5 | , serveSecure 6 | , serveSecure' 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Data.Maybe (Maybe(Nothing)) 12 | import Data.Options (Options, (:=)) 13 | import Effect (Effect) 14 | import Effect.Aff (catchError, message, runAff) 15 | import Effect.Class (liftEffect) 16 | import Effect.Console (error) 17 | import HTTPure.Request (Request, fromHTTPRequest) 18 | import HTTPure.Response (ResponseM, internalServerError, send) 19 | import Node.Encoding (Encoding(UTF8)) 20 | import Node.FS.Sync (readTextFile) 21 | import Node.HTTP (ListenOptions, close, listen) 22 | import Node.HTTP (Request, Response, createServer) as HTTP 23 | import Node.HTTP.Secure (SSLOptions, cert, certString, key, keyString) 24 | import Node.HTTP.Secure (createServer) as HTTPS 25 | 26 | -- | The `ServerM` is just an `Effect` containing a callback to close the 27 | -- | server. This type is the return type of the HTTPure serve and related 28 | -- | methods. 29 | type ServerM = Effect (Effect Unit -> Effect Unit) 30 | 31 | -- | Given a router, handle unhandled exceptions it raises by 32 | -- | responding with 500 Internal Server Error. 33 | onError500 :: (Request -> ResponseM) -> Request -> ResponseM 34 | onError500 router request = 35 | catchError (router request) \err -> do 36 | liftEffect $ error $ message err 37 | internalServerError "Internal server error" 38 | 39 | -- | This function takes a method which takes a `Request` and returns a 40 | -- | `ResponseM`, an HTTP `Request`, and an HTTP `Response`. It runs the 41 | -- | request, extracts the `Response` from the `ResponseM`, and sends the 42 | -- | `Response` to the HTTP `Response`. 43 | handleRequest :: 44 | (Request -> ResponseM) -> 45 | HTTP.Request -> 46 | HTTP.Response -> 47 | Effect Unit 48 | handleRequest router request httpresponse = 49 | void $ runAff (\_ -> pure unit) $ fromHTTPRequest request 50 | >>= onError500 router 51 | >>= send httpresponse 52 | 53 | -- | Given a `ListenOptions` object, a function mapping `Request` to 54 | -- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and 55 | -- | runs a HTTPure server without SSL. 56 | serve' :: ListenOptions -> (Request -> ResponseM) -> Effect Unit -> ServerM 57 | serve' options router onStarted = do 58 | server <- HTTP.createServer (handleRequest router) 59 | listen server options onStarted 60 | pure $ close server 61 | 62 | -- | Given a `Options HTTPS.SSLOptions` object and a `HTTP.ListenOptions` 63 | -- | object, a function mapping `Request` to `ResponseM`, and a `ServerM` 64 | -- | containing effects to run on boot, creates and runs a HTTPure server with 65 | -- | SSL. 66 | serveSecure' :: 67 | Options SSLOptions -> 68 | ListenOptions -> 69 | (Request -> ResponseM) -> 70 | Effect Unit -> 71 | ServerM 72 | serveSecure' sslOptions options router onStarted = do 73 | server <- HTTPS.createServer sslOptions (handleRequest router) 74 | listen server options onStarted 75 | pure $ close server 76 | 77 | -- | Given a port number, return a `HTTP.ListenOptions` `Record`. 78 | listenOptions :: Int -> ListenOptions 79 | listenOptions port = 80 | { hostname: "0.0.0.0" 81 | , port 82 | , backlog: Nothing 83 | } 84 | 85 | -- | Create and start a server. This is the main entry point for HTTPure. Takes 86 | -- | a port number on which to listen, a function mapping `Request` to 87 | -- | `ResponseM`, and a `ServerM` containing effects to run after the server has 88 | -- | booted (usually logging). Returns an `ServerM` containing the server's 89 | -- | effects. 90 | serve :: Int -> (Request -> ResponseM) -> Effect Unit -> ServerM 91 | serve = serve' <<< listenOptions 92 | 93 | -- | Create and start an SSL server. This method is the same as `serve`, but 94 | -- | takes additional SSL arguments. The arguments in order are: 95 | -- | 1. A port number 96 | -- | 2. A path to a cert file 97 | -- | 3. A path to a private key file 98 | -- | 4. A handler method which maps `Request` to `ResponseM` 99 | -- | 5. A callback to call when the server is up 100 | serveSecure :: 101 | Int -> 102 | String -> 103 | String -> 104 | (Request -> ResponseM) -> 105 | Effect Unit -> 106 | ServerM 107 | serveSecure port certFile keyFile router onStarted = do 108 | cert' <- readTextFile UTF8 certFile 109 | key' <- readTextFile UTF8 keyFile 110 | let sslOpts = key := keyString key' <> cert := certString cert' 111 | serveSecure' sslOpts (listenOptions port) router onStarted 112 | -------------------------------------------------------------------------------- /test/Test/HTTPure/BodySpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.BodySpec where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(Nothing), fromMaybe) 6 | import Effect.Aff (Aff) 7 | import Effect.Class (liftEffect) 8 | import Effect.Ref (new) as Ref 9 | import HTTPure.Body (RequestBody, defaultHeaders, read, toBuffer, toStream, toString, write) 10 | import HTTPure.Headers (header) 11 | import Node.Buffer (Buffer, fromString) 12 | import Node.Buffer (toString) as Buffer 13 | import Node.Encoding (Encoding(UTF8)) 14 | import Node.Stream (readString) 15 | import Test.HTTPure.TestHelpers (Test, getResponseBody, mockRequest, mockResponse, stringToStream, (?=)) 16 | import Test.Spec (describe, it) 17 | 18 | mockRequestBody :: String -> Aff RequestBody 19 | mockRequestBody body = 20 | liftEffect do 21 | buffer <- Ref.new Nothing 22 | string <- Ref.new Nothing 23 | pure 24 | { buffer 25 | , stream: stringToStream body 26 | , string 27 | } 28 | 29 | readSpec :: Test 30 | readSpec = 31 | describe "read" do 32 | it "is the body of the Request" do 33 | body <- (liftEffect <<< read) =<< mockRequest "" "GET" "" "test" [] 34 | string <- liftEffect $ fromMaybe "" <$> readString (toStream body) Nothing UTF8 35 | string ?= "test" 36 | 37 | toStringSpec :: Test 38 | toStringSpec = 39 | describe "toString" do 40 | it "turns RequestBody into a String" do 41 | requestBody <- mockRequestBody "foobar" 42 | string <- toString requestBody 43 | string ?= "foobar" 44 | it "is idempotent" do 45 | requestBody <- mockRequestBody "foobar" 46 | string1 <- toString requestBody 47 | string2 <- toString requestBody 48 | string1 ?= string2 49 | 50 | toBufferSpec :: Test 51 | toBufferSpec = 52 | describe "toBuffer" do 53 | it "turns RequestBody into a Buffer" do 54 | requestBody <- mockRequestBody "foobar" 55 | buf <- toBuffer requestBody 56 | string <- liftEffect $ Buffer.toString UTF8 buf 57 | string ?= "foobar" 58 | it "is idempotent" do 59 | requestBody <- mockRequestBody "foobar" 60 | buffer1 <- toBuffer requestBody 61 | buffer2 <- toBuffer requestBody 62 | string1 <- bufferToString buffer1 63 | string2 <- bufferToString buffer2 64 | string1 ?= string2 65 | where 66 | bufferToString = liftEffect <<< Buffer.toString UTF8 67 | 68 | defaultHeadersSpec :: Test 69 | defaultHeadersSpec = 70 | describe "defaultHeaders" do 71 | describe "String" do 72 | describe "with an ASCII string" do 73 | it "has the correct Content-Length header" do 74 | headers <- liftEffect $ defaultHeaders "ascii" 75 | headers ?= header "Content-Length" "5" 76 | describe "with a UTF-8 string" do 77 | it "has the correct Content-Length header" do 78 | headers <- liftEffect $ defaultHeaders "\x2603" 79 | headers ?= header "Content-Length" "3" 80 | describe "Buffer" do 81 | it "has the correct Content-Length header" do 82 | buf :: Buffer <- liftEffect $ fromString "foobar" UTF8 83 | headers <- liftEffect $ defaultHeaders buf 84 | headers ?= header "Content-Length" "6" 85 | describe "Readable" do 86 | it "specifies the Transfer-Encoding header" do 87 | headers <- liftEffect $ defaultHeaders $ stringToStream "test" 88 | headers ?= header "Transfer-Encoding" "chunked" 89 | 90 | writeSpec :: Test 91 | writeSpec = 92 | describe "write" do 93 | describe "String" do 94 | it "writes the String to the Response body" do 95 | body <- do 96 | resp <- liftEffect mockResponse 97 | write "test" resp 98 | pure $ getResponseBody resp 99 | body ?= "test" 100 | describe "Buffer" do 101 | it "writes the Buffer to the Response body" do 102 | body <- do 103 | resp <- liftEffect mockResponse 104 | buf :: Buffer <- liftEffect $ fromString "test" UTF8 105 | write buf resp 106 | pure $ getResponseBody resp 107 | body ?= "test" 108 | describe "Readable" do 109 | it "pipes the input stream to the Response body" do 110 | body <- do 111 | resp <- liftEffect mockResponse 112 | write (stringToStream "test") resp 113 | pure $ getResponseBody resp 114 | body ?= "test" 115 | 116 | bodySpec :: Test 117 | bodySpec = 118 | describe "Body" do 119 | defaultHeadersSpec 120 | readSpec 121 | toStringSpec 122 | toBufferSpec 123 | writeSpec 124 | -------------------------------------------------------------------------------- /History.md: -------------------------------------------------------------------------------- 1 | 0.16.0 / 2022-11-17 2 | =================== 3 | - Allow multi-value headers in request and response 4 | - Breaking change: change the `Show` instance of `HTTPure.Headers.Headers` so 5 | that it's used for debugging only. The previous behavior of `show` is now 6 | available with `HTTPure.Headers.toString`. 7 | 8 | 0.15.0 / 2022-05-05 9 | =================== 10 | - Update for PureScript 0.15 (thanks **@thomashoneyman** and **@sigma-andex**) 11 | 12 | 0.14.0 / 2021-12-06 13 | =================== 14 | - Cache Body `toBuffer`/`toString` results (thanks **@boygao1992**) 15 | 16 | 0.13.1 / 2021-11-29 17 | =================== 18 | - Support Duplex streams as responses (thanks **@arthurxavierx**) 19 | 20 | 0.13.0 / 2021-11-20 21 | =================== 22 | - Ensure correct ordering on stream operations 23 | - Add support for non-string requests (thanks **@sigma-andex**) 24 | 25 | 0.12.0 / 2021-03-20 26 | =================== 27 | - Bump all dependency versions 28 | - Modernize tooling 29 | - Fix CI 30 | - Don't use `echo -n` in example since it's nonportable to OSX 31 | 32 | 0.11.0 / 2021-03-04 33 | =================== 34 | - Dependency version bumps 35 | - Fix `Utils.replacePlus` to replace all occurrences (thanks **@tmciver**) 36 | - Update to purescript 0.14 (thanks **@realvictorprm**) 37 | - Expose original request url as a part of `Request` (thanks **@paluh**) 38 | - Bind to 0.0.0.0 instead of 'localhost' 39 | - Add spago configuration (thanks **@drewolson**) 40 | 41 | 0.10.0 / 2019-12-03 42 | =================== 43 | - Update response functions to return `MonadAff m => m Repsonse` (thanks **@drewolson**) 44 | 45 | 0.9.0 / 2019-09-25 46 | ================== 47 | - Provide utils from purescript-globals instead of FFI (thanks **@nsaunders**) 48 | - Update the tests to work with purescript-spec v4.0.0 (thanks **Dretch**) 49 | - Add some type declarations to get compatibility with node-buffer 6.x (thanks **Dretch**) 50 | 51 | 0.8.3 / 2019-06-03 52 | ================== 53 | - Use `Buffer.concat` instead of string concatenation to fix ordering issues (thanks **@rnons**) 54 | 55 | 0.8.2 / 2019-05-20 56 | ================== 57 | - Add HTTP version to `HTTPure.Request` (thanks **@joneshf**) 58 | - Fix inconsistent case-insensitivity with `HTTPure.Headers` (thanks **@joneshf**) 59 | 60 | 0.8.0 / 2019-02-16 61 | ================== 62 | - Re-export `HTTPure.Query` and `HTTPure.Status` (thanks **@akheron**) 63 | - Support binary response body (thanks **@akheron**) 64 | - Add support for chunked responses 65 | - `ServerM` now contains a callback that when called will shut down the server 66 | - Map empty query parameters to empty strings instead of `"true"` 67 | - Decode percent encoding in path segments and query parameters automatically 68 | - Use psc-package instead of bower 69 | 70 | 0.7.0 / 2018-07-08 71 | ================== 72 | - Add support for PureScript 0.12 (thanks **@akheron**) 73 | - Upgrade all dependencies (thanks **@akheron**) 74 | - Use `Effect` instead of `Eff` (thanks **@akheron**) 75 | - Use `Foreign.Object` instead of `StrMap` (thanks **@akheron**) 76 | - Use `Effect.Ref` instead of `Control.Monad.ST` (thanks **@akheron**) 77 | - Drop `SecureServerM`, it's the same as `ServerM` now (thanks **@akheron**) 78 | 79 | 0.6.0 / 2018-02-08 80 | ================== 81 | - Rename `serve'` to `serveSecure`, add `serve'` and `serveSecure'`. 82 | 83 | 0.5.0 / 2017-10-25 84 | ================== 85 | - Make ResponseM an `Aff` instead of `Eff` 86 | - Add helpers and instances for working with headers (`Semigroup` instance, 87 | `HTTPure.header`, `HTTPure.empty`, etc) 88 | - Clean up patterns for response helpers so all helpers are consistent 89 | - Add `HTTPure.fullPath` function 90 | - Extend `Lookup` typeclass -- make `!!` return `Maybe` types and add `!?` and 91 | `!@` operators. 92 | - Add examples and guidelines for working with middlewares 93 | - Add guides 94 | 95 | 0.4.0 / 2017-09-26 96 | ================== 97 | - Major refactor for simpler APIs 98 | - Lookup typeclass and `!!` operator 99 | - Support for inspecting and routing on path segments 100 | - Support for inspecting and routing on query parameters 101 | 102 | 0.3.0 / 2017-08-01 103 | ================== 104 | - Support HTTPS servers 105 | 106 | 0.2.0 / 2017-07-20 107 | ================== 108 | - Support all HTTP response statuses 109 | - Support all HTTP request methods 110 | - Added in v0.1.0 111 | - Get 112 | - Post 113 | - Put 114 | - Delete 115 | - New 116 | - Head 117 | - Connect 118 | - Options 119 | - Trace 120 | - Patch 121 | 122 | 0.1.0 / 2017-07-17 123 | ================== 124 | - Support OK response 125 | - Support Get, Post, Put, and Delete HTTP methods 126 | - Support sending and reading headers and body 127 | -------------------------------------------------------------------------------- /src/HTTPure/Body.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Body 2 | ( class Body 3 | , RequestBody 4 | , defaultHeaders 5 | , write 6 | , read 7 | , toBuffer 8 | , toStream 9 | , toString 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Data.Either (Either(Right)) 15 | import Data.Maybe (Maybe(Just, Nothing)) 16 | import Effect (Effect) 17 | import Effect.Aff (Aff, makeAff, nonCanceler) 18 | import Effect.Class (liftEffect) 19 | import Effect.Ref (Ref) 20 | import Effect.Ref (modify, new, read, write) as Ref 21 | import HTTPure.Headers (Headers, header) 22 | import Node.Buffer (Buffer, concat, fromString, size) 23 | import Node.Buffer (toString) as Buffer 24 | import Node.Encoding (Encoding(UTF8)) 25 | import Node.HTTP (Request, Response, requestAsStream, responseAsStream) 26 | import Node.Stream (Readable, Stream, end, onData, onEnd, pipe, writeString) 27 | import Node.Stream (write) as Stream 28 | import Type.Equality (class TypeEquals, to) 29 | 30 | type RequestBody = 31 | { buffer :: Ref (Maybe Buffer) 32 | , stream :: Readable () 33 | , string :: Ref (Maybe String) 34 | } 35 | 36 | -- | Read the body `Readable` stream out of the incoming request 37 | read :: Request -> Effect RequestBody 38 | read request = do 39 | buffer <- Ref.new Nothing 40 | string <- Ref.new Nothing 41 | pure 42 | { buffer 43 | , stream: requestAsStream request 44 | , string 45 | } 46 | 47 | -- | Turn `RequestBody` into a `String` 48 | -- | 49 | -- | This drains the `Readable` stream in `RequestBody` for the first time 50 | -- | and returns cached result from then on. 51 | toString :: RequestBody -> Aff String 52 | toString requestBody = do 53 | maybeString <- 54 | liftEffect 55 | $ Ref.read requestBody.string 56 | case maybeString of 57 | Nothing -> do 58 | buffer <- toBuffer requestBody 59 | string <- liftEffect 60 | $ Buffer.toString UTF8 buffer 61 | liftEffect 62 | $ Ref.write (Just string) requestBody.string 63 | pure string 64 | Just string -> pure string 65 | 66 | -- | Turn `RequestBody` into a `Buffer` 67 | -- | 68 | -- | This drains the `Readable` stream in `RequestBody` for the first time 69 | -- | and returns cached result from then on. 70 | toBuffer :: RequestBody -> Aff Buffer 71 | toBuffer requestBody = do 72 | maybeBuffer <- 73 | liftEffect 74 | $ Ref.read requestBody.buffer 75 | case maybeBuffer of 76 | Nothing -> do 77 | buffer <- streamToBuffer requestBody.stream 78 | liftEffect 79 | $ Ref.write (Just buffer) requestBody.buffer 80 | pure buffer 81 | Just buffer -> pure buffer 82 | where 83 | -- | Slurp the entire `Readable` stream into a `Buffer` 84 | streamToBuffer :: Readable () -> Aff Buffer 85 | streamToBuffer stream = 86 | makeAff \done -> do 87 | bufs <- Ref.new [] 88 | onData stream \buf -> void $ Ref.modify (_ <> [ buf ]) bufs 89 | onEnd stream do 90 | body <- Ref.read bufs >>= concat 91 | done $ Right body 92 | pure nonCanceler 93 | 94 | -- | Return the `Readable` stream directly from `RequestBody` 95 | toStream :: RequestBody -> Readable () 96 | toStream = _.stream 97 | 98 | -- | Types that implement the `Body` class can be used as a body to an HTTPure 99 | -- | response, and can be used with all the response helpers. 100 | class Body b where 101 | -- | Return any default headers that need to be sent with this body type, 102 | -- | things like `Content-Type`, `Content-Length`, and `Transfer-Encoding`. 103 | -- | Note that any headers passed in a response helper such as `ok'` will take 104 | -- | precedence over these. 105 | defaultHeaders :: b -> Effect Headers 106 | -- | Given a body value and a Node HTTP `Response` value, write the body value 107 | -- | to the Node response. 108 | write :: b -> Response -> Aff Unit 109 | 110 | -- | The instance for `String` will convert the string to a buffer first in 111 | -- | order to determine it's additional headers. This is to ensure that the 112 | -- | `Content-Length` header properly accounts for UTF-8 characters in the 113 | -- | string. Writing is simply implemented by writing the string to the 114 | -- | response stream and closing the response stream. 115 | instance bodyString :: Body String where 116 | defaultHeaders body = do 117 | buf :: Buffer <- fromString body UTF8 118 | defaultHeaders buf 119 | write body response = makeAff \done -> do 120 | let stream = responseAsStream response 121 | void $ writeString stream UTF8 body $ const $ end stream $ const $ done $ Right unit 122 | pure nonCanceler 123 | 124 | -- | The instance for `Buffer` is trivial--we add a `Content-Length` header 125 | -- | using `Buffer.size`, and to send the response, we just write the buffer to 126 | -- | the stream and end the stream. 127 | instance bodyBuffer :: Body Buffer where 128 | defaultHeaders buf = header "Content-Length" <$> show <$> size buf 129 | write body response = makeAff \done -> do 130 | let stream = responseAsStream response 131 | void $ Stream.write stream body $ const $ end stream $ const $ done $ Right unit 132 | pure nonCanceler 133 | 134 | -- | This instance can be used to send chunked data. Here, we add a 135 | -- | `Transfer-Encoding` header to indicate chunked data. To write the data, we 136 | -- | simply pipe the newtype-wrapped `Stream` to the response. 137 | instance bodyChunked :: 138 | TypeEquals (Stream r) (Readable s) => 139 | Body (Stream r) where 140 | defaultHeaders _ = pure $ header "Transfer-Encoding" "chunked" 141 | write body response = makeAff \done -> do 142 | let stream = to body 143 | void $ pipe stream $ responseAsStream response 144 | onEnd stream $ done $ Right unit 145 | pure nonCanceler 146 | -------------------------------------------------------------------------------- /test/Test/HTTPure/ResponseSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.ResponseSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(Right)) 6 | import Effect.Aff (makeAff, nonCanceler) 7 | import Effect.Class (liftEffect) 8 | import HTTPure.Body (defaultHeaders) 9 | import HTTPure.Headers (header) 10 | import HTTPure.MultiHeaders as HTTPure.MultiHeaders 11 | import HTTPure.Response (emptyResponse, emptyResponse', response, response', send) 12 | import Node.Encoding (Encoding(UTF8)) 13 | import Node.HTTP (responseAsStream) 14 | import Node.Stream (end, writeString) 15 | import Test.HTTPure.TestHelpers 16 | ( Test 17 | , getResponseBody 18 | , getResponseMultiHeader 19 | , getResponseStatus 20 | , mockResponse 21 | , (?=) 22 | ) 23 | import Test.Spec (describe, it) 24 | 25 | sendSpec :: Test 26 | sendSpec = 27 | describe "send" do 28 | let 29 | mockResponse' = 30 | { status: 123 31 | , headers: header "Test" "test" 32 | , multiHeaders: 33 | HTTPure.MultiHeaders.header "Set-Cookie" "test1" 34 | <> HTTPure.MultiHeaders.header "Set-Cookie" "test2" 35 | , writeBody: 36 | \response -> makeAff \done -> do 37 | stream <- pure $ responseAsStream response 38 | void $ writeString stream UTF8 "test" $ const $ end stream $ const $ done $ Right unit 39 | pure nonCanceler 40 | } 41 | it "writes the `headers`" do 42 | header <- do 43 | httpResponse <- liftEffect mockResponse 44 | send httpResponse mockResponse' 45 | pure $ getResponseMultiHeader "Test" httpResponse 46 | header ?= [ "test" ] 47 | it "writes the `multiHeaders`" do 48 | header <- do 49 | httpResponse <- liftEffect mockResponse 50 | send httpResponse mockResponse' 51 | pure $ getResponseMultiHeader "Set-Cookie" httpResponse 52 | header ?= [ "test1", "test2" ] 53 | it "joins headers that exist in both `headers` and `multiHeaders`" do 54 | header <- do 55 | httpResponse <- liftEffect mockResponse 56 | send httpResponse mockResponse' { headers = header "Set-Cookie" "test0" } 57 | pure $ getResponseMultiHeader "Set-Cookie" httpResponse 58 | header ?= [ "test0", "test1", "test2" ] 59 | it "writes the status" do 60 | status <- do 61 | httpResponse <- liftEffect mockResponse 62 | send httpResponse mockResponse' 63 | pure $ getResponseStatus httpResponse 64 | status ?= 123 65 | it "writes the body" do 66 | body <- do 67 | httpResponse <- liftEffect mockResponse 68 | send httpResponse mockResponse' 69 | pure $ getResponseBody httpResponse 70 | body ?= "test" 71 | 72 | responseFunctionSpec :: Test 73 | responseFunctionSpec = 74 | describe "response" do 75 | it "has the right status" do 76 | resp <- response 123 "test" 77 | resp.status ?= 123 78 | it "has only default headers" do 79 | resp <- response 123 "test" 80 | defaultHeaders' <- liftEffect $ defaultHeaders "test" 81 | resp.headers ?= defaultHeaders' 82 | it "has the right writeBody function" do 83 | body <- do 84 | resp <- response 123 "test" 85 | httpResponse <- liftEffect $ mockResponse 86 | resp.writeBody httpResponse 87 | pure $ getResponseBody httpResponse 88 | body ?= "test" 89 | 90 | response'Spec :: Test 91 | response'Spec = 92 | describe "response'" do 93 | let 94 | mockHeaders = header "Test" "test" 95 | mockResponse' = response' 123 mockHeaders "test" 96 | it "has the right status" do 97 | resp <- mockResponse' 98 | resp.status ?= 123 99 | it "has the right headers" do 100 | resp <- mockResponse' 101 | defaultHeaders' <- liftEffect $ defaultHeaders "test" 102 | resp.headers ?= defaultHeaders' <> mockHeaders 103 | it "has the right writeBody function" do 104 | body <- do 105 | resp <- mockResponse' 106 | httpResponse <- liftEffect mockResponse 107 | resp.writeBody httpResponse 108 | pure $ getResponseBody httpResponse 109 | body ?= "test" 110 | 111 | emptyResponseSpec :: Test 112 | emptyResponseSpec = 113 | describe "emptyResponse" do 114 | it "has the right status" do 115 | resp <- emptyResponse 123 116 | resp.status ?= 123 117 | it "has only default headers" do 118 | resp <- emptyResponse 123 119 | defaultHeaders' <- liftEffect $ defaultHeaders "" 120 | resp.headers ?= defaultHeaders' 121 | it "has the right writeBody function" do 122 | body <- do 123 | resp <- emptyResponse 123 124 | httpResponse <- liftEffect $ mockResponse 125 | resp.writeBody httpResponse 126 | pure $ getResponseBody httpResponse 127 | body ?= "" 128 | 129 | emptyResponse'Spec :: Test 130 | emptyResponse'Spec = 131 | describe "emptyResponse'" do 132 | let 133 | mockHeaders = header "Test" "test" 134 | mockResponse' = emptyResponse' 123 mockHeaders 135 | it "has the right status" do 136 | resp <- mockResponse' 137 | resp.status ?= 123 138 | it "has the right headers" do 139 | resp <- mockResponse' 140 | defaultHeaders' <- liftEffect $ defaultHeaders "" 141 | resp.headers ?= mockHeaders <> defaultHeaders' 142 | it "has the right writeBody function" do 143 | body <- do 144 | resp <- mockResponse' 145 | httpResponse <- liftEffect mockResponse 146 | resp.writeBody httpResponse 147 | pure $ getResponseBody httpResponse 148 | body ?= "" 149 | 150 | responseSpec :: Test 151 | responseSpec = 152 | describe "Response" do 153 | sendSpec 154 | responseFunctionSpec 155 | response'Spec 156 | emptyResponseSpec 157 | emptyResponse'Spec 158 | -------------------------------------------------------------------------------- /test/Test/HTTPure/HeadersSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.HeadersSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Map as Data.Map 6 | import Data.Maybe (Maybe(..)) 7 | import Data.String.CaseInsensitive (CaseInsensitiveString(..)) 8 | import Data.Tuple (Tuple(..)) 9 | import Effect.Class (liftEffect) 10 | import HTTPure.Headers (Headers(..), empty, header, headers, read, toString, write) 11 | import HTTPure.Lookup ((!!)) 12 | import Test.HTTPure.TestHelpers ((?=)) 13 | import Test.HTTPure.TestHelpers as TestHelpers 14 | import Test.Spec (describe, it) 15 | 16 | lookupSpec :: TestHelpers.Test 17 | lookupSpec = 18 | describe "lookup" do 19 | describe "when the string is in the header set" do 20 | describe "when searching with lowercase" do 21 | it "is Just the string" do 22 | header "x-test" "test" !! "x-test" ?= Just "test" 23 | describe "when searching with uppercase" do 24 | it "is Just the string" do 25 | header "x-test" "test" !! "X-Test" ?= Just "test" 26 | describe "when the string is uppercase" do 27 | describe "when searching with lowercase" do 28 | it "is Just the string" do 29 | header "X-Test" "test" !! "x-test" ?= Just "test" 30 | describe "when searching with uppercase" do 31 | it "is Just the string" do 32 | header "X-Test" "test" !! "X-Test" ?= Just "test" 33 | describe "when the string is not in the header set" do 34 | it "is Nothing" do 35 | ((empty !! "X-Test") :: Maybe String) ?= Nothing 36 | 37 | eqSpec :: TestHelpers.Test 38 | eqSpec = 39 | describe "eq" do 40 | describe "when the two Headers contain the same keys and values" do 41 | it "is true" do 42 | header "Test1" "test1" == header "Test1" "test1" ?= true 43 | describe "when the two Headers contain different keys and values" do 44 | it "is false" do 45 | header "Test1" "test1" == header "Test2" "test2" ?= false 46 | describe "when the two Headers contain only different values" do 47 | it "is false" do 48 | header "Test1" "test1" == header "Test1" "test2" ?= false 49 | describe "when the one Headers contains additional keys and values" do 50 | it "is false" do 51 | let mock = header "Test1" "1" <> header "Test2" "2" 52 | header "Test1" "1" == mock ?= false 53 | 54 | appendSpec :: TestHelpers.Test 55 | appendSpec = 56 | describe "append" do 57 | describe "when there are multiple keys" do 58 | it "appends the headers correctly" do 59 | let 60 | mock1 = header "Test1" "1" <> header "Test2" "2" 61 | mock2 = header "Test3" "3" <> header "Test4" "4" 62 | mock3 = 63 | headers 64 | [ Tuple "Test1" "1" 65 | , Tuple "Test2" "2" 66 | , Tuple "Test3" "3" 67 | , Tuple "Test4" "4" 68 | ] 69 | mock1 <> mock2 ?= mock3 70 | describe "when there is a duplicated key" do 71 | it "uses the last appended value" do 72 | let mock = header "Test" "foo" <> header "Test" "bar" 73 | mock ?= header "Test" "bar" 74 | 75 | readSpec :: TestHelpers.Test 76 | readSpec = 77 | describe "read" do 78 | describe "with no headers" do 79 | it "is an empty Map" do 80 | request <- TestHelpers.mockRequest "" "" "" "" [] 81 | read request ?= empty 82 | describe "with headers" do 83 | it "is a Map with the contents of the headers" do 84 | let testHeader = [ Tuple "X-Test" "test" ] 85 | request <- TestHelpers.mockRequest "" "" "" "" testHeader 86 | read request ?= headers testHeader 87 | describe "with 'Set-Cookie' headers" do 88 | it "is a Map with the contents of the headers without any 'Set-Cookie' headers" do 89 | let testHeader = [ Tuple "X-Test" "test", Tuple "Set-Cookie" "foo", Tuple "set-cookie" "bar" ] 90 | let headers' = Headers $ Data.Map.singleton (CaseInsensitiveString "X-Test") "test" 91 | request <- TestHelpers.mockRequest "" "" "" "" testHeader 92 | read request ?= headers' 93 | 94 | writeSpec :: TestHelpers.Test 95 | writeSpec = 96 | describe "write" do 97 | it "writes the headers to the response" do 98 | header <- liftEffect do 99 | mock <- TestHelpers.mockResponse 100 | write mock $ header "X-Test" "test" 101 | pure $ TestHelpers.getResponseHeader "X-Test" mock 102 | header ?= "test" 103 | 104 | emptySpec :: TestHelpers.Test 105 | emptySpec = 106 | describe "empty" do 107 | it "is an empty Map in an empty Headers" do 108 | empty ?= Headers Data.Map.empty 109 | 110 | headerSpec :: TestHelpers.Test 111 | headerSpec = 112 | describe "header" do 113 | it "creates a singleton Headers" do 114 | header "X-Test" "test" ?= Headers (Data.Map.singleton (CaseInsensitiveString "X-Test") "test") 115 | 116 | headersFunctionSpec :: TestHelpers.Test 117 | headersFunctionSpec = 118 | describe "headers" do 119 | it "is equivalent to using header with <>" do 120 | let 121 | expected = header "X-Test-1" "1" <> header "X-Test-2" "2" 122 | test = headers 123 | [ Tuple "X-Test-1" "1" 124 | , Tuple "X-Test-2" "2" 125 | ] 126 | test ?= expected 127 | 128 | toStringSpec :: TestHelpers.Test 129 | toStringSpec = 130 | describe "toString" do 131 | it "is a string representing the headers in HTTP format" do 132 | let mock = header "Test1" "1" <> header "Test2" "2" 133 | toString mock ?= "Test1: 1\nTest2: 2\n\n" 134 | 135 | headersSpec :: TestHelpers.Test 136 | headersSpec = 137 | describe "Headers" do 138 | lookupSpec 139 | eqSpec 140 | appendSpec 141 | readSpec 142 | writeSpec 143 | emptySpec 144 | headerSpec 145 | headersFunctionSpec 146 | toStringSpec 147 | -------------------------------------------------------------------------------- /test/Test/HTTPure/IntegrationSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.IntegrationSpec where 2 | 3 | import Prelude 4 | 5 | import Effect.Class (liftEffect) 6 | import Examples.AsyncResponse.Main as AsyncResponse 7 | import Examples.BinaryRequest.Main as BinaryRequest 8 | import Examples.BinaryResponse.Main as BinaryResponse 9 | import Examples.Chunked.Main as Chunked 10 | import Examples.CustomStack.Main as CustomStack 11 | import Examples.Headers.Main as Headers 12 | import Examples.HelloWorld.Main as HelloWorld 13 | import Examples.Middleware.Main as Middleware 14 | import Examples.MultiRoute.Main as MultiRoute 15 | import Examples.PathSegments.Main as PathSegments 16 | import Examples.Post.Main as Post 17 | import Examples.QueryParameters.Main as QueryParameters 18 | import Examples.SSL.Main as SSL 19 | import Foreign.Object (empty, singleton) 20 | import Node.Buffer (toArray) 21 | import Node.FS.Aff (readFile) 22 | import Test.HTTPure.TestHelpers 23 | ( Test 24 | , get 25 | , get' 26 | , getBinary 27 | , getHeader 28 | , post 29 | , postBinary 30 | , (?=) 31 | ) 32 | import Test.Spec (describe, it) 33 | 34 | asyncResponseSpec :: Test 35 | asyncResponseSpec = 36 | it "runs the async response example" do 37 | close <- liftEffect AsyncResponse.main 38 | response <- get 8080 empty "/" 39 | liftEffect $ close $ pure unit 40 | response ?= "hello world!" 41 | 42 | binaryRequestSpec :: Test 43 | binaryRequestSpec = 44 | it "runs the binary request example" do 45 | close <- liftEffect BinaryRequest.main 46 | binaryBuf <- readFile BinaryResponse.filePath 47 | response <- postBinary 8080 empty "/" binaryBuf 48 | liftEffect $ close $ pure unit 49 | response ?= "d5e776724dd545d8b54123b46362a553d10257cee688ef1be62166c984b34405" 50 | 51 | binaryResponseSpec :: Test 52 | binaryResponseSpec = 53 | it "runs the binary response example" do 54 | close <- liftEffect BinaryResponse.main 55 | responseBuf <- getBinary 8080 empty "/" 56 | liftEffect $ close $ pure unit 57 | binaryBuf <- readFile BinaryResponse.filePath 58 | expected <- liftEffect $ toArray binaryBuf 59 | response <- liftEffect $ toArray responseBuf 60 | response ?= expected 61 | 62 | chunkedSpec :: Test 63 | chunkedSpec = 64 | it "runs the chunked example" do 65 | close <- liftEffect Chunked.main 66 | response <- get 8080 empty "/" 67 | liftEffect $ close $ pure unit 68 | -- TODO this isn't a great way to validate this, we need a way of inspecting 69 | -- each individual chunk instead of just looking at the entire response 70 | response ?= "hello \nworld!\n" 71 | 72 | customStackSpec :: Test 73 | customStackSpec = 74 | it "runs the custom stack example" do 75 | close <- liftEffect CustomStack.main 76 | response <- get 8080 empty "/" 77 | liftEffect $ close $ pure unit 78 | response ?= "hello, joe" 79 | 80 | headersSpec :: Test 81 | headersSpec = 82 | it "runs the headers example" do 83 | close <- liftEffect Headers.main 84 | header <- getHeader 8080 empty "/" "X-Example" 85 | response <- get 8080 (singleton "X-Input" "test") "/" 86 | liftEffect $ close $ pure unit 87 | header ?= "hello world!" 88 | response ?= "test" 89 | 90 | helloWorldSpec :: Test 91 | helloWorldSpec = 92 | it "runs the hello world example" do 93 | close <- liftEffect HelloWorld.main 94 | response <- get 8080 empty "/" 95 | liftEffect $ close $ pure unit 96 | response ?= "hello world!" 97 | 98 | middlewareSpec :: Test 99 | middlewareSpec = 100 | it "runs the middleware example" do 101 | close <- liftEffect Middleware.main 102 | header <- getHeader 8080 empty "/" "X-Middleware" 103 | body <- get 8080 empty "/" 104 | header' <- getHeader 8080 empty "/middleware" "X-Middleware" 105 | body' <- get 8080 empty "/middleware" 106 | liftEffect $ close $ pure unit 107 | header ?= "router" 108 | body ?= "hello" 109 | header' ?= "middleware" 110 | body' ?= "Middleware!" 111 | 112 | multiRouteSpec :: Test 113 | multiRouteSpec = 114 | it "runs the multi route example" do 115 | close <- liftEffect MultiRoute.main 116 | hello <- get 8080 empty "/hello" 117 | goodbye <- get 8080 empty "/goodbye" 118 | liftEffect $ close $ pure unit 119 | hello ?= "hello" 120 | goodbye ?= "goodbye" 121 | 122 | pathSegmentsSpec :: Test 123 | pathSegmentsSpec = 124 | it "runs the path segments example" do 125 | close <- liftEffect PathSegments.main 126 | foo <- get 8080 empty "/segment/foo" 127 | somebars <- get 8080 empty "/some/bars" 128 | liftEffect $ close $ pure unit 129 | foo ?= "foo" 130 | somebars ?= "[\"some\",\"bars\"]" 131 | 132 | postSpec :: Test 133 | postSpec = 134 | it "runs the post example" do 135 | close <- liftEffect Post.main 136 | response <- post 8080 empty "/" "test" 137 | liftEffect $ close $ pure unit 138 | response ?= "test" 139 | 140 | queryParametersSpec :: Test 141 | queryParametersSpec = 142 | it "runs the query parameters example" do 143 | close <- liftEffect QueryParameters.main 144 | foo <- get 8080 empty "/?foo" 145 | bar <- get 8080 empty "/?bar=test" 146 | notbar <- get 8080 empty "/?bar=nottest" 147 | baz <- get 8080 empty "/?baz=test" 148 | liftEffect $ close $ pure unit 149 | foo ?= "foo" 150 | bar ?= "bar" 151 | notbar ?= "" 152 | baz ?= "test" 153 | 154 | sslSpec :: Test 155 | sslSpec = 156 | it "runs the ssl example" do 157 | close <- liftEffect SSL.main 158 | response <- get' 8080 empty "/" 159 | liftEffect $ close $ pure unit 160 | response ?= "hello world!" 161 | 162 | integrationSpec :: Test 163 | integrationSpec = 164 | describe "Integration" do 165 | asyncResponseSpec 166 | binaryRequestSpec 167 | binaryResponseSpec 168 | chunkedSpec 169 | customStackSpec 170 | headersSpec 171 | helloWorldSpec 172 | middlewareSpec 173 | multiRouteSpec 174 | pathSegmentsSpec 175 | postSpec 176 | queryParametersSpec 177 | sslSpec 178 | -------------------------------------------------------------------------------- /src/HTTPure/MultiHeaders.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.MultiHeaders 2 | ( MultiHeaders(..) 3 | , empty 4 | , fromHeaders 5 | , header 6 | , header' 7 | , headers 8 | , headers' 9 | , read 10 | , toString 11 | , write 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Data.Array.NonEmpty (NonEmptyArray) 17 | import Data.Array.NonEmpty as Data.Array.NonEmpty 18 | import Data.Foldable as Data.Foldable 19 | import Data.FoldableWithIndex as Data.FoldableWithIndex 20 | import Data.Generic.Rep (class Generic) 21 | import Data.Map (Map) 22 | import Data.Map as Data.Map 23 | import Data.Newtype (class Newtype, un) 24 | import Data.Show.Generic as Data.Show.Generic 25 | import Data.String.CaseInsensitive (CaseInsensitiveString(..)) 26 | import Data.TraversableWithIndex as Data.TraversableWithIndex 27 | import Data.Tuple (Tuple(..)) 28 | import Effect (Effect) 29 | import HTTPure.Headers (Headers(..)) 30 | import HTTPure.Lookup (class Lookup, (!!)) 31 | import Node.HTTP as Node.HTTP 32 | import Unsafe.Coerce as Unsafe.Coerce 33 | 34 | -- | The `MultiHeaders` type represets the set of headers in a HTTP request or 35 | -- | response read in a way such that every header name maps to a non-empty list 36 | -- | of header values. This is useful for headers that may have multiple values, 37 | -- | such as "Set-Cookie". 38 | newtype MultiHeaders = MultiHeaders (Map CaseInsensitiveString (NonEmptyArray String)) 39 | 40 | derive instance newtypeMultiHeaders :: Newtype MultiHeaders _ 41 | 42 | derive instance genericMultiHeaders :: Generic MultiHeaders _ 43 | 44 | -- | Given a string, return a `Maybe` containing the values of the matching 45 | -- | header, if there is any. 46 | instance lookupMultiHeaders :: Lookup MultiHeaders String (NonEmptyArray String) where 47 | lookup (MultiHeaders headersMap) key = headersMap !! key 48 | 49 | instance showMultiHeaders :: Show MultiHeaders where 50 | show = Data.Show.Generic.genericShow 51 | 52 | -- | Compare two `MultiHeaders` objects by comparing the underlying `Objects`. 53 | derive newtype instance eqMultiHeaders :: Eq MultiHeaders 54 | 55 | -- | Allow one `MultiHeaders` objects to be appended to another. 56 | instance semigroupMultiHeaders :: Semigroup MultiHeaders where 57 | append (MultiHeaders a) (MultiHeaders b) = 58 | MultiHeaders $ Data.Map.unionWith append a b 59 | 60 | instance monoidMultiHeaders :: Monoid MultiHeaders where 61 | mempty = MultiHeaders Data.Map.empty 62 | 63 | -- | Return a `MultiHeaders` containing nothing. 64 | empty :: MultiHeaders 65 | empty = MultiHeaders Data.Map.empty 66 | 67 | -- | Create a `MultiHeaders` out of a `Headers` value. 68 | fromHeaders :: Headers -> MultiHeaders 69 | fromHeaders = MultiHeaders <<< map pure <<< Data.Map.fromFoldableWithIndex <<< un Headers 70 | 71 | -- | Create a singleton header from a key-value pair. 72 | header :: String -> String -> MultiHeaders 73 | header key = header' key <<< Data.Array.NonEmpty.singleton 74 | 75 | -- | Create a singleton header from a key-values pair. 76 | header' :: String -> NonEmptyArray String -> MultiHeaders 77 | header' key = MultiHeaders <<< Data.Map.singleton (CaseInsensitiveString key) 78 | 79 | -- | Convert an `Array` of `Tuples` of 2 `Strings` to a `MultiHeaders` object. 80 | headers :: Array (Tuple String String) -> MultiHeaders 81 | headers = headers' <<< map (map pure) 82 | 83 | -- | Convert an `Array` of `Tuples` of 2 `Strings` to a `MultiHeaders` object. 84 | headers' :: Array (Tuple String (NonEmptyArray String)) -> MultiHeaders 85 | headers' = MultiHeaders <<< Data.Foldable.foldl insertField Data.Map.empty 86 | where 87 | insertField x (Tuple key values) = Data.Map.insertWith append (CaseInsensitiveString key) values x 88 | 89 | -- | Parse a list of raw request headers, applying the given function to every 90 | -- | key-value pair. 91 | -- | See https://nodejs.org/api/http.html#messagerawheaders. 92 | foreign import parseRawHeaders :: forall a. (String -> String -> a) -> Array String -> Array a 93 | 94 | -- | Read the headers out of a HTTP `Request` object and parse duplicated 95 | -- | headers as a list (instead of comma-separated values, as with 96 | -- | `HTTPure.Headers.read`). 97 | read :: Node.HTTP.Request -> MultiHeaders 98 | read = 99 | MultiHeaders 100 | <<< Data.Map.fromFoldableWith (flip append) 101 | <<< map (\(Tuple key value) -> Tuple (CaseInsensitiveString key) (pure value)) 102 | <<< parseRawHeaders Tuple 103 | <<< requestRawHeaders 104 | where 105 | -- | The raw request/response headers list exactly as they were received. 106 | -- | The keys and values are in the same list. It is not a list of tuples. 107 | -- | So, the even-numbered offsets are key values, and the odd-numbered 108 | -- | offsets are the associated values. Header names are not lowercased, and 109 | -- | duplicates are not merged. 110 | -- | See https://nodejs.org/api/http.html#messagerawheaders. 111 | requestRawHeaders :: Node.HTTP.Request -> Array String 112 | requestRawHeaders = _.rawHeaders <<< Unsafe.Coerce.unsafeCoerce 113 | 114 | -- | Allow a `MultiHeaders` to be represented as a string. This string is 115 | -- | formatted in HTTP headers format. 116 | toString :: MultiHeaders -> String 117 | toString (MultiHeaders headersMap) = Data.FoldableWithIndex.foldMapWithIndex showField headersMap <> "\n" 118 | where 119 | showField :: CaseInsensitiveString -> NonEmptyArray String -> String 120 | showField key values = 121 | let 122 | separator :: String 123 | separator = if key == CaseInsensitiveString "Set-Cookie" then "; " else ", " 124 | in 125 | un CaseInsensitiveString key <> ": " <> Data.Foldable.intercalate separator values <> "\n" 126 | 127 | -- | Given an HTTP `Response` and a `MultiHeaders` object, return an effect that will 128 | -- | write the `MultiHeaders` to the `Response`. 129 | write :: Node.HTTP.Response -> MultiHeaders -> Effect Unit 130 | write response (MultiHeaders headersMap) = void $ Data.TraversableWithIndex.traverseWithIndex writeField headersMap 131 | where 132 | writeField :: CaseInsensitiveString -> NonEmptyArray String -> Effect Unit 133 | writeField key = Node.HTTP.setHeaders response (un CaseInsensitiveString key) <<< Data.Array.NonEmpty.toArray 134 | -------------------------------------------------------------------------------- /src/HTTPure/Status.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Status 2 | ( Status 3 | , write 4 | -- 1xx 5 | , continue 6 | , switchingProtocols 7 | , processing 8 | -- 2xx 9 | , ok 10 | , created 11 | , accepted 12 | , nonAuthoritativeInformation 13 | , noContent 14 | , resetContent 15 | , partialContent 16 | , multiStatus 17 | , alreadyReported 18 | , iMUsed 19 | -- 3xx 20 | , multipleChoices 21 | , movedPermanently 22 | , found 23 | , seeOther 24 | , notModified 25 | , useProxy 26 | , temporaryRedirect 27 | , permanentRedirect 28 | -- 4xx 29 | , badRequest 30 | , unauthorized 31 | , paymentRequired 32 | , forbidden 33 | , notFound 34 | , methodNotAllowed 35 | , notAcceptable 36 | , proxyAuthenticationRequired 37 | , requestTimeout 38 | , conflict 39 | , gone 40 | , lengthRequired 41 | , preconditionFailed 42 | , payloadTooLarge 43 | , uRITooLong 44 | , unsupportedMediaType 45 | , rangeNotSatisfiable 46 | , expectationFailed 47 | , imATeapot 48 | , misdirectedRequest 49 | , unprocessableEntity 50 | , locked 51 | , failedDependency 52 | , upgradeRequired 53 | , preconditionRequired 54 | , tooManyRequests 55 | , requestHeaderFieldsTooLarge 56 | , unavailableForLegalReasons 57 | -- 5xx 58 | , internalServerError 59 | , notImplemented 60 | , badGateway 61 | , serviceUnavailable 62 | , gatewayTimeout 63 | , hTTPVersionNotSupported 64 | , variantAlsoNegotiates 65 | , insufficientStorage 66 | , loopDetected 67 | , notExtended 68 | , networkAuthenticationRequired 69 | ) where 70 | 71 | import Prelude 72 | 73 | import Effect (Effect) 74 | import Node.HTTP (Response, setStatusCode) 75 | 76 | -- | The `Status` type enumerates all valid HTTP response status codes. 77 | type Status = Int 78 | 79 | -- | Write a status to a given HTTP `Response`. 80 | write :: Response -> Status -> Effect Unit 81 | write = setStatusCode 82 | 83 | --------- 84 | -- 1xx -- 85 | --------- 86 | -- | 100 87 | continue :: Status 88 | continue = 100 89 | 90 | -- | 101 91 | switchingProtocols :: Status 92 | switchingProtocols = 101 93 | 94 | -- | 102 95 | processing :: Status 96 | processing = 102 97 | 98 | --------- 99 | -- 2xx -- 100 | --------- 101 | -- | 200 102 | ok :: Status 103 | ok = 200 104 | 105 | -- | 201 106 | created :: Status 107 | created = 201 108 | 109 | -- | 202 110 | accepted :: Status 111 | accepted = 202 112 | 113 | -- | 203 114 | nonAuthoritativeInformation :: Status 115 | nonAuthoritativeInformation = 203 116 | 117 | -- | 204 118 | noContent :: Status 119 | noContent = 204 120 | 121 | -- | 205 122 | resetContent :: Status 123 | resetContent = 205 124 | 125 | -- | 206 126 | partialContent :: Status 127 | partialContent = 206 128 | 129 | -- | 207 130 | multiStatus :: Status 131 | multiStatus = 207 132 | 133 | -- | 208 134 | alreadyReported :: Status 135 | alreadyReported = 208 136 | 137 | -- | 226 138 | iMUsed :: Status 139 | iMUsed = 226 140 | 141 | --------- 142 | -- 3xx -- 143 | --------- 144 | -- | 300 145 | multipleChoices :: Status 146 | multipleChoices = 300 147 | 148 | -- | 301 149 | movedPermanently :: Status 150 | movedPermanently = 301 151 | 152 | -- | 302 153 | found :: Status 154 | found = 302 155 | 156 | -- | 303 157 | seeOther :: Status 158 | seeOther = 303 159 | 160 | -- | 304 161 | notModified :: Status 162 | notModified = 304 163 | 164 | -- | 305 165 | useProxy :: Status 166 | useProxy = 305 167 | 168 | -- | 307 169 | temporaryRedirect :: Status 170 | temporaryRedirect = 307 171 | 172 | -- | 308 173 | permanentRedirect :: Status 174 | permanentRedirect = 308 175 | 176 | --------- 177 | -- 4xx -- 178 | --------- 179 | -- | 400 180 | badRequest :: Status 181 | badRequest = 400 182 | 183 | -- | 401 184 | unauthorized :: Status 185 | unauthorized = 401 186 | 187 | -- | 402 188 | paymentRequired :: Status 189 | paymentRequired = 402 190 | 191 | -- | 403 192 | forbidden :: Status 193 | forbidden = 403 194 | 195 | -- | 404 196 | notFound :: Status 197 | notFound = 404 198 | 199 | -- | 405 200 | methodNotAllowed :: Status 201 | methodNotAllowed = 405 202 | 203 | -- | 406 204 | notAcceptable :: Status 205 | notAcceptable = 406 206 | 207 | -- | 407 208 | proxyAuthenticationRequired :: Status 209 | proxyAuthenticationRequired = 407 210 | 211 | -- | 408 212 | requestTimeout :: Status 213 | requestTimeout = 408 214 | 215 | -- | 409 216 | conflict :: Status 217 | conflict = 409 218 | 219 | -- | 410 220 | gone :: Status 221 | gone = 410 222 | 223 | -- | 411 224 | lengthRequired :: Status 225 | lengthRequired = 411 226 | 227 | -- | 412 228 | preconditionFailed :: Status 229 | preconditionFailed = 412 230 | 231 | -- | 413 232 | payloadTooLarge :: Status 233 | payloadTooLarge = 413 234 | 235 | -- | 414 236 | uRITooLong :: Status 237 | uRITooLong = 414 238 | 239 | -- | 415 240 | unsupportedMediaType :: Status 241 | unsupportedMediaType = 415 242 | 243 | -- | 416 244 | rangeNotSatisfiable :: Status 245 | rangeNotSatisfiable = 416 246 | 247 | -- | 417 248 | expectationFailed :: Status 249 | expectationFailed = 417 250 | 251 | -- | 418 252 | imATeapot :: Status 253 | imATeapot = 418 254 | 255 | -- | 421 256 | misdirectedRequest :: Status 257 | misdirectedRequest = 421 258 | 259 | -- | 422 260 | unprocessableEntity :: Status 261 | unprocessableEntity = 422 262 | 263 | -- | 423 264 | locked :: Status 265 | locked = 423 266 | 267 | -- | 424 268 | failedDependency :: Status 269 | failedDependency = 424 270 | 271 | -- | 426 272 | upgradeRequired :: Status 273 | upgradeRequired = 426 274 | 275 | -- | 428 276 | preconditionRequired :: Status 277 | preconditionRequired = 428 278 | 279 | -- | 429 280 | tooManyRequests :: Status 281 | tooManyRequests = 429 282 | 283 | -- | 431 284 | requestHeaderFieldsTooLarge :: Status 285 | requestHeaderFieldsTooLarge = 431 286 | 287 | -- | 451 288 | unavailableForLegalReasons :: Status 289 | unavailableForLegalReasons = 451 290 | 291 | --------- 292 | -- 5xx -- 293 | --------- 294 | -- | 500 295 | internalServerError :: Status 296 | internalServerError = 500 297 | 298 | -- | 501 299 | notImplemented :: Status 300 | notImplemented = 501 301 | 302 | -- | 502 303 | badGateway :: Status 304 | badGateway = 502 305 | 306 | -- | 503 307 | serviceUnavailable :: Status 308 | serviceUnavailable = 503 309 | 310 | -- | 504 311 | gatewayTimeout :: Status 312 | gatewayTimeout = 504 313 | 314 | -- | 505 315 | hTTPVersionNotSupported :: Status 316 | hTTPVersionNotSupported = 505 317 | 318 | -- | 506 319 | variantAlsoNegotiates :: Status 320 | variantAlsoNegotiates = 506 321 | 322 | -- | 507 323 | insufficientStorage :: Status 324 | insufficientStorage = 507 325 | 326 | -- | 508 327 | loopDetected :: Status 328 | loopDetected = 508 329 | 330 | -- | 510 331 | notExtended :: Status 332 | notExtended = 510 333 | 334 | -- | 511 335 | networkAuthenticationRequired :: Status 336 | networkAuthenticationRequired = 511 337 | -------------------------------------------------------------------------------- /test/Test/HTTPure/MultiHeadersSpec.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.MultiHeadersSpec where 2 | 3 | import Prelude 4 | 5 | import Data.Array.NonEmpty (NonEmptyArray) 6 | import Data.Map as Data.Map 7 | import Data.Maybe (Maybe(..)) 8 | import Data.String.CaseInsensitive (CaseInsensitiveString(..)) 9 | import Data.Tuple (Tuple(..)) 10 | import Effect.Class (liftEffect) 11 | import HTTPure.Lookup ((!!)) 12 | import HTTPure.MultiHeaders (MultiHeaders(..)) 13 | import HTTPure.MultiHeaders as HTTPure.MultiHeaders 14 | import Test.HTTPure.TestHelpers ((?=)) 15 | import Test.HTTPure.TestHelpers as TestHelpers 16 | import Test.Spec as Test.Spec 17 | 18 | lookupSpec :: TestHelpers.Test 19 | lookupSpec = 20 | Test.Spec.describe "lookup" do 21 | Test.Spec.describe "when the string is in the header set" do 22 | Test.Spec.describe "when searching with lowercase" do 23 | Test.Spec.it "is Just the string" do 24 | HTTPure.MultiHeaders.header "x-test" "test" !! "x-test" ?= Just (pure "test") 25 | Test.Spec.describe "when searching with uppercase" do 26 | Test.Spec.it "is Just the string" do 27 | HTTPure.MultiHeaders.header "x-test" "test" !! "X-Test" ?= Just (pure "test") 28 | Test.Spec.describe "when the string is uppercase" do 29 | Test.Spec.describe "when searching with lowercase" do 30 | Test.Spec.it "is Just the string" do 31 | HTTPure.MultiHeaders.header "X-Test" "test" !! "x-test" ?= Just (pure "test") 32 | Test.Spec.describe "when searching with uppercase" do 33 | Test.Spec.it "is Just the string" do 34 | HTTPure.MultiHeaders.header "X-Test" "test" !! "X-Test" ?= Just (pure "test") 35 | Test.Spec.describe "when the string is not in the header set" do 36 | Test.Spec.it "is Nothing" do 37 | ((HTTPure.MultiHeaders.empty !! "X-Test") :: Maybe (NonEmptyArray String)) ?= Nothing 38 | 39 | eqSpec :: TestHelpers.Test 40 | eqSpec = 41 | Test.Spec.describe "eq" do 42 | Test.Spec.describe "when the two MultiHeaders contain the same keys and values" do 43 | Test.Spec.it "is true" do 44 | HTTPure.MultiHeaders.header "Test1" "test1" == HTTPure.MultiHeaders.header "Test1" "test1" ?= true 45 | Test.Spec.describe "when the two MultiHeaders contain different keys and values" do 46 | Test.Spec.it "is false" do 47 | HTTPure.MultiHeaders.header "Test1" "test1" == HTTPure.MultiHeaders.header "Test2" "test2" ?= false 48 | Test.Spec.describe "when the two MultiHeaders contain only different values" do 49 | Test.Spec.it "is false" do 50 | HTTPure.MultiHeaders.header "Test1" "test1" == HTTPure.MultiHeaders.header "Test1" "test2" ?= false 51 | Test.Spec.describe "when the one MultiHeaders contains additional keys and values" do 52 | Test.Spec.it "is false" do 53 | let mock = HTTPure.MultiHeaders.header "Test1" "1" <> HTTPure.MultiHeaders.header "Test2" "2" 54 | HTTPure.MultiHeaders.header "Test1" "1" == mock ?= false 55 | 56 | appendSpec :: TestHelpers.Test 57 | appendSpec = 58 | Test.Spec.describe "append" do 59 | Test.Spec.describe "when there are multiple keys" do 60 | Test.Spec.it "appends the headers correctly" do 61 | let 62 | mock1 = HTTPure.MultiHeaders.header "Test1" "1" <> HTTPure.MultiHeaders.header "Test2" "2" 63 | mock2 = HTTPure.MultiHeaders.header "Test3" "3" <> HTTPure.MultiHeaders.header "Test4" "4" 64 | mock3 = 65 | HTTPure.MultiHeaders.headers 66 | [ Tuple "Test1" "1" 67 | , Tuple "Test2" "2" 68 | , Tuple "Test3" "3" 69 | , Tuple "Test4" "4" 70 | ] 71 | mock1 <> mock2 ?= mock3 72 | Test.Spec.describe "when there is a duplicated key" do 73 | Test.Spec.it "appends the multiple values" do 74 | let mock = HTTPure.MultiHeaders.header "Test" "foo" <> HTTPure.MultiHeaders.header "Test" "bar" 75 | mock ?= HTTPure.MultiHeaders.header' "Test" (pure "foo" <> pure "bar") 76 | 77 | readSpec :: TestHelpers.Test 78 | readSpec = 79 | Test.Spec.describe "read" do 80 | Test.Spec.describe "with no headers" do 81 | Test.Spec.it "is an empty Map" do 82 | request <- TestHelpers.mockRequest "" "" "" "" [] 83 | HTTPure.MultiHeaders.read request ?= HTTPure.MultiHeaders.empty 84 | Test.Spec.describe "with headers" do 85 | Test.Spec.it "is a Map with the contents of the headers" do 86 | let testHeader = [ Tuple "X-Test" "test", Tuple "X-Foo" "bar" ] 87 | request <- TestHelpers.mockRequest "" "" "" "" testHeader 88 | HTTPure.MultiHeaders.read request ?= HTTPure.MultiHeaders.headers testHeader 89 | Test.Spec.describe "with duplicate headers" do 90 | Test.Spec.it "is a Map with the contents of the headers" do 91 | let testHeader = [ Tuple "X-Test" "test1", Tuple "X-Test" "test2" ] 92 | request <- TestHelpers.mockRequest "" "" "" "" testHeader 93 | HTTPure.MultiHeaders.read request ?= HTTPure.MultiHeaders.headers testHeader 94 | 95 | writeSpec :: TestHelpers.Test 96 | writeSpec = 97 | Test.Spec.describe "write" do 98 | Test.Spec.it "writes the headers to the response" do 99 | header <- liftEffect do 100 | mock <- TestHelpers.mockResponse 101 | HTTPure.MultiHeaders.write mock $ HTTPure.MultiHeaders.headers [ Tuple "X-Test" "test1", Tuple "X-Test" "test2" ] 102 | pure $ TestHelpers.getResponseMultiHeader "X-Test" mock 103 | header ?= [ "test1", "test2" ] 104 | 105 | emptySpec :: TestHelpers.Test 106 | emptySpec = 107 | Test.Spec.describe "empty" do 108 | Test.Spec.it "is an empty Map in an empty MultiHeaders" do 109 | HTTPure.MultiHeaders.empty ?= MultiHeaders Data.Map.empty 110 | 111 | headerSpec :: TestHelpers.Test 112 | headerSpec = 113 | Test.Spec.describe "header" do 114 | Test.Spec.it "creates a singleton MultiHeaders" do 115 | HTTPure.MultiHeaders.header "X-Test" "test" ?= MultiHeaders (Data.Map.singleton (CaseInsensitiveString "X-Test") (pure "test")) 116 | 117 | headersFunctionSpec :: TestHelpers.Test 118 | headersFunctionSpec = 119 | Test.Spec.describe "headers" do 120 | Test.Spec.it "is equivalent to using header with <>" do 121 | let 122 | expected = HTTPure.MultiHeaders.header "X-Test-1" "1" <> HTTPure.MultiHeaders.header "X-Test-2" "2" 123 | test = HTTPure.MultiHeaders.headers 124 | [ Tuple "X-Test-1" "1" 125 | , Tuple "X-Test-2" "2" 126 | ] 127 | test ?= expected 128 | 129 | toStringSpec :: TestHelpers.Test 130 | toStringSpec = 131 | Test.Spec.describe "toString" do 132 | Test.Spec.it "is a string representing the headers in HTTP format" do 133 | let mock = HTTPure.MultiHeaders.header "Test1" "1" <> HTTPure.MultiHeaders.header "Test2" "2" 134 | HTTPure.MultiHeaders.toString mock ?= "Test1: 1\nTest2: 2\n\n" 135 | Test.Spec.it "separates duplicate headers with a comma" do 136 | let 137 | mock = 138 | HTTPure.MultiHeaders.header "Test1" "1" 139 | <> HTTPure.MultiHeaders.header "Test1" "2" 140 | <> HTTPure.MultiHeaders.header "Test2" "2" 141 | HTTPure.MultiHeaders.toString mock ?= "Test1: 1, 2\nTest2: 2\n\n" 142 | Test.Spec.it "separates duplicate 'Set-Cookie' headers with a semicolon" do 143 | let 144 | mock = 145 | HTTPure.MultiHeaders.header "Test1" "1" 146 | <> HTTPure.MultiHeaders.header "Set-Cookie" "1" 147 | <> HTTPure.MultiHeaders.header "Set-Cookie" "2" 148 | HTTPure.MultiHeaders.toString mock ?= "Set-Cookie: 1; 2\nTest1: 1\n\n" 149 | 150 | multiHeadersSpec :: TestHelpers.Test 151 | multiHeadersSpec = 152 | Test.Spec.describe "MultiHeaders" do 153 | lookupSpec 154 | eqSpec 155 | appendSpec 156 | readSpec 157 | writeSpec 158 | emptySpec 159 | headerSpec 160 | headersFunctionSpec 161 | toStringSpec 162 | -------------------------------------------------------------------------------- /docs/Routing.md: -------------------------------------------------------------------------------- 1 | # Routing in HTTPure 2 | 3 | Routing in HTTPure is designed on the simple principle of allowing PureScript to 4 | do what PureScript does best. When you create an HTTPure server, you pass it a 5 | router function: 6 | 7 | ```purescript 8 | main = HTTPure.serve 8080 router $ Console.log "Server up" 9 | ``` 10 | 11 | The router function is called for each inbound request to the HTTPure server. 12 | Its signature is: 13 | 14 | ```purescript 15 | HTTPure.Request -> HTTPure.ResponseM 16 | ``` 17 | 18 | So in HTTPure, routing is handled simply by the router being a pure function 19 | which is passed a value that contains all information about the current request, 20 | and which returns a response monad. There's no fancy path parsing and matching 21 | algorithm to learn, and everything is pure--you don't get anything or set 22 | anything, you simply define the return value given the input parameters, like 23 | any other pure function. 24 | 25 | This is quite powerful, as all routing can be defined using the same PureScript 26 | pattern matching and guard syntax you use everywhere else. It allows you to 27 | break up your router to sub-routers easily, using whatever router grouping makes 28 | sense for your app. It also leads to some powerful patterns for defining and 29 | using middleware. For more details about defining and using middleware, see the 30 | [Middleware guide](./Middleware.md). 31 | 32 | For more details about the response monad, see the [Responses 33 | guide](./Responses.md). 34 | 35 | ## The Request Record 36 | 37 | The `HTTPure.Request` type is the input parameter for the router function. It is 38 | a `Record` type that contains the following fields: 39 | 40 | - `method` - A member of `HTTPure.Method`. 41 | - `path` - An `Array` of `String` path segments. A path segment is a nonempty 42 | string separated by a `"/"`. Empty segments are stripped out when HTTPure 43 | creates the `HTTPure.Request` record. 44 | - `query` - An `Object` of `String` values. Note that if you have any query 45 | parameters without values (for instance, a URL like `/foo?bar`), then the 46 | value in the `Object` for that query parameter will be the empty `String` 47 | (`""`). 48 | - `headers` - A `HTTPure.Headers` object. The `HTTPure.Headers` newtype wraps 49 | the `Object String` type and provides some typeclass instances that make more 50 | sense when working with HTTP headers. 51 | - `body` - A `String` containing the contents of the request body, or an empty 52 | `String` if none was provided. 53 | 54 | Following are some more details on working with specific fields, but remember, 55 | you can combine guards and pattern matching for any or all of these fields 56 | however it makes sense for your use case. 57 | 58 | ## The Lookup Typeclass 59 | 60 | You will find that much of HTTPure routing takes advantage of implementations of 61 | the [HTTPure.Lookup](../src/HTTPure/Lookup.purs) typeclass. This typeclass 62 | defines the function `HTTPure.lookup` (or the infix version `!!`), along with a 63 | few auxiliary helpers, for looking up a field out of an object with some key. 64 | There are three instances defined in HTTPure: 65 | 66 | 1. `Lookup (Array t) Int t` - In this instance, `HTTPure.lookup` is the same as 67 | `Array.index`. Because the path is represented as an `Array` of `Strings`, 68 | this can be used to retrieve the nth path segment by doing something like 69 | `request.path !! n`. 70 | 2. `Lookup (Object t) String t` - In this instance, `HTTPure.lookup` is a 71 | flipped version of `Object.lookup`. Because the query is a `Object String`, 72 | this instance can be used to retrieve the value of a query parameter by name, 73 | by doing something like `request.query !! "someparam"`. 74 | 3. `Lookup Headers String String` - This is similar to the example in #2, except 75 | that it works with the `HTTPure.Headers` newtype, and the key is 76 | case-insensitive (so `request.headers !! "X-Test" == request.headers !! 77 | "x-test"`). 78 | 79 | There are three infix operators defined on the `HTTPure.Lookup` typeclass that 80 | are extremely useful for routing: 81 | 82 | 1. `!!` - This is an alias to `HTTPure.lookup` itself, and returns a `Maybe` 83 | containing some type. 84 | 2. `!@` - This is the same as `HTTPure.lookup`, but it returns the actual value 85 | instead of a `Maybe` containing the value. It only operates on instances of 86 | `HTTPure.Lookup` where the return type is a `Monoid`, and returns `mempty` if 87 | `HTTPure.lookup` returns `Nothing`. It's especially useful when routing based 88 | on specific values in query parameters, path segments, or header fields. 89 | 3. `!?` - This returns `true` if the key on the right hand side is in the data 90 | set on the left hand side. In other words, if `HTTPure.lookup` matches 91 | something, this is `true`, otherwise, this is `false`. 92 | 93 | ## Matching HTTP Methods 94 | 95 | You can use normal pattern matching to route based on the HTTP method: 96 | 97 | ```purescript 98 | router { method: HTTPure.Post } = HTTPure.ok "received a post" 99 | router { method: HTTPure.Get } = HTTPure.ok "received a get" 100 | router { method } = HTTPure.ok $ "received a " <> show method 101 | ``` 102 | 103 | To see the list of methods that HTTPure understands, see the 104 | [Method](../src/HTTPure/Method.purs) module. To see an example server that 105 | routes based on the HTTP method, see [the Post 106 | example](./Examples/Post/Main.purs). 107 | 108 | ## Working With Path Segments 109 | 110 | Generally, there are two use cases for working with path segments: routing on 111 | them, and using them as variables. When routing on path segments, you can route 112 | on exact path matches: 113 | 114 | ```purescript 115 | router { path: [ "exact" ] } = HTTPure.ok "matched /exact" 116 | ``` 117 | 118 | You can also route on partial path matches. It's cleanest to use PureScript 119 | guards for this. For instance: 120 | 121 | ```purescript 122 | router { path } 123 | | path !@ 0 == "foo" = HTTPure.ok "matched something starting with /foo" 124 | | path !@ 1 == "bar" = HTTPure.ok "matched something starting with /*/bar" 125 | ``` 126 | 127 | When using a path segment as a variable, simply extract the path segment using 128 | the `HTTPure.Lookup` typeclass: 129 | 130 | ```purescript 131 | router { path } = HTTPure.ok $ "Path segment 0: " <> path !@ 0 132 | ``` 133 | 134 | To see an example server that works with path segments, see [the Path Segments 135 | example](./Examples/PathSegments/Main.purs). 136 | 137 | ## Working With Query Parameters 138 | 139 | Working with query parameters is very similar to working with path segments. You 140 | can route based on the _existence_ of a query parameter: 141 | 142 | ```purescript 143 | router { query } 144 | | query !? "foo" = HTTPure.ok "matched a request containing the 'foo' param" 145 | ``` 146 | 147 | Or you can route based on the _value_ of a query parameter: 148 | 149 | ```purescript 150 | router { query } 151 | | query !@ "foo" == "bar" = HTTPure.ok "matched a request with 'foo=bar'" 152 | ``` 153 | 154 | You can of course also use the value of a query parameter to calculate your 155 | response: 156 | 157 | ```purescript 158 | router { query } = HTTPure.ok $ "The value of 'foo' is " <> query !@ "foo" 159 | ``` 160 | 161 | To see an example server that works with query parameters, see [the Query 162 | Parameters example](./Examples/QueryParameters/Main.purs). 163 | 164 | ## Working With Request Headers 165 | 166 | Headers are again very similar to working with path segments or query 167 | parameters: 168 | 169 | ```purescript 170 | router { headers } 171 | | headers !? "X-Foo" = HTTPure.ok "There is an 'X-Foo' header" 172 | | headers !@ "X-Foo" == "bar" = HTTPure.ok "The header 'X-Foo' is 'bar'" 173 | | otherwise = HTTPure.ok $ "The value of 'X-Foo' is " <> headers !@ "x-foo" 174 | ``` 175 | 176 | Note that using the `HTTPure.Lookup` typeclass on headers is case-insensitive. 177 | 178 | To see an example server that works with headers, see [the Headers 179 | example](./Examples/Headers/Main.purs). 180 | -------------------------------------------------------------------------------- /test/Test/HTTPure/TestHelpers.purs: -------------------------------------------------------------------------------- 1 | module Test.HTTPure.TestHelpers where 2 | 3 | import Prelude 4 | 5 | import Data.Array (fromFoldable) as Array 6 | import Data.Array as Data.Array 7 | import Data.Either (Either(Right)) 8 | import Data.List (List(Nil, Cons), reverse) 9 | import Data.Maybe (fromMaybe) 10 | import Data.Options ((:=)) 11 | import Data.String (toLower) 12 | import Data.Tuple (Tuple(..)) 13 | import Effect (Effect) 14 | import Effect.Aff (Aff, makeAff, nonCanceler) 15 | import Effect.Class (liftEffect) 16 | import Effect.Ref (modify_, new, read) 17 | import Foreign.Object (Object, lookup) 18 | import Foreign.Object as Object 19 | import Node.Buffer (Buffer, concat, create, fromString) 20 | import Node.Buffer (toString) as Buffer 21 | import Node.Encoding (Encoding(UTF8)) 22 | import Node.HTTP (Request) 23 | import Node.HTTP (Response) as HTTP 24 | import Node.HTTP.Client 25 | ( RequestHeaders(RequestHeaders) 26 | , headers 27 | , hostname 28 | , method 29 | , path 30 | , port 31 | , protocol 32 | , rejectUnauthorized 33 | , requestAsStream 34 | , responseAsStream 35 | , responseHeaders 36 | , statusCode 37 | ) 38 | import Node.HTTP.Client (Response, request) as HTTPClient 39 | import Node.Stream (Readable, end, onData, onEnd, write) 40 | import Test.Spec (Spec) 41 | import Test.Spec.Assertions (shouldEqual) 42 | import Unsafe.Coerce (unsafeCoerce) 43 | 44 | infix 1 shouldEqual as ?= 45 | 46 | -- | The type for integration tests. 47 | type Test = Spec Unit 48 | 49 | -- | The type for the entire test suite. 50 | type TestSuite = Effect Unit 51 | 52 | -- | Given a URL, a failure handler, and a success handler, create an HTTP 53 | -- | client request. 54 | request :: 55 | Boolean -> 56 | Int -> 57 | String -> 58 | Object String -> 59 | String -> 60 | Buffer -> 61 | Aff HTTPClient.Response 62 | request secure port' method' headers' path' body = 63 | makeAff \done -> do 64 | req <- HTTPClient.request options $ Right >>> done 65 | let stream = requestAsStream req 66 | void 67 | $ write stream body 68 | $ const 69 | $ end stream 70 | $ const 71 | $ pure unit 72 | pure nonCanceler 73 | where 74 | options = 75 | protocol := (if secure then "https:" else "http:") 76 | <> method := method' 77 | <> hostname := "localhost" 78 | <> port := port' 79 | <> path := path' 80 | <> headers := RequestHeaders headers' 81 | <> rejectUnauthorized := false 82 | 83 | -- | Same as `request` but without. 84 | request' :: 85 | Boolean -> 86 | Int -> 87 | String -> 88 | Object String -> 89 | String -> 90 | Aff HTTPClient.Response 91 | request' secure port method headers path = 92 | liftEffect (create 0) 93 | >>= request secure port method headers path 94 | 95 | -- | Same as `request` but with a `String` body. 96 | requestString :: 97 | Boolean -> 98 | Int -> 99 | String -> 100 | Object String -> 101 | String -> 102 | String -> 103 | Aff HTTPClient.Response 104 | requestString secure port method headers path body = do 105 | liftEffect (fromString body UTF8) 106 | >>= request secure port method headers path 107 | 108 | -- | Convert a request to an Aff containing the `Buffer with the response body. 109 | toBuffer :: HTTPClient.Response -> Aff Buffer 110 | toBuffer response = 111 | makeAff \done -> do 112 | let 113 | stream = responseAsStream response 114 | chunks <- new Nil 115 | onData stream $ \new -> modify_ (Cons new) chunks 116 | onEnd stream $ read chunks 117 | >>= reverse 118 | >>> Array.fromFoldable 119 | >>> concat 120 | >>= Right 121 | >>> done 122 | pure nonCanceler 123 | 124 | -- | Convert a request to an Aff containing the string with the response body. 125 | toString :: HTTPClient.Response -> Aff String 126 | toString resp = do 127 | buf <- toBuffer resp 128 | liftEffect $ Buffer.toString UTF8 buf 129 | 130 | -- | Run an HTTP GET with the given url and return an Aff that contains the 131 | -- | string with the response body. 132 | get :: 133 | Int -> 134 | Object String -> 135 | String -> 136 | Aff String 137 | get port headers path = request' false port "GET" headers path >>= toString 138 | 139 | -- | Like `get` but return a response body in a `Buffer` 140 | getBinary :: 141 | Int -> 142 | Object String -> 143 | String -> 144 | Aff Buffer 145 | getBinary port headers path = request' false port "GET" headers path >>= toBuffer 146 | 147 | -- | Run an HTTPS GET with the given url and return an Aff that contains the 148 | -- | string with the response body. 149 | get' :: 150 | Int -> 151 | Object String -> 152 | String -> 153 | Aff String 154 | get' port headers path = request' true port "GET" headers path >>= toString 155 | 156 | -- | Run an HTTP POST with the given url and body and return an Aff that 157 | -- | contains the string with the response body. 158 | post :: 159 | Int -> 160 | Object String -> 161 | String -> 162 | String -> 163 | Aff String 164 | post port headers path = requestString false port "POST" headers path >=> toString 165 | 166 | -- | Run an HTTP POST with the given url and binary buffer body and return an 167 | -- | Aff that contains the string with the response body. 168 | postBinary :: 169 | Int -> 170 | Object String -> 171 | String -> 172 | Buffer -> 173 | Aff String 174 | postBinary port headers path = request false port "POST" headers path >=> toString 175 | 176 | -- | Convert a request to an Aff containing the string with the given header 177 | -- | value. 178 | extractHeader :: String -> HTTPClient.Response -> String 179 | extractHeader header = unmaybe <<< lookup' <<< responseHeaders 180 | where 181 | unmaybe = fromMaybe "" 182 | 183 | lookup' = lookup $ toLower header 184 | 185 | -- | Run an HTTP GET with the given url and return an Aff that contains the 186 | -- | string with the header value for the given header. 187 | getHeader :: 188 | Int -> 189 | Object String -> 190 | String -> 191 | String -> 192 | Aff String 193 | getHeader port headers path header = extractHeader header <$> request' false port "GET" headers path 194 | 195 | getStatus :: 196 | Int -> 197 | Object String -> 198 | String -> 199 | Aff Int 200 | getStatus port headers path = statusCode <$> request' false port "GET" headers path 201 | 202 | -- | Mock an HTTP Request object 203 | foreign import mockRequestImpl :: 204 | String -> 205 | String -> 206 | String -> 207 | String -> 208 | Object String -> 209 | Array String -> 210 | Effect Request 211 | 212 | -- | Mock an HTTP Request object 213 | mockRequest :: 214 | String -> 215 | String -> 216 | String -> 217 | String -> 218 | Array (Tuple String String) -> 219 | Aff Request 220 | mockRequest httpVersion method url body headers = 221 | liftEffect $ mockRequestImpl httpVersion method url body (Object.fromFoldable headers) rawHeaders 222 | where 223 | rawHeaders :: Array String 224 | rawHeaders = Data.Array.concatMap (\(Tuple key value) -> [ key, value ]) headers 225 | 226 | -- | Mock an HTTP Response object 227 | foreign import mockResponse :: Effect HTTP.Response 228 | 229 | -- | Get the current body from an HTTP Response object (note this will only work 230 | -- | with an object returned from mockResponse). 231 | getResponseBody :: HTTP.Response -> String 232 | getResponseBody = _.body <<< unsafeCoerce 233 | 234 | -- | Get the currently set status from an HTTP Response object. 235 | getResponseStatus :: HTTP.Response -> Int 236 | getResponseStatus = _.statusCode <<< unsafeCoerce 237 | 238 | -- | Get the current value for the header on the HTTP Response object. 239 | getResponseHeader :: String -> HTTP.Response -> String 240 | getResponseHeader header = fromMaybe "" <<< lookup header <<< _.headers <<< unsafeCoerce 241 | 242 | -- | Get the current values for the header on the HTTP Response object. 243 | getResponseMultiHeader :: String -> HTTP.Response -> Array String 244 | getResponseMultiHeader header = fromMaybe [] <<< lookup header <<< _.headers <<< unsafeCoerce 245 | 246 | -- | Create a stream out of a string. 247 | foreign import stringToStream :: String -> Readable () 248 | -------------------------------------------------------------------------------- /src/HTTPure/Response.purs: -------------------------------------------------------------------------------- 1 | module HTTPure.Response 2 | ( Response 3 | , ResponseM 4 | , send 5 | , response 6 | , response' 7 | , emptyResponse 8 | , emptyResponse' 9 | -- 1xx 10 | , continue 11 | , continue' 12 | , switchingProtocols 13 | , switchingProtocols' 14 | , processing 15 | , processing' 16 | -- 2xx 17 | , ok 18 | , ok' 19 | , created 20 | , created' 21 | , accepted 22 | , accepted' 23 | , nonAuthoritativeInformation 24 | , nonAuthoritativeInformation' 25 | , noContent 26 | , noContent' 27 | , resetContent 28 | , resetContent' 29 | , partialContent 30 | , partialContent' 31 | , multiStatus 32 | , multiStatus' 33 | , alreadyReported 34 | , alreadyReported' 35 | , iMUsed 36 | , iMUsed' 37 | -- 3xx 38 | , multipleChoices 39 | , multipleChoices' 40 | , movedPermanently 41 | , movedPermanently' 42 | , found 43 | , found' 44 | , seeOther 45 | , seeOther' 46 | , notModified 47 | , notModified' 48 | , useProxy 49 | , useProxy' 50 | , temporaryRedirect 51 | , temporaryRedirect' 52 | , permanentRedirect 53 | , permanentRedirect' 54 | -- 4xx 55 | , badRequest 56 | , badRequest' 57 | , unauthorized 58 | , unauthorized' 59 | , paymentRequired 60 | , paymentRequired' 61 | , forbidden 62 | , forbidden' 63 | , notFound 64 | , notFound' 65 | , methodNotAllowed 66 | , methodNotAllowed' 67 | , notAcceptable 68 | , notAcceptable' 69 | , proxyAuthenticationRequired 70 | , proxyAuthenticationRequired' 71 | , requestTimeout 72 | , requestTimeout' 73 | , conflict 74 | , conflict' 75 | , gone 76 | , gone' 77 | , lengthRequired 78 | , lengthRequired' 79 | , preconditionFailed 80 | , preconditionFailed' 81 | , payloadTooLarge 82 | , payloadTooLarge' 83 | , uRITooLong 84 | , uRITooLong' 85 | , unsupportedMediaType 86 | , unsupportedMediaType' 87 | , rangeNotSatisfiable 88 | , rangeNotSatisfiable' 89 | , expectationFailed 90 | , expectationFailed' 91 | , imATeapot 92 | , imATeapot' 93 | , misdirectedRequest 94 | , misdirectedRequest' 95 | , unprocessableEntity 96 | , unprocessableEntity' 97 | , locked 98 | , locked' 99 | , failedDependency 100 | , failedDependency' 101 | , upgradeRequired 102 | , upgradeRequired' 103 | , preconditionRequired 104 | , preconditionRequired' 105 | , tooManyRequests 106 | , tooManyRequests' 107 | , requestHeaderFieldsTooLarge 108 | , requestHeaderFieldsTooLarge' 109 | , unavailableForLegalReasons 110 | , unavailableForLegalReasons' 111 | -- 5xx 112 | , internalServerError 113 | , internalServerError' 114 | , notImplemented 115 | , notImplemented' 116 | , badGateway 117 | , badGateway' 118 | , serviceUnavailable 119 | , serviceUnavailable' 120 | , gatewayTimeout 121 | , gatewayTimeout' 122 | , hTTPVersionNotSupported 123 | , hTTPVersionNotSupported' 124 | , variantAlsoNegotiates 125 | , variantAlsoNegotiates' 126 | , insufficientStorage 127 | , insufficientStorage' 128 | , loopDetected 129 | , loopDetected' 130 | , notExtended 131 | , notExtended' 132 | , networkAuthenticationRequired 133 | , networkAuthenticationRequired' 134 | ) where 135 | 136 | import Prelude 137 | 138 | import Effect.Aff (Aff) 139 | import Effect.Aff.Class (class MonadAff, liftAff) 140 | import Effect.Class (class MonadEffect, liftEffect) 141 | import HTTPure.Body (class Body, defaultHeaders, write) 142 | import HTTPure.Headers (Headers, empty) 143 | import HTTPure.MultiHeaders (MultiHeaders) 144 | import HTTPure.MultiHeaders as HTTPure.MultiHeaders 145 | import HTTPure.Status (Status) 146 | import HTTPure.Status 147 | ( accepted 148 | , alreadyReported 149 | , badGateway 150 | , badRequest 151 | , conflict 152 | , continue 153 | , created 154 | , expectationFailed 155 | , failedDependency 156 | , forbidden 157 | , found 158 | , gatewayTimeout 159 | , gone 160 | , hTTPVersionNotSupported 161 | , iMUsed 162 | , imATeapot 163 | , insufficientStorage 164 | , internalServerError 165 | , lengthRequired 166 | , locked 167 | , loopDetected 168 | , methodNotAllowed 169 | , misdirectedRequest 170 | , movedPermanently 171 | , multiStatus 172 | , multipleChoices 173 | , networkAuthenticationRequired 174 | , noContent 175 | , nonAuthoritativeInformation 176 | , notAcceptable 177 | , notExtended 178 | , notFound 179 | , notImplemented 180 | , notModified 181 | , ok 182 | , partialContent 183 | , payloadTooLarge 184 | , paymentRequired 185 | , permanentRedirect 186 | , preconditionFailed 187 | , preconditionRequired 188 | , processing 189 | , proxyAuthenticationRequired 190 | , rangeNotSatisfiable 191 | , requestHeaderFieldsTooLarge 192 | , requestTimeout 193 | , resetContent 194 | , seeOther 195 | , serviceUnavailable 196 | , switchingProtocols 197 | , temporaryRedirect 198 | , tooManyRequests 199 | , uRITooLong 200 | , unauthorized 201 | , unavailableForLegalReasons 202 | , unprocessableEntity 203 | , unsupportedMediaType 204 | , upgradeRequired 205 | , useProxy 206 | , variantAlsoNegotiates 207 | , write 208 | ) as Status 209 | import Node.HTTP (Response) as HTTP 210 | 211 | -- | The `ResponseM` type simply conveniently wraps up an HTTPure monad that 212 | -- | returns a response. This type is the return type of all router/route 213 | -- | methods. 214 | type ResponseM = Aff Response 215 | 216 | -- | A `Response` is a status code, headers, and a body. 217 | type Response = 218 | { status :: Status 219 | , headers :: Headers 220 | , multiHeaders :: MultiHeaders 221 | , writeBody :: HTTP.Response -> Aff Unit 222 | } 223 | 224 | -- | Given an HTTP `Response` and a HTTPure `Response`, this method will return 225 | -- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response` 226 | -- | and closing the HTTP `Response`. 227 | -- | 228 | -- | If a header exists in both `headers` and `multiHeaders`, the values will be 229 | -- | joined as if they were all in `multiHeaders`. 230 | send :: forall m. MonadEffect m => MonadAff m => HTTP.Response -> Response -> m Unit 231 | send httpresponse { status, headers, multiHeaders, writeBody } = do 232 | liftEffect $ Status.write httpresponse status 233 | liftEffect 234 | $ HTTPure.MultiHeaders.write httpresponse 235 | $ HTTPure.MultiHeaders.fromHeaders headers <> multiHeaders 236 | liftAff $ writeBody httpresponse 237 | 238 | -- | For custom response statuses or providing a body for response codes that 239 | -- | don't typically send one. 240 | response :: forall m b. MonadAff m => Body b => Status -> b -> m Response 241 | response status = response' status empty 242 | 243 | -- | The same as `response` but with headers. 244 | response' :: 245 | forall m b. 246 | MonadAff m => 247 | Body b => 248 | Status -> 249 | Headers -> 250 | b -> 251 | m Response 252 | response' status headers body = liftEffect do 253 | defaultHeaders' <- defaultHeaders body 254 | pure 255 | { status 256 | , headers: defaultHeaders' <> headers 257 | , multiHeaders: HTTPure.MultiHeaders.empty 258 | , writeBody: write body 259 | } 260 | 261 | -- | The same as `response` but without a body. 262 | emptyResponse :: forall m. MonadAff m => Status -> m Response 263 | emptyResponse status = emptyResponse' status empty 264 | 265 | -- | The same as `emptyResponse` but with headers. 266 | emptyResponse' :: forall m. MonadAff m => Status -> Headers -> m Response 267 | emptyResponse' status headers = response' status headers "" 268 | 269 | --------- 270 | -- 1xx -- 271 | --------- 272 | -- | 100 273 | continue :: forall m. MonadAff m => m Response 274 | continue = continue' empty 275 | 276 | -- | 100 with headers 277 | continue' :: forall m. MonadAff m => Headers -> m Response 278 | continue' = emptyResponse' Status.continue 279 | 280 | -- | 101 281 | switchingProtocols :: forall m. MonadAff m => m Response 282 | switchingProtocols = switchingProtocols' empty 283 | 284 | -- | 101 with headers 285 | switchingProtocols' :: forall m. MonadAff m => Headers -> m Response 286 | switchingProtocols' = emptyResponse' Status.switchingProtocols 287 | 288 | -- | 102 289 | processing :: forall m. MonadAff m => m Response 290 | processing = processing' empty 291 | 292 | -- | 102 with headers 293 | processing' :: forall m. MonadAff m => Headers -> m Response 294 | processing' = emptyResponse' Status.processing 295 | 296 | --------- 297 | -- 2xx -- 298 | --------- 299 | -- | 200 300 | ok :: forall m b. MonadAff m => Body b => b -> m Response 301 | ok = ok' empty 302 | 303 | -- | 200 with headers 304 | ok' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 305 | ok' = response' Status.ok 306 | 307 | -- | 201 308 | created :: forall m. MonadAff m => m Response 309 | created = created' empty 310 | 311 | -- | 201 with headers 312 | created' :: forall m. MonadAff m => Headers -> m Response 313 | created' = emptyResponse' Status.created 314 | 315 | -- | 202 316 | accepted :: forall m. MonadAff m => m Response 317 | accepted = accepted' empty 318 | 319 | -- | 202 with headers 320 | accepted' :: forall m. MonadAff m => Headers -> m Response 321 | accepted' = emptyResponse' Status.accepted 322 | 323 | -- | 203 324 | nonAuthoritativeInformation :: forall m b. MonadAff m => Body b => b -> m Response 325 | nonAuthoritativeInformation = nonAuthoritativeInformation' empty 326 | 327 | -- | 203 with headers 328 | nonAuthoritativeInformation' :: 329 | forall m b. 330 | MonadAff m => 331 | Body b => 332 | Headers -> 333 | b -> 334 | m Response 335 | nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation 336 | 337 | -- | 204 338 | noContent :: forall m. MonadAff m => m Response 339 | noContent = noContent' empty 340 | 341 | -- | 204 with headers 342 | noContent' :: forall m. MonadAff m => Headers -> m Response 343 | noContent' = emptyResponse' Status.noContent 344 | 345 | -- | 205 346 | resetContent :: forall m. MonadAff m => m Response 347 | resetContent = resetContent' empty 348 | 349 | -- | 205 with headers 350 | resetContent' :: forall m. MonadAff m => Headers -> m Response 351 | resetContent' = emptyResponse' Status.resetContent 352 | 353 | -- | 206 354 | partialContent :: forall m b. MonadAff m => Body b => b -> m Response 355 | partialContent = partialContent' empty 356 | 357 | -- | 206 with headers 358 | partialContent' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 359 | partialContent' = response' Status.partialContent 360 | 361 | -- | 207 362 | multiStatus :: forall m b. MonadAff m => Body b => b -> m Response 363 | multiStatus = multiStatus' empty 364 | 365 | -- | 207 with headers 366 | multiStatus' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 367 | multiStatus' = response' Status.multiStatus 368 | 369 | -- | 208 370 | alreadyReported :: forall m. MonadAff m => m Response 371 | alreadyReported = alreadyReported' empty 372 | 373 | -- | 208 with headers 374 | alreadyReported' :: forall m. MonadAff m => Headers -> m Response 375 | alreadyReported' = emptyResponse' Status.alreadyReported 376 | 377 | -- | 226 378 | iMUsed :: forall m b. MonadAff m => Body b => b -> m Response 379 | iMUsed = iMUsed' empty 380 | 381 | -- | 226 with headers 382 | iMUsed' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 383 | iMUsed' = response' Status.iMUsed 384 | 385 | --------- 386 | -- 3xx -- 387 | --------- 388 | -- | 300 389 | multipleChoices :: forall m b. MonadAff m => Body b => b -> m Response 390 | multipleChoices = multipleChoices' empty 391 | 392 | -- | 300 with headers 393 | multipleChoices' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 394 | multipleChoices' = response' Status.multipleChoices 395 | 396 | -- | 301 397 | movedPermanently :: forall m b. MonadAff m => Body b => b -> m Response 398 | movedPermanently = movedPermanently' empty 399 | 400 | -- | 301 with headers 401 | movedPermanently' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 402 | movedPermanently' = response' Status.movedPermanently 403 | 404 | -- | 302 405 | found :: forall m b. MonadAff m => Body b => b -> m Response 406 | found = found' empty 407 | 408 | -- | 302 with headers 409 | found' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 410 | found' = response' Status.found 411 | 412 | -- | 303 413 | seeOther :: forall m b. MonadAff m => Body b => b -> m Response 414 | seeOther = seeOther' empty 415 | 416 | -- | 303 with headers 417 | seeOther' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 418 | seeOther' = response' Status.seeOther 419 | 420 | -- | 304 421 | notModified :: forall m. MonadAff m => m Response 422 | notModified = notModified' empty 423 | 424 | -- | 304 with headers 425 | notModified' :: forall m. MonadAff m => Headers -> m Response 426 | notModified' = emptyResponse' Status.notModified 427 | 428 | -- | 305 429 | useProxy :: forall m b. MonadAff m => Body b => b -> m Response 430 | useProxy = useProxy' empty 431 | 432 | -- | 305 with headers 433 | useProxy' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 434 | useProxy' = response' Status.useProxy 435 | 436 | -- | 307 437 | temporaryRedirect :: forall m b. MonadAff m => Body b => b -> m Response 438 | temporaryRedirect = temporaryRedirect' empty 439 | 440 | -- | 307 with headers 441 | temporaryRedirect' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 442 | temporaryRedirect' = response' Status.temporaryRedirect 443 | 444 | -- | 308 445 | permanentRedirect :: forall m b. MonadAff m => Body b => b -> m Response 446 | permanentRedirect = permanentRedirect' empty 447 | 448 | -- | 308 with headers 449 | permanentRedirect' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 450 | permanentRedirect' = response' Status.permanentRedirect 451 | 452 | --------- 453 | -- 4xx -- 454 | --------- 455 | -- | 400 456 | badRequest :: forall m b. MonadAff m => Body b => b -> m Response 457 | badRequest = badRequest' empty 458 | 459 | -- | 400 with headers 460 | badRequest' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 461 | badRequest' = response' Status.badRequest 462 | 463 | -- | 401 464 | unauthorized :: forall m. MonadAff m => m Response 465 | unauthorized = unauthorized' empty 466 | 467 | -- | 401 with headers 468 | unauthorized' :: forall m. MonadAff m => Headers -> m Response 469 | unauthorized' = emptyResponse' Status.unauthorized 470 | 471 | -- | 402 472 | paymentRequired :: forall m. MonadAff m => m Response 473 | paymentRequired = paymentRequired' empty 474 | 475 | -- | 402 with headers 476 | paymentRequired' :: forall m. MonadAff m => Headers -> m Response 477 | paymentRequired' = emptyResponse' Status.paymentRequired 478 | 479 | -- | 403 480 | forbidden :: forall m. MonadAff m => m Response 481 | forbidden = forbidden' empty 482 | 483 | -- | 403 with headers 484 | forbidden' :: forall m. MonadAff m => Headers -> m Response 485 | forbidden' = emptyResponse' Status.forbidden 486 | 487 | -- | 404 488 | notFound :: forall m. MonadAff m => m Response 489 | notFound = notFound' empty 490 | 491 | -- | 404 with headers 492 | notFound' :: forall m. MonadAff m => Headers -> m Response 493 | notFound' = emptyResponse' Status.notFound 494 | 495 | -- | 405 496 | methodNotAllowed :: forall m. MonadAff m => m Response 497 | methodNotAllowed = methodNotAllowed' empty 498 | 499 | -- | 405 with headers 500 | methodNotAllowed' :: forall m. MonadAff m => Headers -> m Response 501 | methodNotAllowed' = emptyResponse' Status.methodNotAllowed 502 | 503 | -- | 406 504 | notAcceptable :: forall m. MonadAff m => m Response 505 | notAcceptable = notAcceptable' empty 506 | 507 | -- | 406 with headers 508 | notAcceptable' :: forall m. MonadAff m => Headers -> m Response 509 | notAcceptable' = emptyResponse' Status.notAcceptable 510 | 511 | -- | 407 512 | proxyAuthenticationRequired :: forall m. MonadAff m => m Response 513 | proxyAuthenticationRequired = proxyAuthenticationRequired' empty 514 | 515 | -- | 407 with headers 516 | proxyAuthenticationRequired' :: forall m. MonadAff m => Headers -> m Response 517 | proxyAuthenticationRequired' = emptyResponse' Status.proxyAuthenticationRequired 518 | 519 | -- | 408 520 | requestTimeout :: forall m. MonadAff m => m Response 521 | requestTimeout = requestTimeout' empty 522 | 523 | -- | 408 with headers 524 | requestTimeout' :: forall m. MonadAff m => Headers -> m Response 525 | requestTimeout' = emptyResponse' Status.requestTimeout 526 | 527 | -- | 409 528 | conflict :: forall m b. MonadAff m => Body b => b -> m Response 529 | conflict = conflict' empty 530 | 531 | -- | 409 with headers 532 | conflict' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response 533 | conflict' = response' Status.conflict 534 | 535 | -- | 410 536 | gone :: forall m. MonadAff m => m Response 537 | gone = gone' empty 538 | 539 | -- | 410 with headers 540 | gone' :: forall m. MonadAff m => Headers -> m Response 541 | gone' = emptyResponse' Status.gone 542 | 543 | -- | 411 544 | lengthRequired :: forall m. MonadAff m => m Response 545 | lengthRequired = lengthRequired' empty 546 | 547 | -- | 411 with headers 548 | lengthRequired' :: forall m. MonadAff m => Headers -> m Response 549 | lengthRequired' = emptyResponse' Status.lengthRequired 550 | 551 | -- | 412 552 | preconditionFailed :: forall m. MonadAff m => m Response 553 | preconditionFailed = preconditionFailed' empty 554 | 555 | -- | 412 with headers 556 | preconditionFailed' :: forall m. MonadAff m => Headers -> m Response 557 | preconditionFailed' = emptyResponse' Status.preconditionFailed 558 | 559 | -- | 413 560 | payloadTooLarge :: forall m. MonadAff m => m Response 561 | payloadTooLarge = payloadTooLarge' empty 562 | 563 | -- | 413 with headers 564 | payloadTooLarge' :: forall m. MonadAff m => Headers -> m Response 565 | payloadTooLarge' = emptyResponse' Status.payloadTooLarge 566 | 567 | -- | 414 568 | uRITooLong :: forall m. MonadAff m => m Response 569 | uRITooLong = uRITooLong' empty 570 | 571 | -- | 414 with headers 572 | uRITooLong' :: forall m. MonadAff m => Headers -> m Response 573 | uRITooLong' = emptyResponse' Status.uRITooLong 574 | 575 | -- | 415 576 | unsupportedMediaType :: forall m. MonadAff m => m Response 577 | unsupportedMediaType = unsupportedMediaType' empty 578 | 579 | -- | 415 with headers 580 | unsupportedMediaType' :: forall m. MonadAff m => Headers -> m Response 581 | unsupportedMediaType' = emptyResponse' Status.unsupportedMediaType 582 | 583 | -- | 416 584 | rangeNotSatisfiable :: forall m. MonadAff m => m Response 585 | rangeNotSatisfiable = rangeNotSatisfiable' empty 586 | 587 | -- | 416 with headers 588 | rangeNotSatisfiable' :: forall m. MonadAff m => Headers -> m Response 589 | rangeNotSatisfiable' = emptyResponse' Status.rangeNotSatisfiable 590 | 591 | -- | 417 592 | expectationFailed :: forall m. MonadAff m => m Response 593 | expectationFailed = expectationFailed' empty 594 | 595 | -- | 417 with headers 596 | expectationFailed' :: forall m. MonadAff m => Headers -> m Response 597 | expectationFailed' = emptyResponse' Status.expectationFailed 598 | 599 | -- | 418 600 | imATeapot :: forall m. MonadAff m => m Response 601 | imATeapot = imATeapot' empty 602 | 603 | -- | 418 with headers 604 | imATeapot' :: forall m. MonadAff m => Headers -> m Response 605 | imATeapot' = emptyResponse' Status.imATeapot 606 | 607 | -- | 421 608 | misdirectedRequest :: forall m. MonadAff m => m Response 609 | misdirectedRequest = misdirectedRequest' empty 610 | 611 | -- | 421 with headers 612 | misdirectedRequest' :: forall m. MonadAff m => Headers -> m Response 613 | misdirectedRequest' = emptyResponse' Status.misdirectedRequest 614 | 615 | -- | 422 616 | unprocessableEntity :: forall m. MonadAff m => m Response 617 | unprocessableEntity = unprocessableEntity' empty 618 | 619 | -- | 422 with headers 620 | unprocessableEntity' :: forall m. MonadAff m => Headers -> m Response 621 | unprocessableEntity' = emptyResponse' Status.unprocessableEntity 622 | 623 | -- | 423 624 | locked :: forall m. MonadAff m => m Response 625 | locked = locked' empty 626 | 627 | -- | 423 with headers 628 | locked' :: forall m. MonadAff m => Headers -> m Response 629 | locked' = emptyResponse' Status.locked 630 | 631 | -- | 424 632 | failedDependency :: forall m. MonadAff m => m Response 633 | failedDependency = failedDependency' empty 634 | 635 | -- | 424 with headers 636 | failedDependency' :: forall m. MonadAff m => Headers -> m Response 637 | failedDependency' = emptyResponse' Status.failedDependency 638 | 639 | -- | 426 640 | upgradeRequired :: forall m. MonadAff m => m Response 641 | upgradeRequired = upgradeRequired' empty 642 | 643 | -- | 426 with headers 644 | upgradeRequired' :: forall m. MonadAff m => Headers -> m Response 645 | upgradeRequired' = emptyResponse' Status.upgradeRequired 646 | 647 | -- | 428 648 | preconditionRequired :: forall m. MonadAff m => m Response 649 | preconditionRequired = preconditionRequired' empty 650 | 651 | -- | 428 with headers 652 | preconditionRequired' :: forall m. MonadAff m => Headers -> m Response 653 | preconditionRequired' = emptyResponse' Status.preconditionRequired 654 | 655 | -- | 429 656 | tooManyRequests :: forall m. MonadAff m => m Response 657 | tooManyRequests = tooManyRequests' empty 658 | 659 | -- | 429 with headers 660 | tooManyRequests' :: forall m. MonadAff m => Headers -> m Response 661 | tooManyRequests' = emptyResponse' Status.tooManyRequests 662 | 663 | -- | 431 664 | requestHeaderFieldsTooLarge :: forall m. MonadAff m => m Response 665 | requestHeaderFieldsTooLarge = requestHeaderFieldsTooLarge' empty 666 | 667 | -- | 431 with headers 668 | requestHeaderFieldsTooLarge' :: forall m. MonadAff m => Headers -> m Response 669 | requestHeaderFieldsTooLarge' = emptyResponse' Status.requestHeaderFieldsTooLarge 670 | 671 | -- | 451 672 | unavailableForLegalReasons :: forall m. MonadAff m => m Response 673 | unavailableForLegalReasons = unavailableForLegalReasons' empty 674 | 675 | -- | 451 with headers 676 | unavailableForLegalReasons' :: forall m. MonadAff m => Headers -> m Response 677 | unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons 678 | 679 | --------- 680 | -- 5xx -- 681 | --------- 682 | -- | 500 683 | internalServerError :: forall m b. MonadAff m => Body b => b -> m Response 684 | internalServerError = internalServerError' empty 685 | 686 | -- | 500 with headers 687 | internalServerError' :: 688 | forall m b. 689 | MonadAff m => 690 | Body b => 691 | Headers -> 692 | b -> 693 | m Response 694 | internalServerError' = response' Status.internalServerError 695 | 696 | -- | 501 697 | notImplemented :: forall m. MonadAff m => m Response 698 | notImplemented = notImplemented' empty 699 | 700 | -- | 501 with headers 701 | notImplemented' :: forall m. MonadAff m => Headers -> m Response 702 | notImplemented' = emptyResponse' Status.notImplemented 703 | 704 | -- | 502 705 | badGateway :: forall m. MonadAff m => m Response 706 | badGateway = badGateway' empty 707 | 708 | -- | 502 with headers 709 | badGateway' :: forall m. MonadAff m => Headers -> m Response 710 | badGateway' = emptyResponse' Status.badGateway 711 | 712 | -- | 503 713 | serviceUnavailable :: forall m. MonadAff m => m Response 714 | serviceUnavailable = serviceUnavailable' empty 715 | 716 | -- | 503 with headers 717 | serviceUnavailable' :: forall m. MonadAff m => Headers -> m Response 718 | serviceUnavailable' = emptyResponse' Status.serviceUnavailable 719 | 720 | -- | 504 721 | gatewayTimeout :: forall m. MonadAff m => m Response 722 | gatewayTimeout = gatewayTimeout' empty 723 | 724 | -- | 504 with headers 725 | gatewayTimeout' :: forall m. MonadAff m => Headers -> m Response 726 | gatewayTimeout' = emptyResponse' Status.gatewayTimeout 727 | 728 | -- | 505 729 | hTTPVersionNotSupported :: forall m. MonadAff m => m Response 730 | hTTPVersionNotSupported = hTTPVersionNotSupported' empty 731 | 732 | -- | 505 with headers 733 | hTTPVersionNotSupported' :: forall m. MonadAff m => Headers -> m Response 734 | hTTPVersionNotSupported' = emptyResponse' Status.hTTPVersionNotSupported 735 | 736 | -- | 506 737 | variantAlsoNegotiates :: forall m. MonadAff m => m Response 738 | variantAlsoNegotiates = variantAlsoNegotiates' empty 739 | 740 | -- | 506 with headers 741 | variantAlsoNegotiates' :: forall m. MonadAff m => Headers -> m Response 742 | variantAlsoNegotiates' = emptyResponse' Status.variantAlsoNegotiates 743 | 744 | -- | 507 745 | insufficientStorage :: forall m. MonadAff m => m Response 746 | insufficientStorage = insufficientStorage' empty 747 | 748 | -- | 507 with headers 749 | insufficientStorage' :: forall m. MonadAff m => Headers -> m Response 750 | insufficientStorage' = emptyResponse' Status.insufficientStorage 751 | 752 | -- | 508 753 | loopDetected :: forall m. MonadAff m => m Response 754 | loopDetected = loopDetected' empty 755 | 756 | -- | 508 with headers 757 | loopDetected' :: forall m. MonadAff m => Headers -> m Response 758 | loopDetected' = emptyResponse' Status.loopDetected 759 | 760 | -- | 510 761 | notExtended :: forall m. MonadAff m => m Response 762 | notExtended = notExtended' empty 763 | 764 | -- | 510 with headers 765 | notExtended' :: forall m. MonadAff m => Headers -> m Response 766 | notExtended' = emptyResponse' Status.notExtended 767 | 768 | -- | 511 769 | networkAuthenticationRequired :: forall m. MonadAff m => m Response 770 | networkAuthenticationRequired = networkAuthenticationRequired' empty 771 | 772 | -- | 511 with headers 773 | networkAuthenticationRequired' :: forall m. MonadAff m => Headers -> m Response 774 | networkAuthenticationRequired' = emptyResponse' Status.networkAuthenticationRequired 775 | --------------------------------------------------------------------------------