Skip to content

Commit

Permalink
Add info page with data download
Browse files Browse the repository at this point in the history
  • Loading branch information
@patricoferris
patricoferris committed Jul 6, 2024
1 parent 229ba5a commit d78e1fc
Show file tree
Hide file tree
Showing 3 changed files with 154 additions and 50 deletions.
15 changes: 13 additions & 2 deletions src/lib/server/build.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,18 @@ let find_paths pred paths =

(* Rendering Builds *)
let render (Obuilder.Store_spec.Store ((module Store), store)) id =
let result = Lwt_eio.run_lwt (fun () -> Store.result store id) in
let result, inputs =
Lwt_eio.run_lwt (fun () ->
let open Lwt.Syntax in
let* result = Store.result store id in
let+ inputs = Store.get_meta store id ":obuilder-run-input" in
( result,
match inputs with
| Some inputs ->
Some
(Obuilder.S.run_input_of_sexp (Sexplib.Sexp.of_string inputs))
| None -> None ))
in
match result with
| None ->
Cohttp_eio.Server.respond_string ~status:`OK ~body:("No result for " ^ id)
Expand Down Expand Up @@ -79,7 +90,7 @@ let render (Obuilder.Store_spec.Store ((module Store), store)) id =
in
let page =
Pages.build ~geojsons ~jsons ~images ~tabular ~manifest ~title:"Build"
~id ~inputs:[] ()
~id ?inputs ()
in
let body =
Cohttp_eio.Body.of_string (Htmlit.El.to_string ~doctype:true page)
Expand Down
152 changes: 106 additions & 46 deletions src/lib/server/pages.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,67 @@ let template title body =
.pure-g .pure-u-3-5 div {
border-right: thin solid grey;
}
:root
{ font-size: 100%;
/* font-synthesis: none; */
-webkit-text-size-adjust: none;

--font_headings: system-ui, sans-serif;
--font_body: system-ui, sans-serif;
--font_mono: monospace;

--font_m: 1rem; --leading_m: 1.5rem;
--font_s: 0.82rem;
--font_l: 1.125rem; --leadig_l: 1.34rem;
--font_xl: 1.5rem; --leading_xl: 1.8rem;
--font_xxl: 2.5rem; --leading_xxl: 3rem;

--font_mono_ratio:
/* mono / body size, difficult to find a good cross-browser value */
0.92;
--leading_mono_m: calc(var(--leading_m) * var(--font_mono_ratio));

--sp_xxs: calc(0.25 * var(--leading_m));
--sp_xs: calc(0.5 * var(--leading_m));
--sp_s: calc(0.75 * var(--leading_m));
--sp_m: var(--leading_m);
--sp_l: calc(1.125 * var(--leading_m));
--sp_xl: calc(1.5 * var(--leading_m));
--sp_xxl: calc(2.0 * var(--leading_m));

--measure_m: 73ch;
--page_inline_pad: var(--sp_m);
--page_block_pad: var(--sp_xl);

--blockquote_border: 2px solid #ACACAC;
--rule_border: 1px solid #CACBCE;
--heading_border: 1px solid #EAECEF;
--table_cell_pad: 0.4em;
--table_hover: #f5f5f5;
--table_sep: #efefef;
--table_cell_inline_pad: 0.625em;
--table_cell_block_pad: 0.25em;

--code_span_bg: #EFF1F3;
--code_span_inline_pad: 0.35ch;
--code_block_bg: #F6F8FA;
--code_block_bleed: 0.8ch;
--code_block_block_pad: 1ch;

--a_fg: #0969DA;
--a_fg_hover: #1882ff;
--a_visited: #8E34A5;
--target_color: #FFFF96;
}

pre
{ line-height: var(--leading_mono_m);
white-space: pre-wrap;
overflow-wrap: break-word;
background-color: var(--code_block_bg);
padding-block: var(--code_block_block_pad);
padding-inline: var(--code_block_bleed);
margin-inline: calc(-1.0 * var(--code_block_bleed)) }

#map { width: 100%; height: 800px }
|};
Expand Down Expand Up @@ -173,8 +234,8 @@ module Table = struct
| _ -> El.txt "Something went wrong rendering the tabluar data"
end

let build ?(geojsons = []) ?(jsons = []) ?(images = []) ?(tabular = []) ~title
~id ~inputs ~manifest () =
let build ?inputs ?(geojsons = []) ?(jsons = []) ?(images = []) ?(tabular = [])
~title ~id ~manifest () =
let open Htmlit in
El.splice
[
Expand All @@ -188,7 +249,7 @@ let build ?(geojsons = []) ?(jsons = []) ?(images = []) ?(tabular = []) ~title
El.em [ El.txt ("Job ID: " ^ id) ];
El.p
[
pure_button "#" "Download Data";
pure_button (Fmt.str "/download/%s" id) "Download Data";
pure_button ~disabled:true "#" "Run Shell";
pure_button ~disabled:true "#" "Run Notebook";
];
Expand Down Expand Up @@ -284,56 +345,55 @@ let build ?(geojsons = []) ?(jsons = []) ?(images = []) ?(tabular = []) ~title
divc "l-box"
[
El.h3 [ El.txt "Build Summary" ];
El.p
[
El.txt
"The following command was the last to be run in this \
pipeline step.";
];
El.pre
[
El.code [ El.txt "python -m methods.matching.find_pairs" ];
];
El.h3 [ El.txt "Data Dependencies" ];
El.p
[
El.txt
{|
The following list is the immediate data dependencies of this build step.
Put another way, these build outputs were made available to this build step
in read-only mode. The actual code may or may not have used the data.
|};
];
El.ul
(List.map
(fun i ->
El.li
[ El.a ~at:[ At.href "#" ] [ El.code [ El.txt i ] ] ])
inputs);
El.h3 [ El.txt "Build Specifications" ];
El.p
[
El.txt
"The build specification is a bit like a Dockerfile. \
In this form it is very raw and specific to how the \
dataflow pipeline works, but it has been copied here \
for your convenience.";
];
El.pre
[
El.code
El.div
(match inputs with
| None -> []
| Some (i : Obuilder.S.run_input) ->
let base =
El.div
[
El.p [ El.txt "Base Image" ];
El.pre [ El.code [ El.txt i.base ] ];
]
in
let cmd =
El.div
[
El.p [ El.txt "The command run was:" ];
El.pre [ El.code [ El.txt i.cmd ] ];
]
in
let roms =
if i.rom = [] then
El.p [ El.txt "No data dependencies" ]
else
El.ul
(List.map
(fun (r : Obuilder_spec.Rom.t) ->
match r.kind with
| `Build (hash, _dir) ->
El.li
[
El.a
~at:
[
At.href
(Fmt.str "/data/%s" hash);
]
[ El.txt (String.sub hash 0 12) ];
])
i.rom)
in
[
El.txt
{|((from alpine) (run (shell "echo 'hello world'")))|};
];
];
base; cmd; El.h3 [ El.txt "Data Dependencies" ]; roms;
]);
El.h3 [ El.txt "Logs" ];
El.p
[
El.txt
{|Raw logs from the build of this particular pipeline step. The data here is very raw, but can help explain how the data was produced.|};
];
pure_button "./logs" "Raw Logs";
pure_button (Fmt.str "/logs/%s" id) "Raw Logs";
];
];
];
Expand Down
37 changes: 35 additions & 2 deletions src/lib/server/shark_server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -237,7 +237,7 @@ let custom_document_renderer _ = function
~at:
[
At.v "target" "_blank";
At.href (Fmt.str "/logs/%s" hash);
At.href (Fmt.str "/data/%s" hash);
At.style "text-decoration:none;";
]
[
Expand All @@ -248,7 +248,7 @@ let custom_document_renderer _ = function
"display:inline-flex;align-items:center;padding:0.2em \
0.4em";
]
[ log; El.nbsp; El.txt (Fmt.str "Logs") ];
[ log; El.nbsp; El.txt (Fmt.str "Info") ];
];
El.a
~at:
Expand Down Expand Up @@ -448,6 +448,38 @@ let serve_dot proc _req body =

