Add custom HTTP configurations (#88)
This commit is contained in:
parent
a488d21108
commit
7c606aec49
@ -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"
|
||||
```
|
||||
|
||||
|
@ -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 $ " │ │"
|
||||
|
@ -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'
|
||||
)
|
||||
|
@ -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'
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user