sharpetronics/dream
1
0
Fork 0
mirror of https://github.com/aantron/dream.git synced 2025-12-09 00:03:47 -05:00
Code Issues Projects Releases Wiki Activity

Playground proof of concept

Browse Source
This commit is contained in:
Anton Bachin 2021-04-26 14:18:59 +03:00
parent 801745075b
commit 882a48ee04
13 changed files with 601 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
docs/web/site/docs.js
View File

@ -1,3 +1,10 @@
// This file is part of Dream, released under the MIT license. See LICENSE.md
// for details, or visit https://github.com/aantron/dream.
//
// Copyright 2021 Anton Bachin *)
console.log("foo"); console.log("foo");
function current_section() { function current_section() {

7
docs/web/templates/index.html
View File

@ -1,3 +1,10 @@
<!-- This file is part of Dream, released under the MIT license. See LICENSE.md
for details, or visit https://github.com/aantron/dream.
Copyright 2021 Anton Bachin -->
<!DOCTYPE html> <!DOCTYPE html>
<html> <html>
<head> <head>

2
example/README.md
View File

@ -106,6 +106,8 @@ if something is missing!
&nbsp;&mdash;&nbsp; benchmarks sending WebSocket messages quickly. &nbsp;&mdash;&nbsp; benchmarks sending WebSocket messages quickly.
- [**`w-multipart-dump`**](w-multipart-dump#files) &nbsp;&mdash;&nbsp; echoes - [**`w-multipart-dump`**](w-multipart-dump#files) &nbsp;&mdash;&nbsp; echoes
`multipart/form-data` bodies for debugging. `multipart/form-data` bodies for debugging.
- [**`z-playground`**](z-playground#files) &nbsp;&mdash;&nbsp; source code of
the Dream playground.
<br> <br>
<br> <br>

11
example/z-playground/README.md Normal file
View File

@ -0,0 +1,11 @@
# `z-playground`
<br>
This “example” is, in fact, the Dream online playground, running at
[http://dream.as](http://dream.as). *Note: the playground is still an early
prototype, and I am starting and stopping it manually.*
It's a simple, one-page app that communicates with its server by a WebSocket.
The server starts and stops Docker containers that run visitors' code. An
`<iframe>` serves as an on-page client for testing out Web apps.

120
example/z-playground/client/playground.css Normal file
View File

@ -0,0 +1,120 @@
/* This file is part of Dream, released under the MIT license. See LICENSE.md
for details, or visit https://github.com/aantron/dream.
Copyright 2021 Anton Bachin */
@font-face {
font-family: 'Iosevka';
font-style: normal;
font-weight: 400;
src: url('iosevka-regular.woff2') format('woff2');
}
body {
margin: 0;
font-size: 15px;
line-height: 22px;
background-color: #131618;
}
#editor {
float: left;
width: 50%;
}
#client {
float: left;
width: 50%;
}
#textarea .CodeMirror, #client iframe {
height: calc(100% - 220px);
}
/* Editor */
#log {
clear: both;
margin: 0;
height: 198px;
overflow-x: hidden;
padding-left: 34px;
}
.CodeMirror, #log {
font-family: Iosevka, SFMono-Regular, Consolas, Liberation Mono, Menlo, monospace;
}
/* Client */
#client input {
display: inline-block;
width: 100%;
}
#client iframe {
border: 0;
width: 100%;
background-color: #eee;
}
/* Syntax */
.cm-s-dream.CodeMirror {
background-color: #131618;
color: #ddd;
border-top: 1px solid #262626;
border-bottom: 1px solid #262626;
box-sizing: border-box;
}
.cm-s-dream .CodeMirror-gutters {
background: none;
border-right: 1px solid #262626;
}
.cm-s-dream .cm-keyword, .t-magenta {
color: #ff6c9b;
}
.cm-s-dream .cm-operator, .t-cyan {
color: #8dc5ff;
}
.cm-s-dream .cm-string, .t-yellow {
color: #e3db7a;
}
.cm-s-dream .cm-variable {
color: #eee;
}
.cm-s-dream .cm-variable-2, .t-green {
color: #70df5c;
}
#log, .t-white {
color: #ddd;
}
.t-dim {
color: #999;
}
.t-red {
color: #ff2300;
}
.t-blue {
color: #81a2ff;
}

42
example/z-playground/client/playground.html Normal file
View File

