login finished XD

permap.opam

@@ -0,0 +1,27 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "OCaml library/executable to TODO"
+description: "permap is an OCaml library/executable to TODO."
+maintainer: ["TODO"]
+authors: ["TODO"]
+license: "ISC"
+tags: ["permap" "TODO" "TODO" "TODO" "TODO"]
+depends: [
+  "dune" {>= "2.8"}
+  "ocaml" {>= "4.08"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]

src/content/assets/css/style.css

@@ -0,0 +1,23 @@
+body {
+  padding-top: 3rem;
+  padding-bottom: 3rem;
+  color: #5a5a5a;
+  background-color: #EEEEEE;
+  line-height: 1.6;
+  font-size: 18px;
+}
+
+.featurette-divider {
+  margin: 5rem 0;
+}
+
+#page-title {
+  text-align: center;
+}
+
+blockquote.blockquote {
+  border-left: 6px solid #3131e0;
+  border-radius: 6px;
+  padding-left: 16px;
+  background-color:  #c0c0f0;
+}

src/content/index.md

@@ -0,0 +1,3 @@
+# Hello world
+
+<iframe width="425" height="350" frameborder="0" scrolling="no" marginheight="0" marginwidth="0" src="https://www.openstreetmap.org/export/embed.html?bbox=-0.11535644531250001%2C48.09642606004488%2C3.5925292968750004%2C49.47169378524674&amp;layer=mapnik" style="border: 1px solid black"></iframe><br/><small><a href="https://www.openstreetmap.org/#map=9/48.7888/1.7386">Afficher une carte plus grande</a></small>

src/content/register.md

@@ -0,0 +1,19 @@
+# Register
+
+<form>
+  <div class="mb-3">
+    <label for="inputNick" class="form-label">Nick</label>
+    <input type="text" class="form-control" id="inputNick" aria-describedby="nickHelp">
+    <div id="nickHelp" class="form-text">Who are u ?</div>
+  </div>
+  <div class="mb-3">
+    <label for="inputEmail" class="form-label">Email address</label>
+    <input type="email" class="form-control" id="inputEmail" aria-describedby="emailHelp">
+    <div id="emailHelp" class="form-text">We'll never share your email with anyone else.</div>
+  </div>
+  <div class="mb-3">
+    <label for="inputPassword" class="form-label">Password</label>
+    <input type="password" class="form-control" id="inputPassword">
+  </div>
+  <button type="submit" class="btn btn-primary" formaction="/register">Submit</button>
+</form>

src/dune

@@ -1,3 +1,36 @@
 (executable
- (name permap)
+ (public_name permap)
- (modules permap))
+ (modules content login permap register template user)
+ (libraries
+  dream
+  emile
+  omd
+  lambdasoup)
+ (preprocess (pps lwt_ppx)))
+
+(rule
+ (targets template.ml)
+ (deps template.eml.html)
+ (action
+  (run dream_eml %{deps} --workspace %{workspace_root})))
+
+(rule
+ (targets login.ml)
+ (deps login.eml.html)
+ (action
+  (run dream_eml %{deps} --workspace %{workspace_root})))
+
+(rule
+ (targets register.ml)
+ (deps register.eml.html)
+ (action
+  (run dream_eml %{deps} --workspace %{workspace_root})))
+
+(rule
+ (target content.ml)
+ (deps
+  (source_tree content))
+ (action
+  (with-stdout-to
+   %{null}
+   (run ocaml-crunch -m plain content -o %{target}))))

src/login.eml.html

@@ -0,0 +1,24 @@
+let f ?nick ?password request =
+
+%   begin match nick, password with
+%   | Some nick, Some password ->
+%     begin match User.login ~nick ~password with
+%     | Error e ->
+Error: <%s e %>
+%     | Ok () ->
+Logged in ! Happy planting XD
+%     end;
+%   | _ ->
+    <%s! Dream.form_tag ~action:"/login" request %>
+      <div class="mb-3">
+        <label for="nick" class="form-label">Nick</label>
+        <input name="nick" type="text" class="form-control" id="nick" aria-describedby="nickHelp">
+        <div id="nickHelp" class="form-text">Who are u ?</div>
+      </div>
+      <div class="mb-3">
+        <label for="password" class="form-label">Password</label>
+        <input name="password" type="password" class="form-control" id="password">
+      </div>
+      <button type="submit" class="btn btn-primary">Submit</button>
+    </form>
+%   end;

src/permap.ml

