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
|
## Creating a Server
|
||||||
|
|
||||||
To create a server, use `HTTPure.serve` (no SSL) or `HTTPure.serve'` (SSL). Both
|
To create a server, use `HTTPure.serve` (no SSL) or `HTTPure.serveSecure` (SSL).
|
||||||
of these functions take a port number, a router function, and an `Eff` that will
|
Both of these functions take a port number, a router function, and an `Eff` that
|
||||||
run once the server has booted. The signature of the router function is:
|
will run once the server has booted. The signature of the router function is:
|
||||||
|
|
||||||
```purescript
|
```purescript
|
||||||
forall e. HTTPure.Request -> HTTPure.ResponseM e
|
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"
|
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),
|
Most of the [examples](./Examples), besides [the SSL Example](./Examples/SSL),
|
||||||
use this method to create the server.
|
use this method to create the server.
|
||||||
|
|
||||||
## SSL
|
## SSL
|
||||||
|
|
||||||
You can create an SSL-enabled HTTPure server using `HTTPure.serve'`, which has
|
You can create an SSL-enabled HTTPure server using `HTTPure.serveSecure`, which
|
||||||
the same signature as `HTTPure.serve` except that it additionally takes a path
|
has the same signature as `HTTPure.serve` except that it additionally takes a
|
||||||
to a cert file and a path to a key file after the port number:
|
path to a cert file and a path to a key file after the port number:
|
||||||
|
|
||||||
```purescript
|
```purescript
|
||||||
main =
|
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"
|
Console.log "Server up"
|
||||||
```
|
```
|
||||||
|
|
||||||
|
@ -27,7 +27,7 @@ sayHello _ = HTTPure.ok "hello world!"
|
|||||||
|
|
||||||
-- | Boot up the server
|
-- | Boot up the server
|
||||||
main :: forall e. HTTPure.SecureServerM (console :: Console.CONSOLE | e)
|
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 $ " ┌───────────────────────────────────────────┐"
|
||||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||||
Console.log $ " │ │"
|
Console.log $ " │ │"
|
||||||
|
@ -88,4 +88,11 @@ import HTTPure.Response
|
|||||||
, notExtended, notExtended'
|
, notExtended, notExtended'
|
||||||
, networkAuthenticationRequired, networkAuthenticationRequired'
|
, 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
|
, SecureServerM
|
||||||
, serve
|
, serve
|
||||||
, serve'
|
, serve'
|
||||||
|
, serveSecure
|
||||||
|
, serveSecure'
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
@ -11,7 +13,7 @@ import Control.Monad.Aff as Aff
|
|||||||
import Control.Monad.Eff as Eff
|
import Control.Monad.Eff as Eff
|
||||||
import Control.Monad.Eff.Class as EffClass
|
import Control.Monad.Eff.Class as EffClass
|
||||||
import Data.Maybe as Maybe
|
import Data.Maybe as Maybe
|
||||||
import Data.Options ((:=))
|
import Data.Options ((:=), Options)
|
||||||
import Node.Encoding as Encoding
|
import Node.Encoding as Encoding
|
||||||
import Node.FS as FS
|
import Node.FS as FS
|
||||||
import Node.FS.Sync as FSSync
|
import Node.FS.Sync as FSSync
|
||||||
@ -48,12 +50,12 @@ handleRequest router request response =
|
|||||||
-- | Given a `ListenOptions` object, a function mapping `Request` to
|
-- | Given a `ListenOptions` object, a function mapping `Request` to
|
||||||
-- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and
|
-- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and
|
||||||
-- | runs a HTTPure server without SSL.
|
-- | runs a HTTPure server without SSL.
|
||||||
bootHTTP :: forall e.
|
serve' :: forall e.
|
||||||
HTTP.ListenOptions ->
|
HTTP.ListenOptions ->
|
||||||
(Request.Request -> Response.ResponseM e) ->
|
(Request.Request -> Response.ResponseM e) ->
|
||||||
ServerM e ->
|
ServerM e ->
|
||||||
ServerM e
|
ServerM e
|
||||||
bootHTTP options router onStarted =
|
serve' options router onStarted =
|
||||||
HTTP.createServer (handleRequest router) >>= \server ->
|
HTTP.createServer (handleRequest router) >>= \server ->
|
||||||
HTTP.listen server options onStarted
|
HTTP.listen server options onStarted
|
||||||
|
|
||||||
@ -61,22 +63,15 @@ bootHTTP options router onStarted =
|
|||||||
-- | key file, a function mapping `Request` to `ResponseM`, and a
|
-- | key file, a function mapping `Request` to `ResponseM`, and a
|
||||||
-- | `SecureServerM` containing effects to run on boot, creates and runs a
|
-- | `SecureServerM` containing effects to run on boot, creates and runs a
|
||||||
-- | HTTPure server with SSL.
|
-- | HTTPure server with SSL.
|
||||||
bootHTTPS :: forall e.
|
serveSecure' :: forall e.
|
||||||
|
Options HTTPS.SSLOptions ->
|
||||||
HTTP.ListenOptions ->
|
HTTP.ListenOptions ->
|
||||||
String ->
|
|
||||||
String ->
|
|
||||||
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
|
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
|
||||||
SecureServerM e ->
|
SecureServerM e ->
|
||||||
SecureServerM e
|
SecureServerM e
|
||||||
bootHTTPS options cert key router onStarted = do
|
serveSecure' sslOptions options router onStarted =
|
||||||
cert' <- FSSync.readTextFile Encoding.UTF8 cert
|
HTTPS.createServer sslOptions (handleRequest router) >>= \server ->
|
||||||
key' <- FSSync.readTextFile Encoding.UTF8 key
|
|
||||||
server <- HTTPS.createServer (sslOpts key' cert') (handleRequest router)
|
|
||||||
HTTP.listen server options onStarted
|
HTTP.listen server options onStarted
|
||||||
where
|
|
||||||
sslOpts key' cert' =
|
|
||||||
HTTPS.key := HTTPS.keyString key' <>
|
|
||||||
HTTPS.cert := HTTPS.certString cert'
|
|
||||||
|
|
||||||
-- | Given a port number, return a `HTTP.ListenOptions` `Record`.
|
-- | Given a port number, return a `HTTP.ListenOptions` `Record`.
|
||||||
listenOptions :: Int -> HTTP.ListenOptions
|
listenOptions :: Int -> HTTP.ListenOptions
|
||||||
@ -96,7 +91,7 @@ serve :: forall e.
|
|||||||
(Request.Request -> Response.ResponseM e) ->
|
(Request.Request -> Response.ResponseM e) ->
|
||||||
ServerM e ->
|
ServerM 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
|
-- | Create and start an SSL server. This method is the same as `serve`, but
|
||||||
-- | takes additional SSL arguments. The arguments in order are:
|
-- | takes additional SSL arguments. The arguments in order are:
|
||||||
@ -105,11 +100,18 @@ serve = bootHTTP <<< listenOptions
|
|||||||
-- | 3. A path to a private key file
|
-- | 3. A path to a private key file
|
||||||
-- | 4. A handler method which maps `Request` to `ResponseM`
|
-- | 4. A handler method which maps `Request` to `ResponseM`
|
||||||
-- | 5. A callback to call when the server is up
|
-- | 5. A callback to call when the server is up
|
||||||
serve' :: forall e.
|
serveSecure :: forall e.
|
||||||
Int ->
|
Int ->
|
||||||
String ->
|
String ->
|
||||||
String ->
|
String ->
|
||||||
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
|
(Request.Request -> Response.ResponseM (fs :: FS.FS | e)) ->
|
||||||
SecureServerM e ->
|
SecureServerM e ->
|
||||||
SecureServerM e
|
SecureServerM e
|
||||||
serve' = bootHTTPS <<< listenOptions
|
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 Prelude
|
||||||
|
|
||||||
import Control.Monad.Eff.Class as EffClass
|
import Control.Monad.Eff.Class as EffClass
|
||||||
|
import Data.Maybe as Maybe
|
||||||
|
import Data.Options ((:=))
|
||||||
import Data.String as String
|
import Data.String as String
|
||||||
import Data.StrMap as StrMap
|
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 as Spec
|
||||||
import Test.Spec.Assertions.Aff as AffAssertions
|
import Test.Spec.Assertions.Aff as AffAssertions
|
||||||
|
|
||||||
@ -26,21 +31,50 @@ serveSpec = Spec.describe "serve" do
|
|||||||
out ?= "/test"
|
out ?= "/test"
|
||||||
|
|
||||||
serve'Spec :: TestHelpers.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.describe "with valid key and cert files" do
|
||||||
Spec.it "boots a server on the given port" do
|
Spec.it "boots a server on the given port" do
|
||||||
EffClass.liftEff $ Server.serve' 7902 cert key mockRouter $ pure unit
|
EffClass.liftEff $ Server.serveSecure 7903 cert key mockRouter $ pure unit
|
||||||
out <- TestHelpers.get' 7902 StrMap.empty "/test"
|
out <- TestHelpers.get' 7903 StrMap.empty "/test"
|
||||||
out ?= "/test"
|
out ?= "/test"
|
||||||
Spec.describe "with invalid key and cert files" do
|
Spec.describe "with invalid key and cert files" do
|
||||||
Spec.it "throws" do
|
Spec.it "throws" do
|
||||||
AffAssertions.expectError do
|
AffAssertions.expectError do
|
||||||
EffClass.liftEff $ Server.serve' 7903 "" "" mockRouter $ pure unit
|
EffClass.liftEff $ Server.serveSecure 7904 "" "" mockRouter $ pure unit
|
||||||
where
|
where
|
||||||
cert = "./test/Mocks/Certificate.cer"
|
cert = "./test/Mocks/Certificate.cer"
|
||||||
key = "./test/Mocks/Key.key"
|
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 :: TestHelpers.Test
|
||||||
serverSpec = Spec.describe "Server" do
|
serverSpec = Spec.describe "Server" do
|
||||||
serveSpec
|
serveSpec
|
||||||
serve'Spec
|
serve'Spec
|
||||||
|
serveSecureSpec
|
||||||
|
serveSecure'Spec
|
||||||
|
Loading…
Reference in New Issue
Block a user