@ -0,0 +1,42 @@
<!-- This file is part of Dream, released under the MIT license. See LICENSE.md
for details, or visit https://github.com/aantron/dream.
Copyright 2021 Anton Bachin -->
<html>
<head>
<title>Dream Playground</title>
<meta name="description" content="Online playground for Dream, the Web framework">
<script src="../node_modules/codemirror/lib/codemirror.js"></script>
<link rel="stylesheet" href="../node_modules/codemirror/lib/codemirror.css">
<link rel="stylesheet" href="../node_modules/codemirror/theme/material.css">
<script src="../node_modules/codemirror/mode/mllike/mllike.js"></script>
<link rel="stylesheet" href="playground.css">
</head>
<body>
<div id="editor">
<header>
<button id="run">Run</button>
</header>
<div id="textarea"></div>
</div>
<div id="client">
<header>
<input id="location"></input>
</header>
<iframe title="Client connecting to the playground server"></iframe>
</div>
<pre id="log"></pre>
<script src="playground.js"></script>
</body>
</html>

86
example/z-playground/client/playground.js Normal file
View File

@ -0,0 +1,86 @@
// This file is part of Dream, released under the MIT license. See LICENSE.md
// for details, or visit https://github.com/aantron/dream.
//
// Copyright 2021 Anton Bachin *)
var editor = document.querySelector("#textarea");
var run = document.querySelector("#run");
var refresh = document.querySelector("#refresh");
var address = document.querySelector("input");
var iframe = document.querySelector("iframe");
var pre = document.querySelector("pre");
var codemirror = CodeMirror(editor, {
theme: "material dream",
lineNumbers: true
});
function colorizeLog(string) {
return string
.replace(/&/g, "&amp;")
.replace(/</g, "&lt;")
.replace(/>/g, "&gt;")
.replace(/"/g, "&quot;")
.replace(/'/g, "&#039;")
.replace(/\033\[\?7l/g, "")
.replace(/\033\[2m/g, "<span class='t-dim'>")
.replace(/\033\[35m\033\[3m/g, "<span class='t-cyan'><i>")
.replace(/\033\[36m\033\[3m/g, "<span class='t-magenta'><i>")
.replace(/\033\[37m\033\[3m/g, "")
.replace(/\033\[0;35m\033\[0m/g, "</i></span>")
.replace(/\033\[0;36m\033\[0m/g, "</i></span>")
.replace(/\033\[0;37m\033\[0m/g, "")
.replace(/\033\[31m/g, "<span class='t-red'>")
.replace(/\033\[32m/g, "<span class='t-green'>")
.replace(/\033\[33m/g, "<span class='t-yellow'>")
.replace(/\033\[34m/g, "<span class='t-blue'>")
.replace(/\033\[35m/g, "<span class='t-magenta'>")
.replace(/\033\[36m/g, "<span class='t-cyan'>")
.replace(/\033\[37m/g, "<span class='t-white'>")
.replace(/\033\[0m/g, "</span>")
;
};
var socket = new WebSocket("ws://" + window.location.host + "/socket");
socket.onopen = function () {
socket.send(JSON.stringify(
{"kind": "attach", "payload": window.location.pathname}));
};
socket.onmessage = function (e) {
var message = JSON.parse(e.data);
switch (message.kind) {
case "content":
codemirror.setValue(message.payload);
socket.send(JSON.stringify(
{"kind": "run", "payload": codemirror.getValue()}));
break;
case "log":
pre.innerHTML += colorizeLog(message.payload);
pre.scrollTop = pre.scrollHeight;
break;
case "started": {
// TODO Always set the location. If there already is one, just need to
// update the port.
var location =
window.location.protocol + "//" +
window.location.hostname + ":" + message.payload;
iframe.src = location;
address.value = location;
break;
}
}
};
run.onclick = function () {
socket.send(JSON.stringify(
{"kind": "run", "payload": codemirror.getValue()}));
};
address.onkeyup = function (event) {
if (event.keyCode === 13)
iframe.src = this.value;
};

4
example/z-playground/dune Normal file
View File

@ -0,0 +1,4 @@
(executable
(name playground)
(libraries dream)
(preprocess (pps lwt_ppx)))

1
example/z-playground/dune-project Normal file
View File

@ -0,0 +1 @@
(lang dune 2.0)

11
example/z-playground/package.json Normal file
View File

@ -0,0 +1,11 @@
{
"name": "dream-playground",
"dependencies": {
"codemirror": "*",
"inliner": "*"
},
"scripts": {
"bundle": "mkdir -p static && inliner -m client/playground.html > static/playground.html",
"start": "npm run bundle && opam exec -- dune exec ./playground.exe"
}
}

275
example/z-playground/playground.ml Normal file
View File

@ -0,0 +1,275 @@
(* This file is part of Dream, released under the MIT license. See
LICENSE.md for details, or visit https://github.com/aantron/dream.
Copyright 2021 Anton Bachin *)
(* Sandbox files. *)
let (//) = Filename.concat
let sandbox_root = "sandbox"
let starter_server_eml_ml = {|let welcome =
<html><head><style>a:visited {color: blue}</style></head><body>
<h1>Welcome to the Dream Playground!</h1>
<p>Edit the code to the left, and press <strong>Run</strong> to recompile!</p>
<p>Links:</p>
<ul>
<li><a href="https://github.com/aantron/dream">GitHub</a></li>
<li><a href="https://github.com/aantron/dream/tree/master/example#readme">Tutorial</a></li>
<li><a href="https://aantron.github.io/dream">API docs</a></li>
</ul>
</body>
let () =
Dream.run ~interface:"0.0.0.0"
@@ Dream.logger
@@ Dream.router [
Dream.get "/" (fun _ -> Dream.html welcome);
]
@@ Dream.not_found
|}
let sandbox_dune_project = {|(lang dune 2.0)
|}
let sandbox_dune = {|(executable
(name server)
(libraries dream)
(preprocess (pps lwt_ppx)))
(rule
(targets server.ml)
(deps server.eml.ml)
(action (run dream_eml %{deps} --workspace %{workspace_root})))
|}
let sandbox_dockerfile = {|FROM ubuntu:focal-20210416
RUN apt update && apt install -y openssl libev4
COPY _build/default/server.exe /server.exe
ENTRYPOINT /server.exe
|}
let write_file id file content =
Lwt_io.(with_file ~mode:Output (sandbox_root // id // file) (fun channel ->
write channel content))
let check_or_create id =
let path = sandbox_root // id in
if%lwt Lwt_unix.file_exists path then
Lwt.return_unit
else
let%lwt () =
match%lwt Lwt_unix.mkdir sandbox_root 0o755 with
| () -> Lwt.return_unit
| exception Unix.(Unix_error (EEXIST, _, _)) -> Lwt.return_unit
in
let%lwt () = Lwt_unix.mkdir path 0o755 in
let%lwt () = write_file id "dune-project" sandbox_dune_project in
let%lwt () = write_file id "dune" sandbox_dune in
let%lwt () = write_file id "server.eml.ml" starter_server_eml_ml in
let%lwt () = write_file id "Dockerfile" sandbox_dockerfile in
Lwt.return_unit
(* Sandbox state transitions. *)
type container = {
port : int;
}
type sandbox = {
mutable id : string option;
mutable container : container option;
socket : Dream.websocket;
}
let sandbox_by_port =
Hashtbl.create 256
let sandbox_by_id =
Hashtbl.create 256
let min_port = 9000
let max_port = 9999
let next_port =
ref min_port
(* This can fail if there is a huge number of sandboxes, or very large spikes in
sandbox creation. However, the failure is not catastrophic. *)
let rec allocate_port () =
let port = !next_port in
incr next_port;
let%lwt () =
if !next_port > max_port then begin
next_port := min_port;
Lwt.pause ()
end
else
Lwt.return_unit
in
if Hashtbl.mem sandbox_by_port port then
allocate_port ()
else
Lwt.return port
let read sandbox =
match sandbox.id with
| None -> Lwt.return ""
| Some id ->
Lwt_io.(with_file ~mode:Input (sandbox_root // id // "server.eml.ml") read)
let validate_id id =
String.length id = 12 && Dream.from_base64url id <> None
let build id =
let command =
Printf.ksprintf Lwt_process.shell
"cd %s && opam exec --color=always -- dune build --root . ./server.exe 2>&1"
(sandbox_root // id) in
Lwt_process.pread command
let image id =
let command =
Printf.ksprintf Lwt_process.shell
"cd %s && docker build -t sandbox:%s . 2>&1" (sandbox_root // id) id in
Lwt_process.pread command
let forward ?(add_newline = false) sandbox message =
let message =
if add_newline then message ^ "\n"
else message
in
`Assoc ["kind", `String "log"; "payload", `String message]
|> Yojson.Basic.to_string
|> fun message -> Dream.send message sandbox.socket
let started sandbox port =
`Assoc ["kind", `String "started"; "payload", `Int port]
|> Yojson.Basic.to_string
|> fun message -> Dream.send message sandbox.socket
let run sandbox id =
let%lwt port = allocate_port () in
Hashtbl.replace sandbox_by_port port sandbox;
Hashtbl.replace sandbox_by_id id sandbox;
sandbox.container <- Some {port};
Lwt.async begin fun () ->
Printf.ksprintf Lwt_process.shell
"docker run -p %i:8080 --name s-%s --rm -t sandbox:%s 2>&1"
port id id
|> Lwt_process.pread_lines
|> Lwt_stream.iter_s (forward ~add_newline:true sandbox)
end;
Lwt.return port
let stop_container sandbox =
match sandbox.id, sandbox.container with
| Some id, Some container ->
Printf.ksprintf Sys.command "docker kill s-%s" id |> ignore;
Hashtbl.remove sandbox_by_port container.port;
Hashtbl.remove sandbox_by_id id;
Lwt.return_unit
| _ -> Lwt.return_unit
(* TODO Forcibly stop after one second. *)
let stop sandbox =
let%lwt () = stop_container sandbox in
Dream.close_websocket sandbox.socket
(* Main loop for each connected client WebSocket. *)
(* TODO Mind concurrency issues with client messages coming during transitions.
OTOH this code waits during those transitions anyway, so maybe it is not an
issue. *)
let rec communicate sandbox =
match%lwt Dream.receive sandbox.socket with
| None -> stop sandbox
| Some message ->
let values =
(* TODO Raises. *)
match Yojson.Basic.from_string message with
| `Assoc ["kind", `String kind; "payload", `String payload] ->
Some (kind, payload)
| _ ->
None
in
match values with
| None -> stop sandbox
| Some (kind, payload) ->
match kind, sandbox with
| "attach", _ ->
let payload = String.sub payload 1 (String.length payload - 1) in
if not (validate_id payload) then stop sandbox
else
let id = payload in
let%lwt () = check_or_create id in
sandbox.id <- Some id;
let%lwt content = read sandbox in
let%lwt () =
`Assoc ["kind", `String "content"; "payload", `String content]
|> Yojson.Basic.to_string
|> fun s -> Dream.send s sandbox.socket
in
communicate sandbox
| "run", {id = Some id; _} ->
let%lwt () = stop_container sandbox in
let%lwt () = write_file id "server.eml.ml" payload in
let%lwt output = build id in
let%lwt () = forward sandbox output in
let%lwt output = image id in
(* let%lwt () = forward sandbox output in *)
ignore output;
let%lwt port = run sandbox id in
let%lwt () = Lwt_unix.sleep 0.25 in
let%lwt () = started sandbox port in
communicate sandbox
| _ -> stop sandbox
(* The Web server proper. *)
let () =
Dream.run ~interface:"0.0.0.0" ~port:80 ~adjust_terminal:false
@@ Dream.logger
@@ Dream.router [
(* Generate a fresh valid id for new visitors, and redirect. *)
Dream.get "/" (fun _ ->
Dream.random 9
|> Dream.to_base64url
|> (^) "/"
|> Dream.redirect);
(* Apply function communicate to WebSocket connections. *)
Dream.get "/socket" (fun _ ->
Dream.websocket (fun socket -> communicate {
id = None;
container = None;
socket;
}));
(* For sandbox ids, respond with the sandbox page. *)
Dream.get "/:id" (fun request ->
if not (validate_id (Dream.param "id" request)) then
Dream.empty `Not_Found
else
let%lwt response =
Dream__middleware.Static.default_loader
"static" "playground.html" request in
let response : Dream.response = Obj.magic response in
Dream.with_header "Content-Type" "text/html; charset=utf-8" response
|> Lwt.return);
]
@@ Dream.not_found

26
example/z-playground/util/setup.sh Normal file
View File

@ -0,0 +1,26 @@
#!/bin/bash
sudo apt update
sudo apt upgrade
# sudo init 6
# https://www.digitalocean.com/community/tutorials/how-to-install-and-use-docker-on-ubuntu-20-04
sudo apt install apt-transport-https
curl -fsSL https://download.docker.com/linux/ubuntu/gpg | sudo apt-key add -
sudo add-apt-repository "deb [arch=amd64] https://download.docker.com/linux/ubuntu focal stable"
sudo apt update
sudo apt install docker-ce
sudo apt install build-essential m4 unzip bubblewrap
wget -O opam https://github.com/ocaml/opam/releases/download/2.0.8/opam-2.0.8-x86_64-linux
sudo mv opam /usr/local/bin/
sudo chmod a+x /usr/local/bin/opam
opam init --no-setup --bare
opam update
opam switch create 4.12.0
sudo apt install libev-dev libssl-dev pkg-config
opam install dream
sudo apt install npm
npm install

9
example/z-playground/util/sync.sh Normal file
View File

@ -0,0 +1,9 @@
#!/bin/bash
HOST=$1
rm -rf sandbox
rsync -rlv . $HOST:playground
rsync -v ../../docs/web/site/iosevka-regular.woff2 $HOST:playground/client/
# ssh $HOST chmod a-x 'playground/*' 'playground/.*'
# ssh $HOST opam exec -- dune build playground/playground.exe