Add custom HTTP configurations (#88)

This commit is contained in:
Connor Prussin 2018-02-08 21:46:45 -08:00 committed by GitHub
parent a488d21108
commit 7c606aec49
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 103 additions and 45 deletions

View File

@ -4,9 +4,9 @@ This guide is a brief overview of the basics of creating a HTTPure server.
## Creating a Server
To create a server, use `HTTPure.serve` (no SSL) or `HTTPure.serve'` (SSL). Both
of these functions take a port number, a router function, and an `Eff` that will
run once the server has booted. The signature of the router function is:
To create a server, use `HTTPure.serve` (no SSL) or `HTTPure.serveSecure` (SSL).
Both of these functions take a port number, a router function, and an `Eff` that
will run once the server has booted. The signature of the router function is:
```purescript
forall e. HTTPure.Request -> HTTPure.ResponseM e
@ -25,18 +25,33 @@ You can create an HTTPure server without SSL using `HTTPure.serve`:
main = HTTPure.serve 8080 router $ Console.log "Server up"
```
You can also create a server using a custom `HTTP.ListenOptions` `Record`:
```purescript
main = HTTPure.serve' customOptions router $ Console.log "Server up"
```
Most of the [examples](./Examples), besides [the SSL Example](./Examples/SSL),
use this method to create the server.
## SSL
You can create an SSL-enabled HTTPure server using `HTTPure.serve'`, which has
the same signature as `HTTPure.serve` except that it additionally takes a path
to a cert file and a path to a key file after the port number:
You can create an SSL-enabled HTTPure server using `HTTPure.serveSecure`, which
has the same signature as `HTTPure.serve` except that it additionally takes a
path to a cert file and a path to a key file after the port number:
```purescript
main =
HTTPure.serve 8080 "./Certificate.cer" "./Key.key" router $
HTTPure.serveSecure 8080 "./Certificate.cer" "./Key.key" router $
Console.log "Server up"
```
You can also create a server using a `HTTP.ListenOptions` and a `Options
HTTPS.SSLOptions`:
```purescript
main =
HTTPure.serveSecure' customSSLOptions customOptions router $
Console.log "Server up"
```

View File

@ -27,7 +27,7 @@ sayHello _ = HTTPure.ok "hello world!"
-- | Boot up the server
main :: forall e. HTTPure.SecureServerM (console :: Console.CONSOLE | e)
main = HTTPure.serve' port cert key sayHello do
main = HTTPure.serveSecure port cert key sayHello do
Console.log $ " ┌───────────────────────────────────────────┐"
Console.log $ " │ Server now up on port " <> portS <> ""
Console.log $ " │ │"

View File

@ -88,4 +88,11 @@ import HTTPure.Response
, notExtended, notExtended'
, networkAuthenticationRequired, networkAuthenticationRequired'
)
import HTTPure.Server (SecureServerM, ServerM, serve, serve')
import HTTPure.Server
( SecureServerM
, ServerM
, serve
, serve'
, serveSecure
, serveSecure'
)

View File

@ -3,6 +3,8 @@ module HTTPure.Server
, SecureServerM
, serve
, serve'
, serveSecure
, serveSecure'
) where
import Prelude
@ -11,7 +13,7 @@ import Control.Monad.Aff as Aff
import Control.Monad.Eff as Eff
import Control.Monad.Eff.Class as EffClass
import Data.Maybe as Maybe
import Data.Options ((:=))
import Data.Options ((:=), Options)
import Node.Encoding as Encoding
import Node.FS as FS
import Node.FS.Sync as FSSync
@ -48,12 +50,12 @@ handleRequest router request response =
-- | Given a `ListenOptions` object, a function mapping `Request` to
-- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and
-- | runs a HTTPure server without SSL.
bootHTTP :: forall e.
HTTP.ListenOptions ->
(Request.Request -> Response.ResponseM e) ->
ServerM e ->
ServerM e
bootHTTP options router onStarted =
serve' :: forall e.
HTTP.ListenOptions ->
(Request.Request -> Response.ResponseM e) ->
ServerM e ->
ServerM e
serve' options router onStarted =
HTTP.createServer (handleRequest router) >>= \server ->
HTTP.listen server options onStarted
@ -61,22 +63,15 @@ bootHTTP options router onStarted =
-- | key file, a function mapping `Request` to `ResponseM`, and a
-- | `SecureServerM` containing effects to run on boot, creates and runs a
-- | HTTPure server with SSL.
bootHTTPS :: forall e.
HTTP.ListenOptions ->
String ->
String ->
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
SecureServerM e ->
SecureServerM e
bootHTTPS options cert key router onStarted = do
cert' <- FSSync.readTextFile Encoding.UTF8 cert
key' <- FSSync.readTextFile Encoding.UTF8 key
server <- HTTPS.createServer (sslOpts key' cert') (handleRequest router)
HTTP.listen server options onStarted
where
sslOpts key' cert' =
HTTPS.key := HTTPS.keyString key' <>
HTTPS.cert := HTTPS.certString cert'
serveSecure' :: forall e.
Options HTTPS.SSLOptions ->
HTTP.ListenOptions ->
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
SecureServerM e ->
SecureServerM e
serveSecure' sslOptions options router onStarted =
HTTPS.createServer sslOptions (handleRequest router) >>= \server ->
HTTP.listen server options onStarted
-- | Given a port number, return a `HTTP.ListenOptions` `Record`.
listenOptions :: Int -> HTTP.ListenOptions
@ -96,7 +91,7 @@ serve :: forall e.
(Request.Request -> Response.ResponseM e) ->
ServerM e ->
ServerM e
serve = bootHTTP <<< listenOptions
serve = serve' <<< listenOptions
-- | Create and start an SSL server. This method is the same as `serve`, but
-- | takes additional SSL arguments. The arguments in order are:
@ -105,11 +100,18 @@ serve = bootHTTP <<< listenOptions
-- | 3. A path to a private key file
-- | 4. A handler method which maps `Request` to `ResponseM`
-- | 5. A callback to call when the server is up
serve' :: forall e.
Int ->
String ->
String ->
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
SecureServerM e ->
SecureServerM e
serve' = bootHTTPS <<< listenOptions
serveSecure :: forall e.
Int ->
String ->
String ->
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
SecureServerM e ->
SecureServerM e
serveSecure port cert key router onStarted = do
cert' <- FSSync.readTextFile Encoding.UTF8 cert
key' <- FSSync.readTextFile Encoding.UTF8 key
serveSecure' (sslOpts key' cert') (listenOptions port) router onStarted
where
sslOpts key' cert' =
HTTPS.key := HTTPS.keyString key' <>
HTTPS.cert := HTTPS.certString cert'