@@ -1 +1,66 @@
-let () = Format.printf "Hello!@."
+let get_title content =
+  let open Soup in
+  try
+    let soup = content |> parse in
+    soup $ "h1" |> R.leaf_text
+  with
+  | Failure _e -> "Permap"
+
+let render ?title content =
+  let title =
+    match title with
+    | None -> get_title content
+    | Some title -> title
+  in
+  Dream.html
+  @@ Template.render_unsafe ~title:(Dream.html_escape title)
+       ~content:(Dream.html_escape content)
+
+let render_unsafe ?title content =
+  let title =
+    match title with
+    | None -> get_title content
+    | Some title -> title
+  in
+  Dream.html @@ Template.render_unsafe ~title ~content
+
+let asset_loader _root path _request =
+  match Content.read ("assets/" ^ path) with
+  | None -> Dream.empty `Not_Found
+  | Some asset -> Dream.respond asset
+
+let page path =
+  match Content.read (path ^ ".md") with
+  | None -> None
+  | Some page -> Some (Omd.of_string page |> Omd.to_html)
+
+let page_of_name name =
+  match page name with
+  | None -> Dream.empty `Not_Found
+  | Some content -> render_unsafe content
+
+let homepage _request = page_of_name "index"
+
+let register _request = page_of_name "register"
+
+let () =
+  Dream.run ~interface:"0.0.0.0"
+  @@ Dream.logger
+  @@ Dream.memory_sessions
+  @@ Dream.router
+       [ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
+       ; Dream.get "/" homepage
+       ; Dream.get "/register" (fun request -> render_unsafe (Register.f request))
+       ; Dream.post "/register" (fun request ->
+           match%lwt Dream.form request with
+           | `Ok ["email", email; "nick", nick; "password", password] ->
+             render_unsafe (Register.f ~nick ~email ~password request)
+           | _ -> assert false)
+       ; Dream.get "/login" (fun request -> render_unsafe (Login.f request))
+       ; Dream.post "/login" (fun request ->
+           match%lwt Dream.form request with
+           | `Ok ["nick", nick; "password", password] ->
+             render_unsafe (Login.f ~nick ~password request)
+           | _ -> assert false)
+       ]
+  @@ Dream.not_found

src/register.eml.html

@@ -0,0 +1,29 @@
+let f ?email ?nick ?password request =
+
+%   begin match email, nick, password with
+%   | Some email, Some nick, Some password ->
+%     begin match User.make ~email ~nick ~password with
+%     | Error e ->
+Error: <%s e %>
+%     | Ok () ->
+User created !
+%     end;
+%   | _ ->
+    <%s! Dream.form_tag ~action:"/register" request %>
+      <div class="mb-3">
+        <label for="nick" class="form-label">Nick</label>
+        <input name="nick" type="text" class="form-control" id="nick" aria-describedby="nickHelp">
+        <div id="nickHelp" class="form-text">Who are u ?</div>
+      </div>
+      <div class="mb-3">
+        <label for="email" class="form-label">Email address</label>
+        <input name="email" type="email" class="form-control" id="email" aria-describedby="emailHelp">
+        <div id="emailHelp" class="form-text">We'll never share your email with anyone else.</div>
+      </div>
+      <div class="mb-3">
+        <label for="password" class="form-label">Password</label>
+        <input name="password" type="password" class="form-control" id="password">
+      </div>
+      <button type="submit" class="btn btn-primary">Submit</button>
+    </form>
+%   end;

src/template.eml.html

@@ -0,0 +1,51 @@
+let render_unsafe ~title ~content =
+  <!DOCTYPE html>
+  <html lang="en">
+    <head>
+      <title><%s title %> | Permap</title>
+      <link rel="icon" type="image/svg+xml" href="/assets/img/favicon.png">
+      <link href="/assets/css/bootstrap.min.css" rel="stylesheet"/>
+      <link href="/assets/css/style.css" rel="stylesheet">
+    </head>
+    <body>
+      <header>
+          <nav class="navbar navbar-expand-md navbar-dark fixed-top bg-dark">
+              <div class="container-fluid">
+                <a class="navbar-brand" href="/">permap</a>
+                  <button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbarCollapse" aria-controls="navbarCollapse" aria-expanded="false" aria-label="Toggle navigation">
+                      <span class="navbar-toggler-icon"></span>
+                  </button>
+                  <div class="collapse navbar-collapse" id="navbarCollapse">
+                      <ul class="navbar-nav me-auto mb-2 mb-md-0">
+                          <li class="nav-item">
+                              <a class="nav-link" href="/">Home</a>
+                          </li>
+                          <li class="nav-item">
+                              <a class="nav-link" href="/register">Register</a>
+                          </li>
+                          <li class="nav-item">
+                              <a class="nav-link" href="/login">Login</a>
+                          </li>
+                      </ul>
+                  </div>
+              </div>
+          </nav>
+      </header>
+      <br />
+      <br />
+      <br />
+      <br />
+      <main>
+        <div class="container">
+          <%s! content %>
+        </div>
+        <hr class="featurette-divider">
+        <footer class="container">
+          <p>permap
+            | <a href="https://git.zapashcanon.fr/zapashcanon/permap">source code</a>
+          </p>
+        </footer>
+      </main>
+      <script src="/assets/js/bootstrap.bundle.min.js"></script>
+    </body>
+  </html>

src/user.ml

@@ -0,0 +1,35 @@
+type t = {
+  nick: string;
+  password: string;
+  email: string option;
+}
+
+
+let login ~nick ~password =
+  if nick = nick && password = password then
+  Ok ()
+  else
+    Error "DDD"
+
+let make ~email ~nick ~password =
+
+  let nick_escaped = String.escaped nick in
+  (* TODO: remove bad characters (e.g. delthas) *)
+  let valid_nick = String.length nick < 64 && String.length nick > 0 && nick_escaped = nick in
+
+  let valid_email = match Emile.of_string email with
+  | Ok _ -> true
+  | Error _ -> false
+  in
+
+  let valid_password = String.length password < 128 && String.length password > 0 in
+
+  let valid = valid_nick && valid_email && valid_password in
+
+  (* TODO: HASH PASSWORD XD *)
+
+  if valid then
+    (* TODO: add to db and check uniqueness of id *)
+    Ok ()
+  else
+    Error "Something is wrong."