From e4a841744bc1d2d2571dc42aaca7995f65e4758d Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Thu, 9 Feb 2017 17:03:39 +0000 Subject: [PATCH] Split datakit-github into datakit-github and datakit-bridge-github datakit-github provides abstraction API for GitHub and doesn't need a lot of depencencies. This can be used by the CI and by the local bridge without requiring to depend on ocaml-github at all. Signed-off-by: Thomas Gazagnaire --- Dockerfile.github | 13 +- Makefile | 4 + _tags | 22 +- bridge/github/_tags | 15 ++ bridge/github/datakit-github-server.mllib | 1 - bridge/github/datakit-github.mllib | 1 - bridge/github/datakit_github_state.ml | 235 +++++++++++++++++ bridge/github/datakit_github_state.mli | 45 ++++ bridge/github/datakit_github_sync.ml | 2 +- bridge/github/datakit_github_sync.mli | 2 - datakit-bridge-github.opam | 36 +++ datakit-github.opam | 12 +- doc/api.odocl | 4 +- pkg/META.bridge-local-git | 8 - pkg/META.github | 24 +- pkg/pkg.ml | 84 +++--- src/datakit-github/_tags | 1 + .../datakit-github/datakit-github.mllib | 1 - .../datakit-github}/datakit_github.ml | 247 +----------------- .../datakit-github}/datakit_github.mli | 64 ++--- .../datakit-github}/datakit_github_conv.ml | 0 .../datakit-github}/datakit_github_conv.mli | 0 src/datakit/main.ml | 6 +- src/{datakit/ir_io.ml => datakit_io.ml} | 0 src/{datakit/ir_io.mli => datakit_io.mli} | 0 tests/test.ml | 1 - tests/test_github.ml | 8 +- tests/test_utils.ml | 3 +- 28 files changed, 437 insertions(+), 402 deletions(-) create mode 100644 bridge/github/_tags delete mode 100644 bridge/github/datakit-github-server.mllib delete mode 100644 bridge/github/datakit-github.mllib create mode 100644 bridge/github/datakit_github_state.ml create mode 100644 bridge/github/datakit_github_state.mli create mode 100644 datakit-bridge-github.opam delete mode 100644 pkg/META.bridge-local-git create mode 100644 src/datakit-github/_tags rename bridge/github/datakit-github-client.mllib => src/datakit-github/datakit-github.mllib (63%) rename {bridge/github => src/datakit-github}/datakit_github.ml (79%) rename {bridge/github => src/datakit-github}/datakit_github.mli (91%) rename {bridge/github => src/datakit-github}/datakit_github_conv.ml (100%) rename {bridge/github => src/datakit-github}/datakit_github_conv.mli (100%) rename src/{datakit/ir_io.ml => datakit_io.ml} (100%) rename src/{datakit/ir_io.mli => datakit_io.mli} (100%) diff --git a/Dockerfile.github b/Dockerfile.github index 1968f28a3..7039a9144 100644 --- a/Dockerfile.github +++ b/Dockerfile.github @@ -1,10 +1,13 @@ FROM docker/datakit:server COPY datakit-github.opam /home/opam/src/datakit/datakit-github.opam +COPY datakit-bridge-github.opam /home/opam/src/datakit/datakit-bridge-github.opam + RUN opam pin add github --dev -n RUN opam pin add datakit-client.dev /home/opam/src/datakit -n RUN opam pin add datakit-github.dev /home/opam/src/datakit -n -RUN opam depext datakit-github && opam install datakit-github --deps +RUN opam pin add datakit-bridge-github.dev /home/opam/src/datakit -n +RUN opam depext datakit-bridge-github && opam install datakit-bridge-github --deps COPY . /home/opam/src/datakit/ RUN sudo chown opam.nogroup -R /home/opam/src/datakit @@ -13,16 +16,16 @@ RUN cd /home/opam/src/datakit && \ git checkout . && scripts/watermark.sh && \ git status --porcelain -RUN opam update datakit-github -RUN opam install datakit-github -vv -y +RUN opam update datakit-bridge-github +RUN opam install datakit-bridge-github -vv -y EXPOSE 5641 RUN sudo mkdir /data && sudo chown opam.nogroup /data && chmod 700 /data && \ - sudo cp $(opam config exec -- which datakit-github) /usr/bin/ + sudo cp $(opam config exec -- which datakit-bridge-github) /usr/bin/ RUN opam config exec -- ocaml /home/opam/src/datakit/check-libev.ml USER root -ENTRYPOINT ["/usr/bin/datakit-github"] +ENTRYPOINT ["/usr/bin/datakit-bridge-github"] CMD ["--listen=tcp://0.0.0.0:5641", "-v", "--datakit=tcp:127.0.0.1:5640"] diff --git a/Makefile b/Makefile index 2c6835bbf..2c1ded941 100644 --- a/Makefile +++ b/Makefile @@ -32,6 +32,10 @@ github: bridge-local-git: ocaml pkg/pkg.ml build -n datakit-bridge-local-git -q +bridge-github: + ocaml pkg/pkg.ml build -n datakit-bridge-github -q --tests true + ocaml pkg/pkg.ml test + ci: ocaml pkg/pkg.ml build -n datakit-ci -q --tests true ocaml pkg/pkg.ml test _build/ci/tests/test_ci.native diff --git a/_tags b/_tags index e568e0151..d4e461a67 100644 --- a/_tags +++ b/_tags @@ -18,51 +18,35 @@ true: package(bytes lwt astring logs result cstruct fmt rresult) : package(irmin tc datakit-server.vfs asetmap) #### irmin-io -: package(conduit.lwt-unix irmin lwt.unix uri camlzip git tc) +: package(conduit.lwt-unix irmin lwt.unix uri camlzip git tc) : package(prometheus-app.unix) : package(cmdliner fmt.cli fmt.tty logs.fmt asetmap) : package(git irmin irmin.git irmin.mem irmin-watcher) : package(irmin.http cohttp.lwt irmin-watcher), thread -: package(datakit-server.vfs datakit-server.fs9p) : package(protocol-9p.unix camlzip), thread ### datakit-conduit : thread, package(threads conduit.lwt-unix hvsock.lwt) : package(hvsock.lwt-unix named-pipe.lwt uri mirage-flow) -: package(protocol-9p.unix datakit-server.fs9p) +: package(protocol-9p.unix) ### datakit-log : package(asl win-eventlog cmdliner logs.cli mtime.os) -### datakit-bridge - -: package(uri datakit-client datakit-server.vfs asetmap prometheus) -: package(datakit-server.fs9p prometheus-app.unix) -: package(github github-hooks.unix) -: package(cmdliner fmt.cli fmt.tty logs.fmt) -: package(github.unix github-hooks.unix) - ### Tests : package(alcotest conduit.lwt-unix str logs.fmt fmt.tty mtime.os) : package(mirage-types.lwt protocol-9p.unix irmin irmin.mem camlzip) -: package(git irmin.git) -: package(datakit-client datakit-server.vfs datakit-server.fs9p) -: package(datakit-github) +: package(git irmin.git asetmap) : thread, package(conduit.lwt-unix hvsock.lwt-unix named-pipe.lwt) ### Painful #### because of src/datakit_conduit.ml -: thread, package(threads conduit.lwt-unix hvsock.lwt) -: package(hvsock.lwt-unix named-pipe.lwt uri mirage-flow) -: package(protocol-9p.unix) : thread, package(threads conduit.lwt-unix hvsock.lwt) : package(hvsock.lwt-unix named-pipe.lwt uri mirage-flow) : package(protocol-9p.unix datakit-server.fs9p) -#### because of src/datakit_log.ml -: package(asl win-eventlog cmdliner mtime.os logs.cli) : package(asl win-eventlog cmdliner mtime.os logs.cli) diff --git a/bridge/github/_tags b/bridge/github/_tags new file mode 100644 index 000000000..5473c2140 --- /dev/null +++ b/bridge/github/_tags @@ -0,0 +1,15 @@ +true: package(uri datakit-client datakit-server.vfs asetmap datakit-github) + +: package(github github-hooks.unix) + +: package(datakit-server.fs9p prometheus-app.unix) +: package(cmdliner fmt.cli fmt.tty logs.fmt) +: package(github.unix github-hooks.unix prometheus) + +### because of src/datakit_conduit.ml +: thread, package(threads conduit.lwt-unix hvsock.lwt) +: package(hvsock.lwt-unix named-pipe.lwt uri mirage-flow) +: package(protocol-9p.unix) + +#### because of src/datakit_log.ml +: package(asl win-eventlog cmdliner mtime.os logs.cli) diff --git a/bridge/github/datakit-github-server.mllib b/bridge/github/datakit-github-server.mllib deleted file mode 100644 index ffb259cf8..000000000 --- a/bridge/github/datakit-github-server.mllib +++ /dev/null @@ -1 +0,0 @@ -Datakit_github_vfs diff --git a/bridge/github/datakit-github.mllib b/bridge/github/datakit-github.mllib deleted file mode 100644 index a072d630e..000000000 --- a/bridge/github/datakit-github.mllib +++ /dev/null @@ -1 +0,0 @@ -Datakit_github_api diff --git a/bridge/github/datakit_github_state.ml b/bridge/github/datakit_github_state.ml new file mode 100644 index 000000000..4e88e188a --- /dev/null +++ b/bridge/github/datakit_github_state.ml @@ -0,0 +1,235 @@ +open Datakit_github + +let src = Logs.Src.create "bridge-github" ~doc:"Github to Git bridge" +module Log = (val Logs.src_log src : Logs.LOG) + +module Make (API: API) = struct + + open Lwt.Infix + + type token = { + t: API.token; + c: Capabilities.t; + } + + let token t c = { t; c } + let ok x = Lwt.return (Ok x) + let capabilities t = t.c + let with_capabilities c t = { t with c } + + let status_of_commits token commits = + let api_status token c = + Log.info (fun l -> l "API.status %a" Commit.pp c); + if not (Capabilities.check token.c `Read `Commit) then ok Status.Set.empty + else + API.status token.t c >|= function + | Error e -> Error (c, e) + | Ok status -> + let status = + List.filter (fun s -> + Capabilities.filter_elt token.c `Read (`Status s) + ) status + in + Ok (Status.Set.of_list status) + in + Lwt_list.map_p (api_status token) (Commit.Set.elements commits) + >|= fun status -> + List.fold_left (fun status -> function + | Ok s -> Status.Set.union status s + | Error (c, e) -> + Log.err (fun l -> l "API.status %a: %s" Commit.pp c e); + status + ) Status.Set.empty status + + let new_prs token repos = + let repos_l = Repo.Set.elements repos in + Lwt_list.map_p (fun r -> + Log.info (fun l -> l "API.prs %a" Repo.pp r); + if not (Capabilities.check token.c `Read `PR) then ok PR.Set.empty + else + API.prs token.t r >|= function + | Error e -> Error (r, e) + | Ok prs -> + List.filter (fun pr -> pr.PR.state = `Open) prs + |> PR.Set.of_list + |> fun x -> Ok x + ) repos_l + >|= fun new_prs -> + List.fold_left (fun new_prs -> function + | Ok prs -> PR.Set.union prs new_prs + | Error (r, e) -> + Log.err (fun l -> l "API.prs %a: %s" Repo.pp r e); + new_prs + ) PR.Set.empty new_prs + + let new_refs token repos = + let repos_l = Repo.Set.elements repos in + Lwt_list.map_p (fun r -> + Log.info (fun l -> l "API.refs %a" Repo.pp r); + if not (Capabilities.check token.c `Read `Ref) then ok Ref.Set.empty + else + API.refs token.t r >|= function + | Error e -> Error (r, e) + | Ok refs -> Ok (Ref.Set.of_list refs) + ) repos_l + >|= fun new_refs -> + List.fold_left (fun new_refs -> function + | Ok refs -> Ref.Set.union refs new_refs + | Error (r, e) -> + Log.err (fun l -> l "API.refs %a: %s" Repo.pp r e); + new_refs + ) Ref.Set.empty new_refs + + let read_prs token ids = + Lwt_list.map_p (fun pr -> + Log.info (fun l -> l "API.pr %a" PR.pp_id pr); + if not (Capabilities.check token.c `Read `PR) then ok None + else + API.pr token.t pr >|= function + | Error e -> Error (pr, e) + | Ok None -> Ok None + | Ok (Some pr) -> + if pr.PR.state = `Open then Ok (Some pr) else Ok None + ) (PR.IdSet.elements ids) + >|= fun new_prs -> + List.fold_left (fun new_prs -> function + | Ok (Some pr) -> PR.Set.add pr new_prs + | Ok None -> PR.Set.empty + | Error (pr, e) -> + Log.err (fun l -> l "API.pr %a: %s" PR.pp_id pr e); + new_prs + ) PR.Set.empty new_prs + + let read_refs token ids = + Lwt_list.map_p (fun r -> + Log.info (fun l -> l "API.ref %a" Ref.pp_id r); + if not (Capabilities.check token.c `Read `PR) then ok None + else + API.ref token.t r >|= function + | Error e -> Error (r, e) + | Ok r -> Ok r + ) (Ref.IdSet.elements ids) + >|= fun new_refs -> + List.fold_left (fun new_refs -> function + | Ok (Some r) -> Ref.Set.add r new_refs + | Ok None -> Ref.Set.empty + | Error (r, e) -> + Log.err (fun l -> l "API.ref %a: %s" Ref.pp_id r e); + new_refs + ) Ref.Set.empty new_refs + + (* Import http://github.com/usr/repo state. *) + let import token t ids = + let repos = Elt.IdSet.repos ids in + new_prs token repos >>= fun new_prs -> + new_refs token repos >>= fun new_refs -> + let prs = Elt.IdSet.prs ids in + let refs = Elt.IdSet.refs ids in + read_prs token prs >>= fun prs -> + let new_prs = PR.Set.union prs new_prs in + read_refs token refs >>= fun refs -> + let new_refs = Ref.Set.union refs new_refs in + let new_commits = + let (++) = Commit.Set.union in + PR.Set.commits new_prs ++ Ref.Set.commits new_refs + in + status_of_commits token new_commits >|= fun new_status -> + let new_t = + Snapshot.v ~repos ~prs:new_prs ~refs:new_refs ~commits:new_commits + ~status:new_status + in + Log.debug (fun l -> l "State.import %a@;@[<2>new:%a@]" + Repo.Set.pp repos Snapshot.pp new_t); + let base = Snapshot.without_repos repos t in + let repos = Repo.Set.union (Snapshot.repos t) repos in + let prs = PR.Set.union (Snapshot.prs base) new_prs in + let refs = Ref.Set.union (Snapshot.refs base) new_refs in + let commits = Commit.Set.union (Snapshot.commits base) new_commits in + let status = Status.Set.union (Snapshot.status base) new_status in + Snapshot.v ~repos ~prs ~commits ~refs ~status + + let api_set_pr token pr = + Log.info (fun l -> l "API.set-pr %a" PR.pp pr); + if not (Capabilities.check token.c `Write `PR) then Lwt.return_unit + else + API.set_pr token.t pr >|= function + | Ok () -> () + | Error e -> Log.err (fun l -> l "API.set-pr %a: %s" PR.pp pr e) + + let api_remove_ref token (repo, name as r) = + Log.info (fun l -> l "API.remove-ref %a" Ref.pp_id r); + if not (Capabilities.check token.c `Write `Ref) then Lwt.return_unit + else + API.remove_ref token.t repo name >|= function + | Ok () -> () + | Error e -> Log.err (fun l -> l "API.remove-ref %a: %s" Ref.pp_id r e) + + let api_set_ref token r = + Log.info (fun l -> l "API.set-ref %a" Ref.pp r); + if not (Capabilities.check token.c `Write `Ref) then Lwt.return_unit + else + API.set_ref token.t r >|= function + | Ok () -> () + | Error e -> Log.err (fun l -> l "API.set-ref %a: %s" Ref.pp r e) + + let api_set_status token s = + Log.info (fun l -> l "API.set-status %a" Status.pp s); + if not (Capabilities.check token.c `Write (`Status (Status.context s))) + then Lwt.return_unit + else + API.set_status token.t s >|= function + | Ok () -> () + | Error e -> Log.err (fun l -> l "API.set-status %a: %s" Status.pp s e) + + (* Read DataKit data and call the GitHub API to sync the world with + what DataKit think it should be. *) + let apply token diff = + Log.debug (fun l -> l "State.apply@;@[%a@]" Diff.pp diff); + let prs = Diff.update diff |> Elt.Set.prs in + Lwt_list.iter_p (api_set_pr token) (PR.Set.elements prs) + >>= fun () -> + let closed_refs = Elt.IdSet.refs (Diff.remove diff) in + Lwt_list.iter_p (api_remove_ref token) (Ref.IdSet.elements closed_refs) + >>= fun () -> + let refs = Elt.Set.refs (Diff.update diff) in + Lwt_list.iter_p (api_set_ref token) (Ref.Set.elements refs) + >>= fun () -> + (* NOTE: ideally we would also remove status, but the GitHub API doesn't + support removing status so we just ignore *) + let status = Elt.Set.status (Diff.update diff) in + Lwt_list.iter_p (api_set_status token) (Status.Set.elements status) + + let add_webhooks token ~watch repos = + Log.debug (fun l -> l "[add_webhooks] repos: %a" Repo.Set.pp repos); + Lwt_list.iter_p (fun r -> + Log.info (fun l -> l "API.add-webhook %a" Repo.pp r); + if not (Capabilities.check token.c `Write `Webhook) then Lwt.return_unit + else watch r + ) (Repo.Set.elements repos) + + let import_webhook_events token ~events t = + match events () with + | [] -> Lwt.return t + | events -> + Log.debug (fun l -> + l "[sync_webhook] events:@;%a" (Fmt.Dump.list Event.pp) events); + (* Need to resynchronsize build status for new commits *) + let commits = List.fold_left (fun acc -> function + | Event.PR pr -> + if PR.state pr <> `Open then acc + else Commit.Set.add (PR.commit pr) acc + | Event.Ref (`Removed _) -> acc + | Event.Ref (`Created r + |`Updated r) -> Commit.Set.add (Ref.commit r) acc + | Event.Repo _ | Event.Status _ | Event.Other _ -> acc + ) Commit.Set.empty events + in + let new_commits = Commit.Set.diff commits (Snapshot.commits t) in + status_of_commits token new_commits >|= fun new_status -> + let events = + (List.map Event.of_status @@ Status.Set.elements new_status) + @ events + in + Snapshot.with_events events t + +end diff --git a/bridge/github/datakit_github_state.mli b/bridge/github/datakit_github_state.mli new file mode 100644 index 000000000..7c85ec375 --- /dev/null +++ b/bridge/github/datakit_github_state.mli @@ -0,0 +1,45 @@ +open Datakit_github + +(** API State: TODO find a better name? *) +module Make (API: API): sig + + (** {1 Token} *) + + type token + (** The type for state token. *) + + val token: API.token -> Capabilities.t -> token + (** [token t c] is the token using the GitHub API token [t] limited + by the capabilities [c]. *) + + val capabilities: token -> Capabilities.t + (** [capabilities t] is the token [t]'s capabilities. *) + + val with_capabilities: Capabilities.t -> token -> token + (** [with_capabilities c t] is [t] with the capabilities [c]. *) + + (** {1 Synchronisation} *) + + val import: token -> Snapshot.t -> Elt.IdSet.t -> Snapshot.t Lwt.t + (** [import token t r] imports the state of GitHub for the elements + in [r] into [t]. API calls use the token [token]. *) + + val apply: token -> Diff.t -> unit Lwt.t + (** [apply token d] applies the snapshot diff [d] as a series of + GitHub API calls, using the token [token]. *) + + (** {1 Webhooks} *) + + val add_webhooks: + token -> watch:(Repo.t -> unit Lwt.t) -> Repo.Set.t -> unit Lwt.t + (** [add_webhooks t rs] adds webhooks for the repositories [rs]. *) + + val import_webhook_events: + token -> events:(unit -> Event.t list) -> Snapshot.t -> Snapshot.t Lwt.t + (** [import_webhook_events t ~events s] applies [events ()] on top + of [s]. Note: it ensure that all the metadata are correctly + updated by inserting (possibly) missing events in the mix. For + instance, GitHub never sends {{!Event.Status}status} events, so + [import_events] has to reconstruct them. *) + +end diff --git a/bridge/github/datakit_github_sync.ml b/bridge/github/datakit_github_sync.ml index 11155f980..a301f4365 100644 --- a/bridge/github/datakit_github_sync.ml +++ b/bridge/github/datakit_github_sync.ml @@ -15,7 +15,7 @@ let ok x = Lwt.return (Ok x) module Make (API: API) (DK: Datakit_S.CLIENT) = struct - module State = Datakit_github.State(API) + module State = Datakit_github_state.Make(API) module Conv = Datakit_github_conv.Make(DK) (* [bridge] [datakit] diff --git a/bridge/github/datakit_github_sync.mli b/bridge/github/datakit_github_sync.mli index 0d9899725..3576ee208 100644 --- a/bridge/github/datakit_github_sync.mli +++ b/bridge/github/datakit_github_sync.mli @@ -1,5 +1,3 @@ -(** Virtual filesystem for the GitHub API. *) - open Datakit_github module Make (API: API) (DK: Datakit_S.CLIENT): sig diff --git a/datakit-bridge-github.opam b/datakit-bridge-github.opam new file mode 100644 index 000000000..39dc0253c --- /dev/null +++ b/datakit-bridge-github.opam @@ -0,0 +1,36 @@ +opam-version: "1.2" +maintainer: "thomas@gazagnaire.org" +authors: ["Thomas Leonard" "Magnus Skjegstad" + "David Scott" "Thomas Gazagnaire"] +license: "Apache" +homepage: "https://github.com/docker/datakit" +bug-reports: "https://github.com/docker/datakit/issues" +dev-repo: "https://github.com/docker/datakit.git" +doc: "https://docker.github.io/datakit/" + +build: [ + "ocaml" "pkg/pkg.ml" "build" "--pinned" "%{pinned}%" "-n" name "--tests" "false" +] + +build-test: [ + ["ocaml" "pkg/pkg.ml" "build" "--pinned" "%{pinned}%" "-n" name "--tests" "true"] + ["ocaml" "pkg/pkg.ml" "test"] +] + +depends: [ + "ocamlfind" {build} + "ocamlbuild" {build} + "topkg" {build} + "cmdliner" + "lwt" {>= "2.7.0"} + "datakit-github" + "logs" "fmt" "mtime" "asl" "win-eventlog" "hvsock" + "hex" "nocrypto" "conduit" + "prometheus-app" + "protocol-9p" {>= "0.8.0"} + "datakit-server" {>= "0.9.0"} + "datakit-client" {>= "0.9.0"} + "github-hooks" {>= "0.1.1"} + "github" {>= "2.1.0"} + "datakit" {test} +] diff --git a/datakit-github.opam b/datakit-github.opam index 26ec5e961..f8628ce16 100644 --- a/datakit-github.opam +++ b/datakit-github.opam @@ -9,7 +9,7 @@ dev-repo: "https://github.com/docker/datakit.git" doc: "https://docker.github.io/datakit/" build: [ - "ocaml" "pkg/pkg.ml" "build" "--pinned" "%{pinned}%" "-n" "datakit-github" + "ocaml" "pkg/pkg.ml" "build" "--pinned" "%{pinned}%" "-n" name ] depends: [ @@ -19,12 +19,8 @@ depends: [ "cmdliner" "lwt" {>= "2.7.0"} "asetmap" - "logs" "fmt" "mtime" "asl" "win-eventlog" "hvsock" - "hex" "nocrypto" "conduit" - "prometheus-app" - "protocol-9p" {>= "0.8.0"} - "datakit-server" {>= "0.7.0"} + "logs" + "fmt" + "result" "datakit-client" {>= "0.7.0"} - "github-hooks" {>= "0.1.1"} - "github" {>= "2.1.0"} ] diff --git a/doc/api.odocl b/doc/api.odocl index 1326e1f06..259859b37 100644 --- a/doc/api.odocl +++ b/doc/api.odocl @@ -10,8 +10,6 @@ src/datakit/Ivfs_tree src/datakit/Ivfs_remote src/datakit/Ivfs_blob -bridge/github/Datakit_github -bridge/github/Datakit_github_api -bridge/github/Datakit_github_vfs +src/datakit-github/Datakit_github ci/src/Datakit_ci \ No newline at end of file diff --git a/pkg/META.bridge-local-git b/pkg/META.bridge-local-git deleted file mode 100644 index b5bb2bc6d..000000000 --- a/pkg/META.bridge-local-git +++ /dev/null @@ -1,8 +0,0 @@ -description = "Local alternative to datakit-github (for testing)" -version = "%%VERSION%%" -requires = "lwt.unix datakit-github.client" -archive(byte) = "datakit-bridge-local-git.cma" -archive(native) = "datakit-bridge-local-git.cmxa" -plugin(byte) = "datakit-bridge-local-git.cma" -plugin(native) = "datakit-bridge-local-git.cmxs" -exists_if = "datakit-bridge-local-git.cma" diff --git a/pkg/META.github b/pkg/META.github index 0747027e0..df959c4c9 100644 --- a/pkg/META.github +++ b/pkg/META.github @@ -1,30 +1,8 @@ description = "Use Datakit to interact with the GitHub API" version = "%%VERSION%%" -requires = "github.unix github-hooks.unix lwt.unix datakit-github.client datakit-github.server prometheus-app" +requires = "astring cstruct datakit-client fmt logs uri asetmap" archive(byte) = "datakit-github.cma" archive(native) = "datakit-github.cmxa" plugin(byte) = "datakit-github.cma" plugin(native) = "datakit-github.cmxs" exists_if = "datakit-github.cma" - -package "client" ( - description = "Client abstraction for the GitHub API, using datakit" - version = "%%VERSION%%" - requires = "astring cstruct datakit-client fmt logs result rresult uri asetmap" - archive(byte) = "datakit-github-client.cma" - archive(native) = "datakit-github-client.cmxa" - plugin(byte) = "datakit-github-client.cma" - plugin(native) = "datakit-github-client.cmxs" - exists_if = "datakit-github-client.cma" -) - -package "server" ( - description = "Server abstraction for the GitHub API, using datakit" - version = "%%VERSION%%" - requires = "datakit-server.vfs datakit-github.client" - archive(byte) = "datakit-github-server.cma" - archive(native) = "datakit-github-server.cmxa" - plugin(byte) = "datakit-github-server.cma" - plugin(native) = "datakit-github-server.cmxs" - exists_if = "datakit-github-server.cma" -) diff --git a/pkg/pkg.ml b/pkg/pkg.ml index fd8120527..5fdcbb84c 100755 --- a/pkg/pkg.ml +++ b/pkg/pkg.ml @@ -6,47 +6,61 @@ open Topkg let includes = function | "datakit-ci" -> ["ci"] | "datakit" -> ["src"; "src/datakit"] + | "datakit-client" -> ["src"; "src/datakit-client"] | "datakit-server" -> ["src"; "src/datakit-server"] - | "datakit-github" -> ["src"; "src/datakit"] + | "datakit-github" -> ["src/datakit"] | "datakit-bridge-local-git" -> ["bridge/local"] - | "datakit-client" -> ["src"; "src/datakit-client"] + | "datakit-bridge-github" -> ["src"; "bridge/github"] + | x -> failwith ("Unknown includes for package: " ^ x) + + +let extra_deps c = + let tests = Conf.build_tests c in + match Conf.pkg_name c with + | "datakit-ci" -> [] + | "datakit" -> + ["datakit-server.vfs"; "datakit-server.fs9p"] + @ if tests then ["datakit-client"] else [] + | "datakit-client" -> [] + | "datakit-server" -> [] + | "datakit-github" -> ["datakit-client"] + | "datakit-bridge-local-git" -> ["datakit-github"; "datakit-client"] + | "datakit-bridge-github" -> + ["datakit-client"; "datakit-server.vfs"; "datakit-server.fs9p"; + "datakit-github"] @ if tests then ["datakit.ivfs"] else [] | x -> failwith ("Unknown includes for package: " ^ x) let build = - let build_with_visible_warnings c os = - let ocamlbuild = Conf.tool "ocamlbuild" os in - let build_dir = Conf.build_dir c in - let debug = Cmd.(on (Conf.debug c) (v "-tag" % "debug")) in - let profile = Cmd.(on (Conf.profile c) (v "-tag" % "profile")) in - let includes = - match includes (Conf.pkg_name c) with + let cmd c os = + let includes = match includes (Conf.pkg_name c) with | [] -> Cmd.empty | is -> Cmd.(v "-Is" % String.concat "," is) in - Cmd.(ocamlbuild % "-use-ocamlfind" %% debug %% profile %% includes % "-build-dir" % build_dir) - in - let cmd c os files = - OS.Cmd.run @@ Cmd.(build_with_visible_warnings c os %% of_list files) + let extra_deps = match extra_deps c with + | [] -> Cmd.empty + | ed -> Cmd.(v "-package" % String.concat "," ed) + in + Cmd.(Pkg.build_cmd c os %% includes %% extra_deps) in + let cmd c os files = OS.Cmd.run @@ Cmd.(cmd c os %% of_list files) in Pkg.build ~cmd () -let metas = [ - Pkg.meta_file ~install:false "pkg/META"; - Pkg.meta_file ~install:false "pkg/META.client"; - Pkg.meta_file ~install:false "pkg/META.server"; - Pkg.meta_file ~install:false "pkg/META.github"; - Pkg.meta_file ~install:false "pkg/META.ci"; -] +let metas = List.map (Pkg.meta_file ~install:false) [ + "pkg/META"; + "pkg/META.client"; + "pkg/META.server"; + "pkg/META.github"; + "pkg/META.ci"; + ] -let opams = - let lint_deps_excluding = None in - let install = false in - [ - Pkg.opam_file "opam" ~lint_deps_excluding ~install; - Pkg.opam_file "datakit-client.opam" ~lint_deps_excluding ~install; - Pkg.opam_file "datakit-server.opam" ~lint_deps_excluding ~install; - Pkg.opam_file "datakit-github.opam" ~lint_deps_excluding ~install; - Pkg.opam_file "datakit-ci.opam" ~lint_deps_excluding ~install; +let opams = List.map (Pkg.opam_file ~lint_deps_excluding:None ~install:false) [ + "opam"; + "datakit-client.opam"; + "datakit-server.opam"; + "datakit-github.opam"; + "datakit-ci.opam"; + "datakit-bridge-github.opam"; + "datakit-bridge-local-git.opam" ] let () = @@ -78,17 +92,15 @@ let () = | "datakit-github" -> Ok [ Pkg.lib "pkg/META.github" ~dst:"META"; Pkg.lib "datakit-github.opam" ~dst:"opam"; - Pkg.mllib "bridge/github/datakit-github.mllib"; - Pkg.mllib "bridge/github/datakit-github-client.mllib"; - Pkg.mllib "bridge/github/datakit-github-server.mllib"; - Pkg.bin "bridge/github/main" ~dst:"datakit-github" ; + Pkg.mllib "src/datakit-github/datakit-github.mllib"; ] | "datakit-bridge-local-git" -> Ok [ - Pkg.lib "pkg/META.bridge-local-git" ~dst:"META"; - Pkg.lib "datakit-bridge-local-git.opam" ~dst:"opam"; - Pkg.mllib "bridge/local/datakit-bridge-local-git.mllib"; Pkg.bin "bridge/local/main" ~dst:"datakit-bridge-local-git" ; ] + | "datakit-bridge-github" -> Ok [ + Pkg.bin "bridge/github/main" ~dst:"datakit-bridge-github"; + Pkg.test "tests/test_github" ~args:(Cmd.v "-q"); + ] | "datakit-ci" -> Ok [ Pkg.lib "pkg/META.ci" ~dst:"META"; Pkg.lib "datakit-ci.opam" ~dst:"opam"; diff --git a/src/datakit-github/_tags b/src/datakit-github/_tags new file mode 100644 index 000000000..4f3aa13cc --- /dev/null +++ b/src/datakit-github/_tags @@ -0,0 +1 @@ +true: package(asetmap uri datakit-client result) \ No newline at end of file diff --git a/bridge/github/datakit-github-client.mllib b/src/datakit-github/datakit-github.mllib similarity index 63% rename from bridge/github/datakit-github-client.mllib rename to src/datakit-github/datakit-github.mllib index b48beb255..2d58b43ed 100644 --- a/bridge/github/datakit-github-client.mllib +++ b/src/datakit-github/datakit-github.mllib @@ -1,3 +1,2 @@ Datakit_github Datakit_github_conv -Datakit_github_sync diff --git a/bridge/github/datakit_github.ml b/src/datakit-github/datakit_github.ml similarity index 79% rename from bridge/github/datakit_github.ml rename to src/datakit-github/datakit_github.ml index 09c440778..52a7e8001 100644 --- a/bridge/github/datakit_github.ml +++ b/src/datakit-github/datakit_github.ml @@ -1,7 +1,6 @@ open Astring -open Result -let src = Logs.Src.create "dkt-github" ~doc:"Github to Git bridge" +let src = Logs.Src.create "dkt-github" ~doc:"Github API abstraction for DataKit" module Log = (val Logs.src_log src : Logs.LOG) module type ELT = sig @@ -559,17 +558,17 @@ module Elt = struct let compare = compare_id end) - let filter_repos s = + let repos s = fold (fun e acc -> match e with `Repo r -> Repo.Set.add r acc | _ -> acc) s Repo.Set.empty - let filter_prs s = + let prs s = fold (fun e acc -> match e with `PR pr -> PR.IdSet.add pr acc | _ -> acc) s PR.IdSet.empty - let filter_refs s = + let refs s = fold (fun e acc -> match e with `Ref r -> Ref.IdSet.add r acc | _ -> acc) s Ref.IdSet.empty @@ -578,13 +577,6 @@ module Elt = struct let of_prs s = PR.Set.fold (fun p -> add (`PR (PR.id p))) s empty let of_refs s = Ref.Set.fold (fun r -> add (`Ref (Ref.id r))) s empty - let refs t = - elements t - |> List.fold_left (fun acc -> function - | `Ref pr -> Ref.IdSet.add pr acc - | _ -> acc - ) Ref.IdSet.empty - end module Set = struct @@ -1210,234 +1202,3 @@ module type API = sig val clear: t -> unit end end - -module State (API: API) = struct - - open Lwt.Infix - - type token = { - t: API.token; - c: Capabilities.t; - } - - let token t c = { t; c } - let ok x = Lwt.return (Ok x) - let capabilities t = t.c - let with_capabilities c t = { t with c } - - let status_of_commits token commits = - let api_status token c = - Log.info (fun l -> l "API.status %a" Commit.pp c); - if not (Capabilities.check token.c `Read `Commit) then ok Status.Set.empty - else - API.status token.t c >|= function - | Error e -> Error (c, e) - | Ok status -> - let status = - List.filter (fun s -> - Capabilities.filter_elt token.c `Read (`Status s) - ) status - in - Ok (Status.Set.of_list status) - in - Lwt_list.map_p (api_status token) (Commit.Set.elements commits) - >|= fun status -> - List.fold_left (fun status -> function - | Ok s -> Status.Set.union status s - | Error (c, e) -> - Log.err (fun l -> l "API.status %a: %s" Commit.pp c e); - status - ) Status.Set.empty status - - let new_prs token repos = - let repos_l = Repo.Set.elements repos in - Lwt_list.map_p (fun r -> - Log.info (fun l -> l "API.prs %a" Repo.pp r); - if not (Capabilities.check token.c `Read `PR) then ok PR.Set.empty - else - API.prs token.t r >|= function - | Error e -> Error (r, e) - | Ok prs -> - List.filter (fun pr -> pr.PR.state = `Open) prs - |> PR.Set.of_list - |> fun x -> Ok x - ) repos_l - >|= fun new_prs -> - List.fold_left (fun new_prs -> function - | Ok prs -> PR.Set.union prs new_prs - | Error (r, e) -> - Log.err (fun l -> l "API.prs %a: %s" Repo.pp r e); - new_prs - ) PR.Set.empty new_prs - - let new_refs token repos = - let repos_l = Repo.Set.elements repos in - Lwt_list.map_p (fun r -> - Log.info (fun l -> l "API.refs %a" Repo.pp r); - if not (Capabilities.check token.c `Read `Ref) then ok Ref.Set.empty - else - API.refs token.t r >|= function - | Error e -> Error (r, e) - | Ok refs -> Ok (Ref.Set.of_list refs) - ) repos_l - >|= fun new_refs -> - List.fold_left (fun new_refs -> function - | Ok refs -> Ref.Set.union refs new_refs - | Error (r, e) -> - Log.err (fun l -> l "API.refs %a: %s" Repo.pp r e); - new_refs - ) Ref.Set.empty new_refs - - let read_prs token ids = - Lwt_list.map_p (fun pr -> - Log.info (fun l -> l "API.pr %a" PR.pp_id pr); - if not (Capabilities.check token.c `Read `PR) then ok None - else - API.pr token.t pr >|= function - | Error e -> Error (pr, e) - | Ok None -> Ok None - | Ok (Some pr) -> - if pr.PR.state = `Open then Ok (Some pr) else Ok None - ) (PR.IdSet.elements ids) - >|= fun new_prs -> - List.fold_left (fun new_prs -> function - | Ok (Some pr) -> PR.Set.add pr new_prs - | Ok None -> PR.Set.empty - | Error (pr, e) -> - Log.err (fun l -> l "API.pr %a: %s" PR.pp_id pr e); - new_prs - ) PR.Set.empty new_prs - - let read_refs token ids = - Lwt_list.map_p (fun r -> - Log.info (fun l -> l "API.ref %a" Ref.pp_id r); - if not (Capabilities.check token.c `Read `PR) then ok None - else - API.ref token.t r >|= function - | Error e -> Error (r, e) - | Ok r -> Ok r - ) (Ref.IdSet.elements ids) - >|= fun new_refs -> - List.fold_left (fun new_refs -> function - | Ok (Some r) -> Ref.Set.add r new_refs - | Ok None -> Ref.Set.empty - | Error (r, e) -> - Log.err (fun l -> l "API.ref %a: %s" Ref.pp_id r e); - new_refs - ) Ref.Set.empty new_refs - - (* Import http://github.com/usr/repo state. *) - let import token t ids = - let repos = Elt.IdSet.filter_repos ids in - new_prs token repos >>= fun new_prs -> - new_refs token repos >>= fun new_refs -> - let prs = Elt.IdSet.filter_prs ids in - let refs = Elt.IdSet.filter_refs ids in - read_prs token prs >>= fun prs -> - let new_prs = PR.Set.union prs new_prs in - read_refs token refs >>= fun refs -> - let new_refs = Ref.Set.union refs new_refs in - let new_commits = - let (++) = Commit.Set.union in - PR.Set.commits new_prs ++ Ref.Set.commits new_refs - in - status_of_commits token new_commits >|= fun new_status -> - let new_t = - Snapshot.v ~repos ~prs:new_prs ~refs:new_refs ~commits:new_commits - ~status:new_status - in - Log.debug (fun l -> l "State.import %a@;@[<2>new:%a@]" - Repo.Set.pp repos Snapshot.pp new_t); - let base = Snapshot.without_repos repos t in - let repos = Repo.Set.union (Snapshot.repos t) repos in - let prs = PR.Set.union (Snapshot.prs base) new_prs in - let refs = Ref.Set.union (Snapshot.refs base) new_refs in - let commits = Commit.Set.union (Snapshot.commits base) new_commits in - let status = Status.Set.union (Snapshot.status base) new_status in - Snapshot.v ~repos ~prs ~commits ~refs ~status - - let api_set_pr token pr = - Log.info (fun l -> l "API.set-pr %a" PR.pp pr); - if not (Capabilities.check token.c `Write `PR) then Lwt.return_unit - else - API.set_pr token.t pr >|= function - | Ok () -> () - | Error e -> Log.err (fun l -> l "API.set-pr %a: %s" PR.pp pr e) - - let api_remove_ref token (repo, name as r) = - Log.info (fun l -> l "API.remove-ref %a" Ref.pp_id r); - if not (Capabilities.check token.c `Write `Ref) then Lwt.return_unit - else - API.remove_ref token.t repo name >|= function - | Ok () -> () - | Error e -> Log.err (fun l -> l "API.remove-ref %a: %s" Ref.pp_id r e) - - let api_set_ref token r = - Log.info (fun l -> l "API.set-ref %a" Ref.pp r); - if not (Capabilities.check token.c `Write `Ref) then Lwt.return_unit - else - API.set_ref token.t r >|= function - | Ok () -> () - | Error e -> Log.err (fun l -> l "API.set-ref %a: %s" Ref.pp r e) - - let api_set_status token s = - Log.info (fun l -> l "API.set-status %a" Status.pp s); - if not (Capabilities.check token.c `Write (`Status (Status.context s))) - then Lwt.return_unit - else - API.set_status token.t s >|= function - | Ok () -> () - | Error e -> Log.err (fun l -> l "API.set-status %a: %s" Status.pp s e) - - (* Read DataKit data and call the GitHub API to sync the world with - what DataKit think it should be. *) - let apply token diff = - Log.debug (fun l -> l "State.apply@;@[%a@]" Diff.pp diff); - let prs = Diff.update diff |> Elt.Set.prs in - Lwt_list.iter_p (api_set_pr token) (PR.Set.elements prs) - >>= fun () -> - let closed_refs = Elt.IdSet.refs (Diff.remove diff) in - Lwt_list.iter_p (api_remove_ref token) (Ref.IdSet.elements closed_refs) - >>= fun () -> - let refs = Elt.Set.refs (Diff.update diff) in - Lwt_list.iter_p (api_set_ref token) (Ref.Set.elements refs) - >>= fun () -> - (* NOTE: ideally we would also remove status, but the GitHub API doesn't - support removing status so we just ignore *) - let status = Elt.Set.status (Diff.update diff) in - Lwt_list.iter_p (api_set_status token) (Status.Set.elements status) - - let add_webhooks token ~watch repos = - Log.debug (fun l -> l "[add_webhooks] repos: %a" Repo.Set.pp repos); - Lwt_list.iter_p (fun r -> - Log.info (fun l -> l "API.add-webhook %a" Repo.pp r); - if not (Capabilities.check token.c `Write `Webhook) then Lwt.return_unit - else watch r - ) (Repo.Set.elements repos) - - let import_webhook_events token ~events t = - match events () with - | [] -> Lwt.return t - | events -> - Log.debug (fun l -> - l "[sync_webhook] events:@;%a" (Fmt.Dump.list Event.pp) events); - (* Need to resynchronsize build status for new commits *) - let commits = List.fold_left (fun acc -> function - | Event.PR pr -> - if PR.state pr <> `Open then acc - else Commit.Set.add (PR.commit pr) acc - | Event.Ref (`Removed _) -> acc - | Event.Ref (`Created r - |`Updated r) -> Commit.Set.add (Ref.commit r) acc - | Event.Repo _ | Event.Status _ | Event.Other _ -> acc - ) Commit.Set.empty events - in - let new_commits = Commit.Set.diff commits (Snapshot.commits t) in - status_of_commits token new_commits >|= fun new_status -> - let events = - (List.map Event.of_status @@ Status.Set.elements new_status) - @ events - in - Snapshot.with_events events t - -end diff --git a/bridge/github/datakit_github.mli b/src/datakit-github/datakit_github.mli similarity index 91% rename from bridge/github/datakit_github.mli rename to src/datakit-github/datakit_github.mli index c4dfe9121..4b4bcd20f 100644 --- a/bridge/github/datakit_github.mli +++ b/src/datakit-github/datakit_github.mli @@ -183,6 +183,8 @@ module PR: sig end (** Sets of pull requests. *) + module IdSet: SET with type elt = id + module Index: MAP with type key = id (** Maps indexed by pull-request IDs. *) @@ -330,6 +332,8 @@ module Ref: sig end (** Sets of Git references. *) + module IdSet: SET with type elt = id + type event = [`Created of t | `Updated of t | `Removed of id] (** The type for reference events' state. *) @@ -392,9 +396,18 @@ module Elt: sig val pp_id: id Fmt.t val compare_id: id -> id -> int - module Set: SET with type elt = t + module Set: sig + include SET with type elt = t + val prs: t -> PR.Set.t + val refs: t -> Ref.Set.t + val status: t -> Status.Set.t + end + module IdSet: sig include SET with type elt = id + val repos: t -> Repo.Set.t + val prs: t -> PR.IdSet.t + val refs: t -> Ref.IdSet.t val of_repos: Repo.Set.t -> t val of_prs: PR.Set.t -> t val of_refs: Ref.Set.t -> t @@ -470,6 +483,9 @@ module Snapshot: sig (** [with_elts] is like {!with_elt} but for a collection of elements. *) + val without_repos: Repo.Set.t -> t -> t + val with_events: Event.t list -> t -> t + val find: Elt.id -> t -> Elt.t option (** [find id t] finds the element with ID [id] in [t]. *) @@ -592,6 +608,8 @@ module Capabilities: sig subset of operations [op] over the capabilities defined by [t]. *) + val filter_elt: t -> op -> Elt.t -> bool + end (** Signature for the GitHub API. *) @@ -682,47 +700,3 @@ module type API = sig end end - -(** API State: TODO find a better name? *) -module State (API: API): sig - - (** {1 Token} *) - - type token - (** The type for state token. *) - - val token: API.token -> Capabilities.t -> token - (** [token t c] is the token using the GitHub API token [t] limited - by the capabilities [c]. *) - - val capabilities: token -> Capabilities.t - (** [capabilities t] is the token [t]'s capabilities. *) - - val with_capabilities: Capabilities.t -> token -> token - (** [with_capabilities c t] is [t] with the capabilities [c]. *) - - (** {1 Synchronisation} *) - - val import: token -> Snapshot.t -> Elt.IdSet.t -> Snapshot.t Lwt.t - (** [import token t r] imports the state of GitHub for the elements - in [r] into [t]. API calls use the token [token]. *) - - val apply: token -> Diff.t -> unit Lwt.t - (** [apply token d] applies the snapshot diff [d] as a series of - GitHub API calls, using the token [token]. *) - - (** {1 Webhooks} *) - - val add_webhooks: - token -> watch:(Repo.t -> unit Lwt.t) -> Repo.Set.t -> unit Lwt.t - (** [add_webhooks t rs] adds webhooks for the repositories [rs]. *) - - val import_webhook_events: - token -> events:(unit -> Event.t list) -> Snapshot.t -> Snapshot.t Lwt.t - (** [import_webhook_events t ~events s] applies [events ()] on top - of [s]. Note: it ensure that all the metadata are correctly - updated by inserting (possibly) missing events in the mix. For - instance, GitHub never sends {{!Event.Status}status} events, so - [import_events] has to reconstruct them. *) - -end diff --git a/bridge/github/datakit_github_conv.ml b/src/datakit-github/datakit_github_conv.ml similarity index 100% rename from bridge/github/datakit_github_conv.ml rename to src/datakit-github/datakit_github_conv.ml diff --git a/bridge/github/datakit_github_conv.mli b/src/datakit-github/datakit_github_conv.mli similarity index 100% rename from bridge/github/datakit_github_conv.mli rename to src/datakit-github/datakit_github_conv.mli diff --git a/src/datakit/main.ml b/src/datakit/main.ml index 31237657b..589fef2f9 100644 --- a/src/datakit/main.ml +++ b/src/datakit/main.ml @@ -62,8 +62,9 @@ module Contents_string = struct end module Git_fs_store = struct open Irmin + open Datakit_io module Store = - Irmin_git.FS(Ir_io.Sync)(Ir_io.Zlib)(Ir_io.Lock)(Ir_io.FS) + Irmin_git.FS(Sync)(Zlib)(Lock)(FS) (Contents_string)(Ref.String)(Hash.SHA1) type t = Store.Repo.t module Filesystem = Ivfs.Make(Store) @@ -84,8 +85,9 @@ end module In_memory_store = struct open Irmin + open Datakit_io module Store = Irmin_git.Memory - (Ir_io.Sync)(Ir_io.Zlib)(Contents_string)(Ref.String) (Hash.SHA1) + (Sync)(Zlib)(Contents_string)(Ref.String) (Hash.SHA1) type t = Store.Repo.t module Filesystem = Ivfs.Make(Store) diff --git a/src/datakit/ir_io.ml b/src/datakit_io.ml similarity index 100% rename from src/datakit/ir_io.ml rename to src/datakit_io.ml diff --git a/src/datakit/ir_io.mli b/src/datakit_io.mli similarity index 100% rename from src/datakit/ir_io.mli rename to src/datakit_io.mli diff --git a/tests/test.ml b/tests/test.ml index 3ed34686f..61e7900aa 100644 --- a/tests/test.ml +++ b/tests/test.ml @@ -763,6 +763,5 @@ let () = Alcotest.run "datakit" [ "server" , test_set; "client" , Test_client.test_set; - "github" , Test_github.test_set; "conduit", [ "basic", `Quick, test_conduit ]; ] diff --git a/tests/test_github.ml b/tests/test_github.ml index 6b39cdead..127fef287 100644 --- a/tests/test_github.ml +++ b/tests/test_github.ml @@ -1,7 +1,6 @@ open Astring open Test_utils open Lwt.Infix -(*open Datakit_github*) open Datakit_path.Infix open Datakit_github @@ -572,7 +571,7 @@ module API = struct end module Bridge = Datakit_github_sync.Make(API)(DK) -module State = Datakit_github.State(API) +module State = Datakit_github_state.Make(API) let user = "test" let repo = "test" @@ -1793,3 +1792,8 @@ let test_set = [ "random-datakit" , `Quick, runx (test_random_datakit ~quick:true); "random-datakit-*", `Slow , runx (test_random_datakit ~quick:false); ] + +let () = + Alcotest.run "datakit-github" [ + "github" , test_set; + ] diff --git a/tests/test_utils.ml b/tests/test_utils.ml index 0ac818e7d..9d8407bbd 100644 --- a/tests/test_utils.ml +++ b/tests/test_utils.ml @@ -110,7 +110,8 @@ module Contents_string = struct module Path = Ivfs_tree.Path end -module Store = Irmin_git.Memory(Ir_io.Sync)(Ir_io.Zlib) +module Store = + Irmin_git.Memory(Datakit_io.Sync)(Datakit_io.Zlib) (Contents_string)(Irmin.Ref.String)(Irmin.Hash.SHA1) module Tree = Ivfs_tree.Make(Store)