View File

@ -3,8 +3,13 @@ module Test.HTTPure.ServerSpec where
import Prelude
import Control.Monad.Eff.Class as EffClass
import Data.Maybe as Maybe
import Data.Options ((:=))
import Data.String as String
import Data.StrMap as StrMap
import Node.Encoding as Encoding
import Node.HTTP.Secure as HTTPS
import Node.FS.Sync as FSSync
import Test.Spec as Spec
import Test.Spec.Assertions.Aff as AffAssertions
@ -26,21 +31,50 @@ serveSpec = Spec.describe "serve" do
out ?= "/test"
serve'Spec :: TestHelpers.Test
serve'Spec = Spec.describe "serve" do
serve'Spec = Spec.describe "serve'" do
Spec.it "boots a server with the given options" do
EffClass.liftEff $ Server.serve' options mockRouter $ pure unit
out <- TestHelpers.get 7902 StrMap.empty "/test"
out ?= "/test"
where
options = { hostname: "localhost", port: 7902, backlog: Maybe.Nothing }
serveSecureSpec :: TestHelpers.Test
serveSecureSpec = Spec.describe "serveSecure" do
Spec.describe "with valid key and cert files" do
Spec.it "boots a server on the given port" do
EffClass.liftEff $ Server.serve' 7902 cert key mockRouter $ pure unit
out <- TestHelpers.get' 7902 StrMap.empty "/test"
EffClass.liftEff $ Server.serveSecure 7903 cert key mockRouter $ pure unit
out <- TestHelpers.get' 7903 StrMap.empty "/test"
out ?= "/test"
Spec.describe "with invalid key and cert files" do
Spec.it "throws" do
AffAssertions.expectError do
EffClass.liftEff $ Server.serve' 7903 "" "" mockRouter $ pure unit
EffClass.liftEff $ Server.serveSecure 7904 "" "" mockRouter $ pure unit
where
cert = "./test/Mocks/Certificate.cer"
key = "./test/Mocks/Key.key"
serveSecure'Spec :: TestHelpers.Test
serveSecure'Spec = Spec.describe "serveSecure'" do
Spec.describe "with valid key and cert files" do
Spec.it "boots a server on the given port" do
sslOpts <- EffClass.liftEff $ sslOptions
EffClass.liftEff $
Server.serveSecure' sslOpts (options 7905) mockRouter $ pure unit
out <- TestHelpers.get' 7905 StrMap.empty "/test"
out ?= "/test"
where
options port = { hostname: "localhost", port, backlog: Maybe.Nothing }
sslOptions = do
cert <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Certificate.cer"
key <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Key.key"
pure $
HTTPS.key := HTTPS.keyString key <>
HTTPS.cert := HTTPS.certString cert
serverSpec :: TestHelpers.Test
serverSpec = Spec.describe "Server" do
serveSpec
serve'Spec
serveSecureSpec
serveSecure'Spec