From 80459a0bc472e62dd9e753736c2dd1c0f860e475 Mon Sep 17 00:00:00 2001 From: Shawn McGinty Date: Sun, 16 Jun 2019 14:35:17 -0500 Subject: [PATCH] added types for handling sessions, no implementation yet. --- .esyrc | 3 ++ .gitignore | 1 + docs/getting-started.md | 85 +++++++++++++++++++++++++++++- integration-test/fullServerTest.re | 3 +- package.json | 6 +-- src/Session.re | 1 + src/naboris.re | 3 +- src/req.re | 18 ++++++- src/res.re | 4 +- src/server.re | 9 +++- 10 files changed, 120 insertions(+), 13 deletions(-) create mode 100644 .esyrc create mode 100644 src/Session.re diff --git a/.esyrc b/.esyrc new file mode 100644 index 0000000..10b8bb9 --- /dev/null +++ b/.esyrc @@ -0,0 +1,3 @@ +{ + "prefixPath": ".esy" +} \ No newline at end of file diff --git a/.gitignore b/.gitignore index 49d5c6e..961aadc 100644 --- a/.gitignore +++ b/.gitignore @@ -23,6 +23,7 @@ setup.log .merlin _esy +.esy node_modules esy.lock naboris.install diff --git a/docs/getting-started.md b/docs/getting-started.md index ba23cb2..3f661c2 100644 --- a/docs/getting-started.md +++ b/docs/getting-started.md @@ -2,10 +2,26 @@ ### Configure the server ```ocaml -let testServerConfig: Naboris.Server.serverConfig = { +type mySession = { + user: UserInfo +}; + +let sessionConfig: Naboris.Server.sessionConfig(mySession) = { + onRequest: (sessionId) => { + getSessionFromDbOrWhatever(sessionId) + >>= ( + (mySessionData) => { + Lwt.return(Naboris.Session(mySessionData)); + } + ); + } +}; + +let testServerConfig: Naboris.Server.serverConfig(mySession) = { onListen: () => { print_string("🐫 Yay your server has started!\n"); }, + sessionConfig: Some(sessionConfig), routeRequest: (route, req, res) => switch (route.method, route.path) { | (Naboris.Method.GET, ["echo", "pre-existing-route"]) => @@ -57,10 +73,75 @@ let testServerConfig: Naboris.Server.serverConfig = { }, }; ``` - +`Naboris.Server.serverConfig('s)` - `'s` being your session data type. - `onListen: unit -> unit` - Function callback that fires after the server has started. +- `sessionConfig: Some(Naboris.Server.sessionConfig('s))` - Hooks to attach your session data to the naboris request. - `routeRequest: Naboris.Route.t -> Naboris.Req.t -> Naboris.Res.t -> Lwt.t(unit)` - Function that gets called on every request. Use pattern matching to route and handle each request. +### Sessions +If the server config record includes a session config, the `onRequest` function will fire for each incoming request and attach the output to `Lwt.t(Req.session(s))` (`s` being your session data). + +- `Naboris.Session.get(Naboris.Req.t) => Option('s)` - `'s` being the type of `s` returned by `onRequest` in the `sessionConfig('s)` record. + +### Example without sessions +```ocaml +let testServerConfig: Naboris.Server.serverConfig(unit) = { + onListen: () => { + print_string("🐫 Yay your server has started!\n"); + }, + sessionConfig: None, + routeRequest: (route, req, res) => + switch (route.method, route.path) { + | (Naboris.Method.GET, ["echo", "pre-existing-route"]) => + Naboris.Res.status(200, res) + |> Naboris.Res.html( + req, + "This route should take priority in the matcher.", + ); + Lwt.return_unit; + | (Naboris.Method.GET, ["html"]) => + Naboris.Res.status(200, res) + |> Naboris.Res.html( + req, + "You made it.", + ); + Lwt.return_unit; + | (Naboris.Method.GET, ["echo-query", "query"]) => + echoQueryQuery(req, res, route.query); + Lwt.return_unit; + | (Naboris.Method.GET, ["echo", str]) => + Naboris.Res.status(200, res) |> Naboris.Res.html(req, str); + Lwt.return_unit; + | (Naboris.Method.GET, ["echo", str1, "multi", str2]) => + Naboris.Res.status(200, res) + |> Naboris.Res.html(req, str1 ++ "\n" ++ str2); + Lwt.return_unit; + | (POST, ["echo"]) => + Lwt.bind( + Naboris.Req.getBody(req), + bodyStr => { + Naboris.Res.status(200, res) |> Naboris.Res.html(req, bodyStr); + Lwt.return_unit; + }, + ) + | (GET, ["static", ...staticPath]) => + Naboris.Res.static( + Sys.getcwd() ++ "/test/test_assets", + staticPath, + req, + res, + ) + | _ => + Naboris.Res.status(404, res) + |> Naboris.Res.html( + req, + "Page not found", + ); + Lwt.return_unit; + }, +}; +``` + ### Fire it up! ```ocaml diff --git a/integration-test/fullServerTest.re b/integration-test/fullServerTest.re index d1343c4..3f2db43 100644 --- a/integration-test/fullServerTest.re +++ b/integration-test/fullServerTest.re @@ -62,7 +62,7 @@ let echoQueryQuery = (req, res, query) => { }; }; -let testServerConfig: Naboris.Server.serverConfig = { +let testServerConfig: Naboris.Server.serverConfig(unit) = { onListen: () => { print_string("🐫 Started a server on port 9991!\n\n"); switch (startTests(MainTestSpec.tests)) { @@ -70,6 +70,7 @@ let testServerConfig: Naboris.Server.serverConfig = { | _ => exit(1) }; }, + sessionConfig: None, routeRequest: (route, req, res) => switch (route.method, route.path) { | (Naboris.Method.GET, ["echo", "pre-existing-route"]) => diff --git a/package.json b/package.json index 6c98807..238f8a4 100644 --- a/package.json +++ b/package.json @@ -1,7 +1,7 @@ { "name": "naboris", "version": "0.0.4", - "description": "Express-like HTTP server for ocaml/reasonml. Based on httpaf and lwt.", + "description": "Simple HTTP server for ocaml/reasonml. Based on httpaf and lwt.", "esy": { "build": [ ["dune"] @@ -9,13 +9,13 @@ "install": [ "esy-installer" ], - "buildInSource": true + "buildInSource": "_build" }, "scripts": { "test": "npm run unit-test && npm run int-test", "unit-test": "esy b dune exec ./test/test.exe", "int-test": "esy b dune exec ./integration-test/fullServerTest.exe", - "install": "esy", + "install": "esy install", "build-main": "esy b dune build @install", "build-unit-test": "esy b dune build ./test/test.exe @install", "build-int-test": "esy b dune build ./integration-test/fullServerTest.exe @install", diff --git a/src/Session.re b/src/Session.re new file mode 100644 index 0000000..3310b0f --- /dev/null +++ b/src/Session.re @@ -0,0 +1 @@ +type t('sessionData) = {data: 'sessionData}; \ No newline at end of file diff --git a/src/naboris.re b/src/naboris.re index 842dc06..480327c 100644 --- a/src/naboris.re +++ b/src/naboris.re @@ -4,9 +4,10 @@ module Res = Res; module Method = Method; module QueryMap = Query.QueryMap; module MimeTypes = MimeTypes; +module Session = Session; open Lwt.Infix; -let listen = (port, serverConfig: Server.serverConfig) => { +let listen = (port, serverConfig: Server.serverConfig('a)) => { let listenAddress = Unix.(ADDR_INET(inet_addr_loopback, port)); let connectionHandler = Server.buildConnectionHandler(serverConfig); diff --git a/src/req.re b/src/req.re index b6ab9e2..96dbd3f 100644 --- a/src/req.re +++ b/src/req.re @@ -1,4 +1,7 @@ -type t = {requestDescriptor: Httpaf.Reqd.t}; +type t('sessionData) = { + requestDescriptor: Httpaf.Reqd.t, + session: option(Session.t('sessionData)), +}; let getHeader = (headerKey, req) => switch (Httpaf.Reqd.request(req.requestDescriptor)) { @@ -21,4 +24,15 @@ let getBody = ({requestDescriptor, _}) => { Lwt_stream.fold((a, b) => a ++ b, bodyStream, ""); }; -let fromReqd = reqd => {requestDescriptor: reqd}; \ No newline at end of file +let fromReqd = reqd => {requestDescriptor: reqd, session: None}; + +let getSessionData = (req: t('a)) => { + switch (req.session) { + | None => None + | Some(session) => session.data + }; +}; + +let setSessionData = (req, data) => { + {...req, session: Some(data)}; +}; \ No newline at end of file diff --git a/src/res.re b/src/res.re index b8a4a21..ee94c7b 100644 --- a/src/res.re +++ b/src/res.re @@ -20,7 +20,7 @@ let status = (status: int, res: t) => { {...res, status}; }; -let html = (req: Req.t, htmlBody: string, res: t) => { +let html = (req: Req.t('a), htmlBody: string, res: t) => { let resWithHeaders = addHeader(("Content-Type", "text/html"), res) |> addHeader(("Connection", "close")); @@ -60,7 +60,7 @@ let streamFileContentsToBody = (fullFilePath, responseBody) => { ); }; -let static = (basePath, pathList, req: Req.t, res) => { +let static = (basePath, pathList, req: Req.t('a), res) => { let fullFilePath = Static.getFilePath(basePath, pathList); switch (Sys.file_exists(fullFilePath)) { | true => diff --git a/src/server.re b/src/server.re index 50457b8..35f4ee7 100644 --- a/src/server.re +++ b/src/server.re @@ -2,9 +2,14 @@ module Req = Req; module Res = Res; module Router = Router; -type serverConfig = { +type sessionConfig('sessionData) = { + onRequest: string => Lwt.t(Session.t('sessionData)), +}; + +type serverConfig('sessionData) = { onListen: unit => unit, - routeRequest: (Route.t, Req.t, Res.t) => Lwt.t(unit), + routeRequest: (Route.t, Req.t('sessionData), Res.t) => Lwt.t(unit), + sessionConfig: option(sessionConfig('sessionData)), }; let respondWithDefault = requestDescriptor => {