added types for handling sessions, no implementation yet.

shawn-mcginty · Jun 16, 2019 · 80459a0 · 80459a0
1 parent 12ffbc0
commit 80459a0
Show file tree

Hide file tree

Showing 10 changed files with 120 additions and 13 deletions.
diff --git a/.esyrc b/.esyrc
@@ -0,0 +1,3 @@
+{
+	"prefixPath": ".esy"
+}
diff --git 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
@@ -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,
+           "<!doctype html><html><body>You made it.</body></html>",
+         );
+      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,
+           "<!doctype html><html><body>Page not found</body></html>",
+         );
+      Lwt.return_unit;
+    },
+};
+```
+
 ### Fire it up!
 
 ```ocaml

diff --git a/integration-test/fullServerTest.re b/integration-test/fullServerTest.re
@@ -62,14 +62,15 @@ 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)) {
     | TestDone => exit(0)
     | _ => 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
@@ -1,21 +1,21 @@
 {
   "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"]
     ],
     "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
@@ -0,0 +1 @@
+type t('sessionData) = {data: 'sessionData};
diff --git 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
@@ -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};
+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)};
+};
diff --git 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
@@ -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 => {
-Original file line number
+Diff line change
@@ Expand Up / @@ -23,6 +23,7 @@ setup.log @@
     .merlin
     _esy
+    .esy
     node_modules
     esy.lock
     naboris.install
@@ Expand Down @@