let serve_data store id = Build.render store id

let with_file f fn =
let open Lwt.Infix in
Lwt_unix.openfile f [ Unix.O_RDWR; Unix.O_CREAT ] 0o644 >>= fun fd ->
Lwt.finalize (fun () -> fn (f, fd)) (fun () -> Lwt_unix.close fd)

let download ~fs (Obuilder.Store_spec.Store ((module Store), store)) id =
match Lwt_eio.run_lwt @@ fun () -> Store.result store id with
| None -> Cohttp_eio.Server.respond_string ~status:`Not_found ~body:"" ()
| Some src_dir -> (
Logs.info (fun f -> f "Download for %s" src_dir);
let src_dir = Filename.concat src_dir "rootfs" in
match Obuilder.Manifest.generate ~exclude:[] ~src_dir "data" with
| Error (`Msg m) ->
Cohttp_eio.Server.respond_string ~status:`Bad_request
~body:("Failed data zip: " ^ m) ()
| Ok src_manifest ->
let fname = Filename.temp_file "tmf-" ".zip" in
let tar () =
with_file fname @@ fun (_, fd) ->
Obuilder.Tar_transfer.send_files ~src_dir
~src_manifest:[ src_manifest ] ~dst_dir:"" ~to_untar:fd
~user:(`Unix Obuilder_spec.{ uid = 1000; gid = 1000 })
in
let headers =
Http.Header.add_opt_unless_exists None "content-type"
"application/zip"
in
(* Some respond_file API would be nice here *)
let () = Lwt_eio.run_lwt tar in
let body = Cohttp_eio.Body.of_string Eio.Path.(load (fs / fname)) in
Cohttp_eio.Server.respond ~status:`OK ~headers ~body ())

let edit_routes ~proc md_file (_conn : Cohttp_eio.Server.conn) request body =
let open Routes in
[
Expand All @@ -464,6 +496,7 @@ let router ~proc ~fs ~store md_file (conn : Cohttp_eio.Server.conn) request body
route nil (serve md_file);
route (s "logs" / str /? nil) (serve_logs fs store);
route (s "data" / str /? nil) (serve_data store);
route (s "download" / str /? nil) (download ~fs store);
route
(s "files" / str /? nil)
(fun hash -> serve_files fs store hash None);
Expand Down

0 comments on commit d78e1fc

Please sign in to comment.