diff --git a/.dockerignore b/.dockerignore index 188126e..0183eaf 100644 --- a/.dockerignore +++ b/.dockerignore @@ -5,3 +5,4 @@ static/system _data docker_dev/ docker_prod/ +e2e diff --git a/.gitignore b/.gitignore index da166ae..1bd57cc 100644 --- a/.gitignore +++ b/.gitignore @@ -41,3 +41,6 @@ _opam/ /docker_prod/config/prod.yml /_data .env* +e2e/_test* +e2e/_bin +e2e/.kubeconfig diff --git a/README.md b/README.md index 84c4eaa..7e91b1b 100644 --- a/README.md +++ b/README.md @@ -171,3 +171,24 @@ MIT, except for the following files: > LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, > OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE > SOFTWARE. + +## How to run Waq and Mastodon on kind + +Install docker beforehand. Then: +``` +cd e2e +make start-tmole +make create-cluster +make start-waq +make start-mastodon +make waq-port-forward & +make mastodon-port-forward & +cat _test_waq # Access this domain for Waq. +cat _test_mastodon # Access this domain for Mastodon. +``` + +When shutting down: +``` +make clean-cluster +make stop-tmole +``` diff --git a/e2e/Makefile b/e2e/Makefile new file mode 100644 index 0000000..331778e --- /dev/null +++ b/e2e/Makefile @@ -0,0 +1,103 @@ +KIND_VERSION:=0.20.0 +KUBERNETES_VERSION:=1.28.0 +HELM_VERSION:=3.14.0 +WD:=$(dir $(lastword $(MAKEFILE_LIST))) +BIN:=$(WD)/_bin +KIND:=$(BIN)/kind-$(KIND_VERSION) +KIND_CLUSTER_NAME=waq-test-cluster +KUBECTL:=$(BIN)/kubectl-$(KUBERNETES_VERSION) +HELM:=$(BIN)/helm-$(HELM_VERSION) +IMAGE=waq:dev + +.PHONY: run-test +run-test: + #env KUBECTL=$(KUBECTL) MANIFESTS=$(WD)/manifests OCAMLRUNPARAM=b E2E_TEST_WAQ_SERVER_NAME=https://$(shell cat $(WD)/_test_waq_domain) dune exec src/main.exe + env KUBECTL=$(KUBECTL) MANIFESTS=$(WD)/manifests OCAMLRUNPARAM=b E2E_TEST_WAQ_SERVER_NAME=http://localhost:58080 dune exec src/main.exe + +.PHONY: test +test: + $(MAKE) start-waq + $(MAKE) run-test + +$(BIN): + mkdir -p $(BIN) + +$(KIND): | $(BIN) + wget -O $(KIND) https://github.com/kubernetes-sigs/kind/releases/download/v$(KIND_VERSION)/kind-linux-amd64 + chmod a+x $(KIND) + +$(KUBECTL): | $(BIN) + wget -O $(KUBECTL) https://storage.googleapis.com/kubernetes-release/release/v$(KUBERNETES_VERSION)/bin/linux/amd64/kubectl + chmod a+x $(KUBECTL) + +$(HELM): | $(BIN) + curl -sSLf https://get.helm.sh/helm-v$(HELM_VERSION)-linux-amd64.tar.gz \ + | tar xvz -C $(BIN) --strip-components 1 linux-amd64/helm + mv $(BIN)/helm $@ + +KUBECONFIG := $(shell pwd)/.kubeconfig +.PHONY: $(KUBECONFIG) +$(KUBECONFIG): | $(KIND) + $(KIND) export kubeconfig --name $(KIND_CLUSTER_NAME) --kubeconfig=$@ + +.PHONY: setup +setup: $(KIND) $(KUBECTL) $(HELM) + +.PHONY: build-image +build-image: + cd $(WD)/.. && docker build . -t $(IMAGE) + +.PHONY: clean-cluster +clean-cluster: + $(KIND) delete cluster -n $(KIND_CLUSTER_NAME) + +.PHONY: start-tmole +start-tmole: + systemctl --user reset-failed tmole-waq || true + systemctl --user reset-failed tmole-mastodon || true + systemd-run --user --unit=tmole-waq --working-directory=$(WD) ./launch-tmole.sh waq 58080 + systemd-run --user --unit=tmole-mastodon --working-directory=$(WD) ./launch-tmole.sh mastodon 58081 + +.PHONY: stop-tmole +stop-tmole: + systemctl --user stop tmole-waq || true + rm -f _test_waq_domain + systemctl --user stop tmole-mastodon || true + rm -f _test_mastodon_domain + +.PHONY: create-cluster +create-cluster: + $(MAKE) setup + $(MAKE) clean-cluster + $(KIND) create cluster -n $(KIND_CLUSTER_NAME) --image kindest/node:v$(KUBERNETES_VERSION) + $(MAKE) $(KUBECONFIG) + $(KUBECTL) create namespace e2e + KUBECONFIG=$(KUBECONFIG) $(HELM) install --namespace e2e --repo https://ushitora-anqou.github.io/mahout mahout mahout + $(KUBECTL) apply -f $(WD)/manifests/postgres.yaml + $(KUBECTL) apply -f $(WD)/manifests/elk.yaml + +.PHONY: start-mastodon +start-mastodon: + cat $(WD)/manifests/mastodon.yaml | sed "s/E2E_TEST_MASTODON_SERVER_NAME/$(shell cat $(WD)/_test_mastodon_domain)/" | $(KUBECTL) apply -f - + +.PHONY: start-waq +start-waq: + $(MAKE) build-image + $(KIND) load docker-image $(IMAGE) -n $(KIND_CLUSTER_NAME) + $(KUBECTL) delete -f $(WD)/manifests/waq.yaml || true + $(KUBECTL) delete -f $(WD)/manifests/waq-reset-db.yaml || true + cat $(WD)/manifests/waq.yaml | sed "s/E2E_TEST_WAQ_SERVER_NAME/$(shell cat $(WD)/_test_waq_domain)/" | $(KUBECTL) apply -f - + $(KUBECTL) apply -f $(WD)/manifests/waq-reset-db.yaml + $(KUBECTL) wait --for=condition=available deploy/waq-web -n e2e + +.PHONY: waq-port-forward +waq-port-forward: + $(KUBECTL) port-forward -n e2e --address 0.0.0.0 svc/waq-web 58080:8000 + +.PHONY: mastodon-port-forward +mastodon-port-forward: + $(KUBECTL) port-forward -n e2e --address 0.0.0.0 svc/mastodon-gateway 58081:80 + +.PHONY: elk-port-forward +elk-port-forward: + $(KUBECTL) port-forward -n e2e --address 0.0.0.0 svc/elk 58082:5314 diff --git a/e2e/launch-tmole.sh b/e2e/launch-tmole.sh new file mode 100755 index 0000000..541e413 --- /dev/null +++ b/e2e/launch-tmole.sh @@ -0,0 +1,22 @@ +#!/usr/bin/bash -eu + +set -o pipefail + +NAME=$1 +PORT=$2 + +PROG=" +cd /home/node +npm i tunnelmole +cat < tmole.js +const fs = require('node:fs'); +const tunnelmole = require('tunnelmole/cjs'); +(async () => { + const url = await tunnelmole({ port: ${PORT} }); + const domain = new URL(url).hostname; + console.log('OUTPUT:'+domain); +})() +EOS +node tmole.js" + +docker run --init --rm --add-host=localhost:host-gateway --entrypoint 'bash' node -c "${PROG}" | grep --line-buffered OUTPUT | stdbuf -oL cut -d ':' -f2 | tee _test_${NAME}_domain diff --git a/e2e/manifests/elk.yaml b/e2e/manifests/elk.yaml new file mode 100644 index 0000000..7102ac0 --- /dev/null +++ b/e2e/manifests/elk.yaml @@ -0,0 +1,34 @@ +--- +apiVersion: v1 +kind: Service +metadata: + name: elk + namespace: e2e +spec: + selector: + app: elk + ports: + - port: 5314 +--- +apiVersion: apps/v1 +kind: Deployment +metadata: + name: elk + namespace: e2e +spec: + replicas: 1 + selector: + matchLabels: + app: elk + template: + metadata: + labels: + app: elk + spec: + containers: + - name: elk + image: ghcr.io/elk-zone/elk:v0.12.1 + ports: + - name: http + containerPort: 5314 + protocol: TCP diff --git a/e2e/manifests/mastodon.yaml b/e2e/manifests/mastodon.yaml new file mode 100644 index 0000000..065160a --- /dev/null +++ b/e2e/manifests/mastodon.yaml @@ -0,0 +1,82 @@ +--- +apiVersion: mahout.anqou.net/v1alpha1 +kind: Mastodon +metadata: + name: mastodon + namespace: e2e +spec: + serverName: "mastodon.test" + image: "ghcr.io/mastodon/mastodon:v4.2.0" + envFrom: + - secretRef: + name: mastodon-secret-env + gateway: + replicas: 1 + image: "nginx:1.25.4" + sidekiq: + replicas: 1 + streaming: + replicas: 1 + web: + replicas: 1 +--- +apiVersion: v1 +kind: Service +metadata: + name: redis + namespace: e2e + labels: + app: redis +spec: + ports: + - port: 6379 + name: redis + clusterIP: None + selector: + app: redis +--- +apiVersion: apps/v1 +kind: StatefulSet +metadata: + name: redis + namespace: e2e +spec: + selector: + matchLabels: + app: redis + serviceName: "redis" + replicas: 1 + template: + metadata: + labels: + app: redis + spec: + terminationGracePeriodSeconds: 10 + containers: + - name: redis + image: redis:7.2.3-alpine + ports: + - containerPort: 6379 + name: redis +--- +apiVersion: v1 +kind: Secret +metadata: + name: mastodon-secret-env + namespace: e2e +type: Opaque +stringData: + LOCAL_DOMAIN: "E2E_TEST_MASTODON_SERVER_NAME" + REDIS_HOST: redis.e2e.svc + REDIS_PORT: "6379" + DB_HOST: postgres.e2e.svc + DB_USER: mastodon + DB_PASS: password + DB_NAME: mastodon_production + DB_PORT: "5432" + IP_RETENTION_PERIOD: "31556952" + SESSION_RETENTION_PERIOD: "31556952" + SECRET_KEY_BASE: 928dab5fdf3cfd4a16e89ab92e343d9d3d96e232ee77bf9d0a18ea510d4231f0fb1425c51f3ca8cfb8f031ca6b7bc25a04e2aa2230e11b614b8215974bff23b6 + OTP_SECRET: a2679b530056aa9a5aa2c5956684bdab64480f69bd5252e5c9f5eb64c6ea1dbcece44195d7f9236f5bfccad421413fd606996ec53c082147303736921e4ad07b + VAPID_PRIVATE_KEY: YMFYOwrat5ZQxRQmXka0oaHr56TpctygcO7XtYfuwCA= + VAPID_PUBLIC_KEY: BNQoJF_o0Jk-soeZuqdGIx-8vjUfk6bH7ezFw3JtGl29iTUAz8OtjZl6wkb2Zz2I_ekokAk4lI-dyLiUpHLV6gA= diff --git a/e2e/manifests/postgres.yaml b/e2e/manifests/postgres.yaml new file mode 100644 index 0000000..9268573 --- /dev/null +++ b/e2e/manifests/postgres.yaml @@ -0,0 +1,82 @@ +--- +apiVersion: v1 +kind: Service +metadata: + name: postgres + namespace: e2e + labels: + app: postgres +spec: + ports: + - port: 5432 + name: postgres + clusterIP: None + selector: + app: postgres +--- +apiVersion: apps/v1 +kind: StatefulSet +metadata: + name: postgres + namespace: e2e +spec: + selector: + matchLabels: + app: postgres + serviceName: "postgres" + replicas: 1 + template: + metadata: + labels: + app: postgres + spec: + terminationGracePeriodSeconds: 10 + containers: + - name: postgres + image: postgres + ports: + - containerPort: 5432 + name: postgres + env: + - name: POSTGRES_HOST_AUTH_METHOD + value: trust + livenessProbe: + exec: + command: + - pg_isready + - -U + - postgres + readinessProbe: + exec: + command: + - pg_isready + - -U + - postgres +--- +apiVersion: batch/v1 +kind: Job +metadata: + name: create-postgres-database + namespace: e2e +spec: + template: + spec: + restartPolicy: Never + containers: + - name: postgres + image: postgres + command: + - bash + - -ce + - | + cat < ) f g a = a |> f |> g +let ignore_lwt = Waq.Util.ignore_lwt +let fetch = Httpq.Client.fetch +let fetch_exn = Httpq.Client.fetch_exn +let ( ^/ ) a b = a ^ "/" ^ b + +let expect_string = function + | `String s -> s + | _ -> failwith "Expected string, got something different" + +let expect_assoc = function + | `Assoc l -> l + | _ -> failwith "Expected assoc, got something different" + +let expect_list = function + | `List l -> l + | _ -> failwith "Expected list, got something different" + +let expect_bool = function + | `Bool b -> b + | _ -> failwith "Expected bool, got something different" + +let expect_int = function + | `Int v -> v + | _ -> failwith "Expected int, got something different" + +let with_lock mtx f = + match mtx with None -> f () | Some mtx -> Lwt_mutex.with_lock mtx f + +let kubectl_path = Sys.getenv "KUBECTL" +let manifests = Sys.getenv "MANIFESTS" ^ "/" + +let kubectl args f = + let open Unix in + let ic = + open_process_args_in kubectl_path (Array.of_list (kubectl_path :: args)) + in + try + let res = f ic in + (close_process_in ic, res) + with e -> + close_process_in ic |> ignore; + raise e + +let port_forward ~ns ~svc ~ports f = + kubectl + [ "port-forward"; "-n"; ns; "--address"; "0.0.0.0"; "svc/" ^ svc; ports ] + (fun ic -> + let pid = Unix.process_in_pid ic in + Fun.protect ~finally:(fun () -> Unix.kill pid Sys.sigint) f) + |> ignore + +let new_session f = + let _ = + kubectl [ "delete"; "job"; "reset-waq-database"; "-n"; "e2e" ] ignore + in + let _ = kubectl [ "apply"; "-f"; manifests ^ "waq-reset-db.yaml" ] ignore in + let _ = + kubectl [ "wait"; "--for=condition=complete"; "job/reset-waq-database"; "-n"; "e2e" ] + ignore + [@ocamlformat "disable"] + in + + port_forward ~ns:"e2e" ~svc:"waq-web" ~ports:"58080:8000" @@ fun () -> + let token1 = + kubectl + (["exec"; "-n"; "e2e"; "deploy/waq-web"; "--"; "bash"; "-ce"; + "/waq/waq oauth:generate_access_token user1 2> /dev/null"] + [@ocamlformat "disable"]) + (fun ic -> In_channel.input_line ic |> Option.value ~default:"") + |> snd + in + f token1; + () + +let new_mastodon_session f = + let path = + Sys.getenv_opt "MSTDN_BIN" + |> Option.value ~default:"test_e2e/launch_mstdn.sh" + in + let open Unix in + let ic = open_process_args_in path [| path |] in + let token = In_channel.input_line ic |> Option.value ~default:"" in + let pid = process_in_pid ic in + Fun.protect + (fun () -> f token) + ~finally:(fun () -> + Logq.debug (fun m -> m "Killing mastodon processes"); + kill pid Sys.sigint; + close_process_in ic |> ignore) + +let make_waq_and_mstdn_scenario ?(timeout = 30.0) handler () : unit = + new_session @@ fun waq_token -> + Logq.debug (fun m -> m "Access token for Waq: %s" waq_token); + new_mastodon_session @@ fun mstdn_token -> + Logq.debug (fun m -> m "Access token for Mastodon: %s" mstdn_token); + Unix.sleep 10; + Lwt_main.run + @@ Lwt.pick + [ + handler waq_token mstdn_token; + (Lwt_unix.sleep timeout >>= fun () -> failwith "Timeout"); + ] + +let make_waq_scenario ?(timeout = 30.0) handler () : unit = + new_session @@ fun waq_token -> + Logq.debug (fun m -> m "Access token for Waq: %s" waq_token); + Unix.sleep 1; + Lwt_main.run + @@ Lwt.pick + [ + handler waq_token; + (Lwt_unix.sleep timeout >>= fun () -> failwith "Timeout"); + ] + +let waq_server_name = Sys.getenv "E2E_TEST_WAQ_SERVER_NAME" +let waq_server_domain = Uri.(of_string waq_server_name |> domain) +let waq url = waq_server_name ^ url + +let mstdn url = + let server_name = "http://localhost:3000" in + server_name ^ url + +let url = function `Waq -> waq | `Mstdn -> mstdn + +let pp_json (s : string) = + Logq.debug (fun m -> m "%s" Yojson.Safe.(from_string s |> pretty_to_string)) + [@@warning "-32"] + +let do_fetch ?token ?(meth = `GET) ?(body = "") kind target = + let headers = [ (`Accept, "application/json") ] in + let headers = + match meth with + | `POST -> (`Content_type, "application/json") :: headers + | _ -> headers + in + let headers = + match token with + | Some token -> (`Authorization, "Bearer " ^ token) :: headers + | None -> headers + in + fetch_exn ~headers ~meth ~body (url kind target) + +type account = { + id : string; + username : string; + acct : string; + display_name : string; + note : string; + last_status_at : string option; + statuses_count : int; + followers_count : int; + following_count : int; + avatar : string; + header : string; + bot : bool; +} +[@@deriving yojson] [@@yojson.allow_extra_fields] + +type media_attachment = { + id : string; + type_ : string; [@key "type"] + url : string; +} +[@@deriving yojson] [@@yojson.allow_extra_fields] + +type preview_card = { url : string } +[@@deriving yojson] [@@yojson.allow_extra_fields] + +type status_mention = { + id : string; + username : string; + url : string; + acct : string; +} +[@@deriving make, yojson] + +type status = { + id : string; + uri : string; + reblog : status option; + reblogged : bool; + reblogs_count : int; + favourited : bool; + account : account; + favourites_count : int; + media_attachments : media_attachment list; + spoiler_text : string; + mentions : status_mention list; + card : preview_card option; + content : string option; [@yojson.option] +} +[@@deriving yojson] [@@yojson.allow_extra_fields] + +type relationship = { id : string; following : bool; followed_by : bool } +[@@deriving yojson] [@@yojson.allow_extra_fields] + +type notification = { + id : string; + typ : string; [@key "type"] + created_at : string; + account : account; + status : status option; [@yojson.option] +} +[@@deriving make, yojson] + +type marker = { last_read_id : string; version : int; updated_at : string } +[@@deriving make, yojson] + +let update_credentials ~token kind ?display_name ?note ?avatar ?header ?bot () = + let target = "/api/v1/accounts/update_credentials" in + let headers = + [ + (`Accept, "application/json"); + (`Authorization, "Bearer " ^ token); + ( `Content_type, + "multipart/form-data; \ + boundary=---------------------------91791948726096252761377705945" ); + ] + in + let body = + [ {|-----------------------------91791948726096252761377705945--|}; {||} ] + in + let body = + match bot with + | None -> body + | Some bot -> + [ + {|-----------------------------91791948726096252761377705945|}; + {|Content-Disposition: form-data; name="bot"|}; + {||}; + string_of_bool bot; + ] + @ body + in + let body = + match note with + | None -> body + | Some note -> + [ + {|-----------------------------91791948726096252761377705945|}; + {|Content-Disposition: form-data; name="note"|}; + {||}; + note; + ] + @ body + in + let body = + match display_name with + | None -> body + | Some display_name -> + [ + {|-----------------------------91791948726096252761377705945|}; + {|Content-Disposition: form-data; name="display_name"|}; + {||}; + display_name; + ] + @ body + in + let body = + match avatar with + | None -> body + | Some avatar -> + [ + {|-----------------------------91791948726096252761377705945|}; + {|Content-Disposition: form-data; name="avatar"; filename="avatar.png"|}; + {|Content-Type: image/png|}; + {||}; + avatar; + ] + @ body + in + let body = + match header with + | None -> body + | Some header -> + [ + {|-----------------------------91791948726096252761377705945|}; + {|Content-Disposition: form-data; name="header"; filename="header.png"|}; + {|Content-Type: image/png|}; + {||}; + header; + ] + @ body + in + assert (List.length body <> 2); + let body = String.concat "\r\n" body in + fetch_exn ~headers ~meth:`PATCH ~body (url kind target) + >|= Yojson.Safe.from_string >|= account_of_yojson + +let lookup_via_v1_accounts_lookup ~token kind ?domain ~username () = + let target = + let src = "/api/v1/accounts/lookup?acct=" in + match domain with + | None -> src ^ username + | Some domain -> src ^ username ^ "@" ^ domain + in + let%lwt r = do_fetch ~token kind target in + let a = r |> Yojson.Safe.from_string |> account_of_yojson in + Lwt.return (a.id, a.username, a.acct) + +let lookup_via_v1_accounts_search ?token kind ?domain ~username () = + let target = + let src = "/api/v1/accounts/search?resolve=true&q=@" in + match domain with + | None -> src ^ username + | Some domain -> src ^ username ^ "@" ^ domain + in + let%lwt r = do_fetch ?token kind target in + let l = + match Yojson.Safe.from_string r with + | `List [ `Assoc l ] -> l + | _ -> assert false + in + Lwt.return + ( l |> List.assoc "id" |> expect_string, + l |> List.assoc "username" |> expect_string, + l |> List.assoc "acct" |> expect_string ) + +let search ?token kind q = + let queries = [ ("resolve", [ "true" ]); ("q", [ q ]) ] in + let u = Uri.of_string "/api/v2/search" in + let u = Uri.add_query_params u queries in + let%lwt r = do_fetch ?token kind (Uri.to_string u) in + let l = Yojson.Safe.from_string r |> expect_assoc in + Lwt.return + ( List.assoc "accounts" l |> expect_list |> List.map account_of_yojson, + List.assoc "statuses" l |> expect_list |> List.map status_of_yojson, + List.assoc "hashtags" l |> expect_list ) + +let lookup ~token kind ?domain ~username () = + search ~token kind + (domain + |> Option.fold ~none:("@" ^ username) ~some:(fun domain -> + "@" ^ username ^ "@" ^ domain)) + >|= function + | [ acct ], _, _ -> (acct.id, acct.username, acct.acct) + | _ -> assert false + +let get_account kind id = + do_fetch kind ("/api/v1/accounts/" ^ id) + >|= Yojson.Safe.from_string >|= account_of_yojson + +let get_relationships ~token kind account_ids = + let target = + "/api/v1/accounts/relationships?" + ^ (account_ids |> List.map (fun id -> "id[]=" ^ id) |> String.concat "&") + in + do_fetch ~token kind target + >|= Yojson.Safe.from_string >|= expect_list + >|= List.map relationship_of_yojson + +let get_followers ?token kind account_id = + do_fetch ?token kind ("/api/v1/accounts/" ^ account_id ^ "/followers") + >|= Yojson.Safe.from_string >|= expect_list >|= List.map account_of_yojson + +let get_following ?token kind account_id = + do_fetch ?token kind ("/api/v1/accounts/" ^ account_id ^ "/following") + >|= Yojson.Safe.from_string >|= expect_list >|= List.map account_of_yojson + +let get_notifications ?token kind = + do_fetch ?token kind "/api/v1/notifications" + >|= Yojson.Safe.from_string >|= expect_list + >|= List.map notification_of_yojson + +let markers_of_yojson j = + let l = expect_assoc j in + ( List.assoc_opt "home" l |> Option.map marker_of_yojson, + List.assoc_opt "notifications" l |> Option.map marker_of_yojson ) + +let get_markers ?token kind timelines = + do_fetch ?token kind + ("/api/v1/markers?" + ^ (timelines |> List.map (fun s -> "timeline[]=" ^ s) |> String.concat "&") + ) + >|= Yojson.Safe.from_string >|= markers_of_yojson + +let post_markers ?token kind values = + let body = + values + |> List.map (fun (timeline, last_read_id) -> + (timeline, `Assoc [ ("last_read_id", `String last_read_id) ])) + |> fun l -> `Assoc l |> Yojson.Safe.to_string + in + do_fetch ~meth:`POST ?token kind ~body "/api/v1/markers" + >|= Yojson.Safe.from_string >|= markers_of_yojson + +let follow ~token kind account_id = + let%lwt r = + do_fetch ~meth:`POST ~token kind + ("/api/v1/accounts/" ^ account_id ^ "/follow") + in + assert ( + Yojson.Safe.from_string r |> expect_assoc |> List.assoc "following" + |> expect_bool); + Lwt.return_unit + +let unfollow ~token kind account_id = + do_fetch ~meth:`POST ~token kind + ("/api/v1/accounts/" ^ account_id ^ "/unfollow") + |> ignore_lwt + +let get_status kind ?token status_id = + do_fetch ?token kind ("/api/v1/statuses/" ^ status_id) + >|= Yojson.Safe.from_string >|= status_of_yojson + +let get_account_statuses kind ?token ?(exclude_replies = false) account_id = + do_fetch ?token kind + ("/api/v1/accounts/" ^ account_id ^ "/statuses?exclude_replies=" + ^ string_of_bool exclude_replies) + >|= Yojson.Safe.from_string >|= expect_list >|= List.map status_of_yojson + +let get_status_context kind status_id = + let%lwt r = do_fetch kind ("/api/v1/statuses/" ^ status_id ^ "/context") in + let l = Yojson.Safe.from_string r |> expect_assoc in + match l with + | [ ("ancestors", `List ancestors); ("descendants", `List descendants) ] + | [ ("descendants", `List descendants); ("ancestors", `List ancestors) ] -> + let ancestors = ancestors |> List.map status_of_yojson in + let descendants = descendants |> List.map status_of_yojson in + Lwt.return (ancestors, descendants) + | _ -> assert false + +let post ~token kind ?spoiler_text ?content ?in_reply_to_id ?(media_ids = []) () + = + let content = content |> Option.value ~default:"こんにちは、世界！" in + let body = + let l = + [ + ("status", `String content); + ("media_ids", `List (media_ids |> List.map (fun s -> `String s))); + ] + in + let l = + in_reply_to_id + |> Option.fold ~none:l ~some:(fun id -> + ("in_reply_to_id", `String id) :: l) + in + let l = + spoiler_text + |> Option.fold ~none:l ~some:(fun s -> ("spoiler_text", `String s) :: l) + in + `Assoc l |> Yojson.Safe.to_string + in + do_fetch ~token ~meth:`POST ~body kind "/api/v1/statuses" + >|= Yojson.Safe.from_string >|= status_of_yojson + +let delete_status ~token kind status_id = + do_fetch ~token ~meth:`DELETE kind ("/api/v1/statuses/" ^ status_id) + >|= Yojson.Safe.from_string >|= status_of_yojson + +let reblog ~token kind ~id = + do_fetch ~token ~meth:`POST kind ("/api/v1/statuses/" ^ id ^ "/reblog") + >|= Yojson.Safe.from_string >|= status_of_yojson + +let unreblog ~token kind ~id = + do_fetch ~token ~meth:`POST kind ("/api/v1/statuses/" ^ id ^ "/unreblog") + >|= Yojson.Safe.from_string >|= status_of_yojson + +let fav ~token kind ~id = + do_fetch ~token ~meth:`POST kind ("/api/v1/statuses/" ^ id ^ "/favourite") + >|= Yojson.Safe.from_string >|= status_of_yojson + +let unfav ~token kind ~id = + do_fetch ~token ~meth:`POST kind ("/api/v1/statuses/" ^ id ^ "/unfavourite") + >|= Yojson.Safe.from_string >|= status_of_yojson + +let get_favourited_by ~token kind ~id = + do_fetch ~token ~meth:`GET kind ("/api/v1/statuses/" ^ id ^ "/favourited_by") + >|= Yojson.Safe.from_string >|= expect_list >|= List.map account_of_yojson + +let home_timeline ~token kind = + do_fetch ~token kind "/api/v1/timelines/home" >|= fun r -> + match Yojson.Safe.from_string r with `List l -> l | _ -> assert false + +let fetch_access_token ~username = + let%lwt r = + fetch_exn ~meth:`POST + ~headers:[ (`Content_type, "application/json") ] + ~body: + {|{"client_name":"foo","redirect_uris":"http://example.com?origin=http://example.com"}|} + (waq "/api/v1/apps") + in + let client_id, client_secret = + match Yojson.Safe.from_string r with + | `Assoc l -> + ( List.assoc "client_id" l |> expect_string, + List.assoc "client_secret" l |> expect_string ) + | _ -> assert false + in + + let%lwt r = + let body = + Uri.encoded_of_query + [ + ("response_type", [ "code" ]); + ("client_id", [ client_id ]); + ("redirect_uri", [ "http://example.com?origin=http://example.com" ]); + ("username", [ username ]); + ("password", [ username ^ "password" ]); + ] + in + fetch ~meth:`POST ~body (waq "/oauth/authorize") + in + let auth_code = + match r with + | Ok (`Found, headers, _body) -> + (* 0123456789012345678901234 + http://example.com?code=... *) + headers |> List.assoc "location" |> Uri.of_string |> Uri.query + |> List.assoc "code" |> List.hd + | _ -> assert false + in + + let%lwt r = + fetch_exn ~meth:`POST + ~headers:[ (`Content_type, "application/json") ] + ~body: + (`Assoc + [ + ("grant_type", `String "authorization_code"); + ("code", `String auth_code); + ("client_id", `String client_id); + ("client_secret", `String client_secret); + ( "redirect_uri", + `String "http://example.com?origin=http://example.com" ); + ] + |> Yojson.Safe.to_string) + (waq "/oauth/token") + in + match Yojson.Safe.from_string r with + | `Assoc l -> l |> List.assoc "access_token" |> expect_string |> Lwt.return + | _ -> assert false + +let websocket ?mtx ~token kind ?target handler f = + let open Websocket_lwt_unix in + let target = + match target with + | Some target -> target + | None -> "/api/v1/streaming?stream=user" + in + let uri = Uri.of_string (url kind target) in + let%lwt endp = Resolver_lwt.resolve_uri ~uri Resolver_lwt_unix.system in + let ctx = Lazy.force Conduit_lwt_unix.default_ctx in + let%lwt client = Conduit_lwt_unix.endp_to_client ~ctx endp in + + let extra_headers = + Cohttp.Header.of_list [ ("Sec-WebSocket-Protocol", token) ] + in + let%lwt conn = connect ~extra_headers ~ctx client uri in + let close_sent = ref false in + let pushf msg = + match msg with + | Some content -> write conn (Websocket.Frame.create ~content ()) + | None when !close_sent -> Lwt.return_unit + | None -> + write conn (Websocket.Frame.create ~opcode:Close ());%lwt + Lwt.return (close_sent := true) + in + let rec react () = + match%lwt read conn with + | { Websocket.Frame.opcode = Ping; _ } -> + write conn (Websocket.Frame.create ~opcode:Pong ());%lwt + react () + | { opcode = Pong; _ } -> react () + | { opcode = Text; content; _ } | { opcode = Binary; content; _ } -> + with_lock mtx (fun () -> handler content pushf);%lwt + react () + | { opcode = Close; content; _ } -> + if !close_sent then Lwt.return_unit + else if String.length content >= 2 then + write conn + (Websocket.Frame.create ~opcode:Close + ~content:(String.sub content 0 2) ()) + else write conn (Websocket.Frame.close 1000);%lwt + close_transport conn + | _ -> close_transport conn + in + Lwt.join [ with_lock mtx (fun () -> f pushf); react () ] + +let websocket_handler_state_machine ~states ~init () = + let current = ref init in + let set_current v = current := v in + let handler content pushf = + let real_handler = states |> List.assoc !current in + let%lwt next_state = + real_handler (content |> Yojson.Safe.from_string |> expect_assoc) pushf + in + set_current next_state; + Lwt.return_unit + in + (set_current, handler) + +let websocket_stack kind ~token ?num_msgs f = + let recv_msgs = ref [] in + let handler content pushf = + recv_msgs := content :: !recv_msgs; + match num_msgs with + | Some num_msgs when List.length !recv_msgs = num_msgs -> pushf None + | _ -> Lwt.return_unit + in + websocket kind ~token handler (fun pushf -> + f pushf;%lwt + match num_msgs with None -> pushf None | Some _ -> Lwt.return_unit) + >|= fun () -> !recv_msgs + +let expect_exc_lwt f = + (try%lwt + let%lwt _ = f () in + Lwt.return_false + with _ -> Lwt.return_true) + >|= fun b -> assert b + +let test_image = + {| +iVBORw0KGgoAAAANSUhEUgAAADIAAAAyAQAAAAA2RLUcAAAABGdBTUEAALGPC/xhBQAAACBjSFJN +AAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAAAmJLR0QAAd2KE6QAAAAHdElN +RQfnAxYCJTrYPC4yAAAADklEQVQY02NgGAWDCQAAAZAAAcWb20kAAAAldEVYdGRhdGU6Y3JlYXRl +ADIwMjMtMDMtMjJUMDI6Mzc6NTgrMDA6MDClQ3CPAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIzLTAz +LTIyVDAyOjM3OjU4KzAwOjAw1B7IMwAAAABJRU5ErkJggg==|} + |> String.trim |> String.split_on_char '\n' |> String.concat "" + |> Base64.decode_exn diff --git a/e2e/src/common2.ml b/e2e/src/common2.ml new file mode 100644 index 0000000..42f4372 --- /dev/null +++ b/e2e/src/common2.ml @@ -0,0 +1,162 @@ +include Common + +type agent = { + kind : [ `Waq | `Mstdn ]; + token : string; + username : string; + domain : string; +} +[@@deriving make] + +let acct_of_agent ~(from : agent) (a : agent) = + if a.domain = from.domain then a.username else a.username ^ "@" ^ a.domain + +let lookup src = lookup src.kind ~token:src.token +let follow src = follow src.kind ~token:src.token +let post src = post src.kind ~token:src.token +let search src = search src.kind ~token:src.token +let reblog src = reblog src.kind ~token:src.token +let unreblog src = unreblog src.kind ~token:src.token + +let home_timeline src = + home_timeline src.kind ~token:src.token >|= List.map status_of_yojson + +let delete_status src = delete_status src.kind ~token:src.token +let get_status src = get_status src.kind ~token:src.token +let get_notifications src = get_notifications src.kind ~token:src.token +let update_credentials src = update_credentials src.kind ~token:src.token + +let websocket src ?target handler f = + websocket src.kind ~token:src.token ?target handler f + +let upload_media src ~filename ~data ~content_type = + let target = "/api/v2/media" in + let headers = + [ + (`Accept, "application/json"); + (`Authorization, "Bearer " ^ src.token); + ( `Content_type, + "multipart/form-data; \ + boundary=---------------------------91791948726096252761377705945" ); + ] + in + let body = + [ {|-----------------------------91791948726096252761377705945--|}; {||} ] + in + let body = + [ + {|-----------------------------91791948726096252761377705945|}; + {|Content-Disposition: form-data; name="file"; filename="|} ^ filename + ^ {|"|}; + {|Content-Type: |} ^ content_type; + {||}; + data; + ] + @ body + in + assert (List.length body <> 2); + let body = String.concat "\r\n" body in + fetch_exn ~headers ~meth:`POST ~body (url src.kind target) + >|= Yojson.Safe.from_string >|= media_attachment_of_yojson + +let lookup_agent src dst = + let domain = if src.domain = dst.domain then None else Some dst.domain in + lookup src ~username:dst.username ?domain () + +let follow_agent src dst = + let%lwt id, _, _ = lookup_agent src dst in + follow src id + +let expect_no_status src id = + try%lwt + get_status src id |> ignore_lwt;%lwt + assert false + with Httpq.Client.FetchFailure (Some (`Not_found, _, _)) -> Lwt.return_unit + +type runtime_context = { + waq_tokens : string array; + mutable waq_num_used_tokens : int; + mstdn_tokens : string array; + mutable mstdn_num_used_tokens : int; +} +[@@deriving make] + +let generate_waq_agent ctxt = + let i = ctxt.waq_num_used_tokens in + ctxt.waq_num_used_tokens <- i + 1; + let token = ctxt.waq_tokens.(i) in + let username = "user" ^ string_of_int (i + 1) in + make_agent ~kind:`Waq ~token ~username ~domain:waq_server_domain + +let generate_mstdn_agent ctxt = + let i = ctxt.mstdn_num_used_tokens in + ctxt.mstdn_num_used_tokens <- i + 1; + let token = ctxt.mstdn_tokens.(i) in + let username = "mstdn" ^ string_of_int (i + 1) in + make_agent ~kind:`Mstdn ~token ~username ~domain:"localhost:3000" + +let new_session f = + let path = + Sys.getenv_opt "WAQ_BIN" |> Option.value ~default:"test_e2e/launch_waq.sh" + in + let open Unix in + let ic = open_process_args_in path [| path |] in + let token1 = In_channel.input_line ic |> Option.get in + let token2 = In_channel.input_line ic |> Option.get in + let token3 = In_channel.input_line ic |> Option.get in + let pid = process_in_pid ic in + Fun.protect + (fun () -> f [| token1; token2; token3 |]) + ~finally:(fun () -> + kill pid Sys.sigint; + close_process_in ic |> ignore) + +let new_mastodon_session f = + let path = + Sys.getenv_opt "MSTDN_BIN" + |> Option.value ~default:"test_e2e/launch_mstdn.sh" + in + let open Unix in + let ic = open_process_args_in path [| path |] in + let _admin = In_channel.input_line ic |> Option.get in + let token1 = In_channel.input_line ic |> Option.get in + let token2 = In_channel.input_line ic |> Option.get in + let token3 = In_channel.input_line ic |> Option.get in + let pid = process_in_pid ic in + Fun.protect + (fun () -> f [| token1; token2; token3 |]) + ~finally:(fun () -> + Logq.debug (fun m -> m "Killing mastodon processes"); + kill pid Sys.sigint; + close_process_in ic |> ignore) + +let launch_waq ?(timeout = 30.0) (f : runtime_context -> unit Lwt.t) : unit = + new_session @@ fun waq_tokens -> + Logq.debug (fun m -> + m "Access token for Waq: [%s]" + (waq_tokens |> Array.to_list |> String.concat ";")); + let ctxt = + make_runtime_context ~waq_tokens ~mstdn_tokens:[||] ~waq_num_used_tokens:0 + ~mstdn_num_used_tokens:0 + in + Unix.sleep 10; + Lwt.pick [ f ctxt; (Lwt_unix.sleep timeout >>= fun () -> failwith "Timeout") ] + |> Lwt_main.run + +let launch_waq_and_mstdn ?(timeout = 30.0) (f : runtime_context -> unit Lwt.t) : + unit = + new_session @@ fun waq_tokens -> + Logq.debug (fun m -> + m "Access token for Waq: [%s]" + (waq_tokens |> Array.to_list |> String.concat ";")); + new_mastodon_session @@ fun mstdn_tokens -> + Logq.debug (fun m -> + m "Access token for Mastodon: [%s]" + (mstdn_tokens |> Array.to_list |> String.concat ";")); + let ctxt = + make_runtime_context ~waq_tokens ~mstdn_tokens ~waq_num_used_tokens:0 + ~mstdn_num_used_tokens:0 + in + Unix.sleep 10; + Lwt.pick [ f ctxt; (Lwt_unix.sleep timeout >>= fun () -> failwith "Timeout") ] + |> Lwt_main.run diff --git a/e2e/src/dune b/e2e/src/dune new file mode 100644 index 0000000..613a94b --- /dev/null +++ b/e2e/src/dune @@ -0,0 +1,16 @@ +(executable + (name main) + (preprocess + (pps lwt_ppx ppx_deriving.make ppx_yojson_conv)) + (libraries + cohttp + cohttp-lwt-unix + httpq + logq + lwt + lwt.unix + waq + websocket + websocket-lwt-unix + websocket-lwt-unix.cohttp + yojson)) diff --git a/e2e/src/main.ml b/e2e/src/main.ml new file mode 100644 index 0000000..57b8723 --- /dev/null +++ b/e2e/src/main.ml @@ -0,0 +1,85 @@ +module Uri = Httpq.Uri +module Ptime = Waq.Util.Ptime + +let all_tests = + [ + (* + ("waq-mstdn-1", Waq_mstdn_1.f); + ("waq-mstdn-2", Waq_mstdn_2.f); + ("waq-mstdn-3", Waq_mstdn_3_reply.f); + ("waq-mstdn-4", Waq_mstdn_4_reblog.f); + ("waq-mstdn-5", Waq_mstdn_5_reblog.f); + ("waq-mstdn-6", Waq_mstdn_6_fav.f); + ("waq-mstdn-7", Waq_mstdn_7_fav.f); + ("waq-mstdn-8", Waq_mstdn_8_lookup_search.f); + ("waq-mstdn-9-1", Waq_mstdn_9_delete.f_waq_mstdn); + ("waq-mstdn-9-2", Waq_mstdn_9_delete.f_mstdn_waq); + ("waq-mstdn-10-1", Waq_mstdn_10_attachment.f_waq_mstdn); + ("waq-mstdn-10-2", Waq_mstdn_10_attachment.f_mstdn_waq); + ("waq-mstdn-10-3", Waq_mstdn_10_attachment.f_waq_waq); + ("waq-mstdn-13", Waq_mstdn_13_v2_search.f); + *) + ("waq-1", Waq_1.f); + ("waq-2", Waq_2_ws.f); + ("waq-3", Waq_3.f); + ("waq-4", Waq_4_reblog.f); + ("waq-5", Waq_5_fav.f); + ("waq-6", Waq_6_rel.f); + ("waq-7", Waq_7_reblog.f); + ("waq-8", Waq_8_delete.f); + (*("waq-9", Waq_9_ap.f);*) + ("waq-10", Waq_10_mention.f); + ("waq-11", Waq_11_marker.f); + (* + (* ********** *) + ("01-mention-waq-mstdn-waq", Waq_mstdn_11_mention.f_waq_mstdn_waq); + ("01-mention-mstdn-waq-waq", Waq_mstdn_11_mention.f_mstdn_waq_waq); + ("01-mention-waq-waq-waq", Waq_mstdn_11_mention.f_waq_waq_waq); + ("01-mention-mstdn-waq-mstdn", Waq_mstdn_11_mention.f_mstdn_waq_mstdn); + ("02-summary-mstdn-waq", Waq_mstdn_12_summary.f_mstdn_waq); + ("02-summary-waq-mstdn", Waq_mstdn_12_summary.f_waq_mstdn); + ("02-summary-waq-waq", Waq_mstdn_12_summary.f_waq_waq); + ("03-preview-card-waq-waq", Waq_mstdn_14_preview_card.f_waq_waq); + ("03-preview-card-mstdn-waq", Waq_mstdn_14_preview_card.f_mstdn_waq); + ("04-text-waq-waq", Waq_mstdn_15_text.f_waq_waq); + ("04-text-waq-mstdn", Waq_mstdn_15_text.f_waq_mstdn); + ("04-text-mstdn-waq", Waq_mstdn_15_text.f_mstdn_waq); + ("06-cred-waq-waq", Waq_mstdn_16_cred.f_waq_waq); + ("06-cred-waq-mstdn", Waq_mstdn_16_cred.f_waq_mstdn); + ("06-cred-mstdn-waq", Waq_mstdn_16_cred.f_mstdn_waq); + *) + ] + +let execute_one_test (name, f) = + Logq.debug (fun m -> m "===== Testcase %s =====" name); + try f () + with e -> + Logq.err (fun m -> m "!!!!! !!!!! !!!!! !!!!!"); + Logq.err (fun m -> m "Testcase %s failed: %s" name (Printexc.to_string e)); + Logq.err (fun m -> m "!!!!! !!!!! !!!!! !!!!!"); + raise e + +let () = + print_newline (); + Logq.(add_reporter (make_reporter ~l:Debug ())); + Random.self_init (); + + let shuffle d = + (* Thanks to: https://stackoverflow.com/a/15095713 *) + let nd = List.map (fun c -> (Random.bits (), c)) d in + let sond = List.sort compare nd in + List.map snd sond + in + let chosen_tests = + match Sys.argv with + | [| _ |] -> shuffle all_tests + | _ -> + Sys.argv |> Array.to_list |> List.tl + |> List.map (fun name -> (name, List.assoc name all_tests)) + in + + Logq.info (fun m -> + chosen_tests |> List.map fst |> String.concat " " + |> m "[e2e] Chosen tests: %s"); + + chosen_tests |> List.iter execute_one_test diff --git a/e2e/src/waq_1.ml b/e2e/src/waq_1.ml new file mode 100644 index 0000000..140692e --- /dev/null +++ b/e2e/src/waq_1.ml @@ -0,0 +1,52 @@ +open Common + +let f = + make_waq_scenario @@ fun _token -> + let%lwt access_token = fetch_access_token ~username:"user1" in + + let%lwt r = + fetch_exn + ~headers:[ (`Authorization, "Bearer " ^ access_token) ] + (waq "/api/v1/apps/verify_credentials") + in + assert ( + match Yojson.Safe.from_string r with + | `Assoc l -> l |> List.assoc "name" |> expect_string = "foo" + | _ -> false); + + let%lwt r = + fetch_exn + ~headers:[ (`Authorization, "Bearer " ^ access_token) ] + (waq "/api/v1/accounts/verify_credentials") + in + let l = Yojson.Safe.from_string r |> expect_assoc in + assert (l |> List.assoc "username" |> expect_string = "user1"); + assert (l |> List.assoc "acct" |> expect_string = "user1"); + assert ( + l |> List.assoc "display_name" |> expect_string = "User 1's display name"); + assert ( + l |> List.assoc "source" |> expect_assoc |> List.assoc "privacy" + |> expect_string = "public"); + let account_id = l |> List.assoc "id" |> expect_string in + + let%lwt r = fetch_exn (waq "/api/v1/instance") in + let l = Yojson.Safe.from_string r |> expect_assoc in + assert (l |> List.mem_assoc "uri"); + + let%lwt r = get_account `Waq account_id in + assert (r.id = account_id); + assert (r.username = "user1"); + assert (r.acct = "user1"); + assert (r.last_status_at = None); + assert (r.statuses_count = 0); + assert (r.followers_count = 0); + assert (r.following_count = 0); + + let%lwt a = + update_credentials `Waq ~token:access_token ~display_name:"mod user1" () + in + assert (a.display_name = "mod user1"); + let%lwt a = get_account `Waq account_id in + assert (a.display_name = "mod user1"); + + Lwt.return_unit diff --git a/e2e/src/waq_10_mention.ml b/e2e/src/waq_10_mention.ml new file mode 100644 index 0000000..d08edd8 --- /dev/null +++ b/e2e/src/waq_10_mention.ml @@ -0,0 +1,28 @@ +open Common + +let f = + make_waq_scenario @@ fun token -> + let%lwt user1_id, _, _ = lookup `Waq ~token ~username:"user1" () in + let%lwt token2 = fetch_access_token ~username:"user2" in + let%lwt { id; _ } = post `Waq ~token ~content:"@user2 てすと" () in + + let%lwt ntfs = get_notifications `Waq ~token:token2 in + (match ntfs with + | [ + { + typ = "mention"; + account = { id = account_id; _ }; + status = Some { id = status_id; _ }; + _; + }; + ] -> + assert (account_id = user1_id); + assert (status_id = id); + Lwt.return_unit + | _ -> assert false);%lwt + + (* Handle invalid mentions correctly *) + let%lwt _ = post `Waq ~token ~content:"@not_found_user test" () in + home_timeline `Waq ~token |> ignore_lwt;%lwt + + Lwt.return_unit diff --git a/e2e/src/waq_11_marker.ml b/e2e/src/waq_11_marker.ml new file mode 100644 index 0000000..745f281 --- /dev/null +++ b/e2e/src/waq_11_marker.ml @@ -0,0 +1,18 @@ +open Common + +let f = + make_waq_scenario @@ fun token -> + let%lwt Some { last_read_id = "0"; _ }, Some { last_read_id = "0"; _ } = + get_markers ~token `Waq [ "home"; "notifications" ] + in + let%lwt Some { last_read_id = "1"; _ }, None = + post_markers ~token `Waq [ ("home", "1") ] + in + let%lwt None, Some { last_read_id = "2"; _ } = + post_markers ~token `Waq [ ("notifications", "2") ] + in + let%lwt Some { last_read_id = "1"; _ }, Some { last_read_id = "2"; _ } = + get_markers ~token `Waq [ "home"; "notifications" ] + in + Lwt.return_unit + [@@warning "-8"] diff --git a/e2e/src/waq_2_ws.ml b/e2e/src/waq_2_ws.ml new file mode 100644 index 0000000..6625441 --- /dev/null +++ b/e2e/src/waq_2_ws.ml @@ -0,0 +1,37 @@ +open Common + +let f = + make_waq_scenario @@ fun waq_token -> + let got_uri = ref None in + let set_current_state, handler = + websocket_handler_state_machine ~init:`Init + ~states: + [ + (`Init, fun _ -> assert false); + ( `Recv, + fun l pushf -> + assert (List.assoc "stream" l = `List [ `String "user" ]); + assert (List.assoc "event" l |> expect_string = "update"); + let payload = List.assoc "payload" l |> expect_string in + let uri = + let l = Yojson.Safe.from_string payload |> expect_assoc in + List.assoc "uri" l |> expect_string + in + got_uri := Some uri; + pushf None;%lwt + Lwt.return `End ); + (`End, fun _ -> assert false); + ] + () + in + + let expected_uri = ref None in + let mtx = Lwt_mutex.create () in + websocket ~mtx `Waq ~token:waq_token handler (fun _pushf -> + let%lwt { uri; _ } = post `Waq ~token:waq_token () in + expected_uri := Some uri; + set_current_state `Recv; + Lwt.return_unit);%lwt + + assert (Option.get !got_uri = Option.get !expected_uri); + Lwt.return_unit diff --git a/e2e/src/waq_3.ml b/e2e/src/waq_3.ml new file mode 100644 index 0000000..bb88f31 --- /dev/null +++ b/e2e/src/waq_3.ml @@ -0,0 +1,78 @@ +open Common + +let f = + make_waq_scenario @@ fun waq_token -> + let%lwt waq_token' = fetch_access_token ~username:"user2" in + let%lwt user1_id, _, _ = lookup `Waq ~token:waq_token ~username:"user1" () in + let%lwt user2_id, _, _ = lookup `Waq ~token:waq_token ~username:"user2" () in + + (* Follow @user2 *) + follow `Waq ~token:waq_token user2_id;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Post by @user2 *) + let%lwt { uri; id; _ } = post `Waq ~token:waq_token' () in + + (* check accounts *) + let%lwt a = get_account `Waq user2_id in + assert (a.statuses_count = 1); + + (* Reply by me *) + let%lwt { uri = uri2; id = id2; _ } = + post `Waq ~token:waq_token ~in_reply_to_id:id () + in + + (* check accounts *) + let%lwt a = get_account `Waq user1_id in + assert (a.statuses_count = 1); + + (* Reply again *) + let%lwt { uri = uri3; _ } = + post `Waq ~token:waq_token ~in_reply_to_id:id2 () + in + + (* Get my home timeline and check *) + (home_timeline `Waq ~token:waq_token >|= function + | [ `Assoc l3; `Assoc l2; `Assoc l ] -> + (* Check if the timeline is correct *) + assert (uri = (l |> List.assoc "uri" |> expect_string)); + assert (id = (l2 |> List.assoc "in_reply_to_id" |> expect_string)); + assert (uri2 = (l2 |> List.assoc "uri" |> expect_string)); + assert (id2 = (l3 |> List.assoc "in_reply_to_id" |> expect_string)); + assert (uri3 = (l3 |> List.assoc "uri" |> expect_string)); + () + | _ -> assert false);%lwt + + (* Unfollow @user2 *) + unfollow `Waq ~token:waq_token user2_id;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Get my home timeline and check again *) + (home_timeline `Waq ~token:waq_token >|= function + | [ `Assoc l3; `Assoc l2 ] -> + (* Check if the timeline is correct *) + assert (uri2 = (l2 |> List.assoc "uri" |> expect_string)); + assert (uri3 = (l3 |> List.assoc "uri" |> expect_string)); + () + | _ -> assert false);%lwt + + (* Check status itself *) + let%lwt s = get_status `Waq id in + assert (s.uri = uri); + + (* Check the status's context *) + let%lwt ancestors, descendants = get_status_context `Waq id2 in + assert (ancestors |> List.map (fun r -> r.uri) = [ uri ]); + assert (descendants |> List.map (fun r -> r.uri) = [ uri3 ]); + + (* Check account's statuses *) + let%lwt statuses = get_account_statuses `Waq user1_id in + assert ([ uri3; uri2 ] = (statuses |> List.map (fun s -> s.uri))); + let%lwt statuses = get_account_statuses `Waq ~exclude_replies:true user1_id in + assert (statuses = []); + let%lwt statuses = get_account_statuses `Waq user2_id in + assert ([ uri ] = (statuses |> List.map (fun s -> s.uri))); + let%lwt statuses = get_account_statuses `Waq ~exclude_replies:true user2_id in + assert ([ uri ] = (statuses |> List.map (fun s -> s.uri))); + + Lwt.return_unit diff --git a/e2e/src/waq_4_reblog.ml b/e2e/src/waq_4_reblog.ml new file mode 100644 index 0000000..8f44127 --- /dev/null +++ b/e2e/src/waq_4_reblog.ml @@ -0,0 +1,61 @@ +open Common + +let f = + make_waq_scenario @@ fun token -> + let expected_ids = ref [] in + let%lwt ws_recv_msgs = + websocket_stack `Waq ~token @@ fun _pushf -> + let%lwt { id = id1; reblog = None; reblogged = false; reblogs_count = 0; _ } + = + post `Waq ~token ~content:"Hello world" () + in + let%lwt { + id = id2; + reblogged = true; + reblog = Some { id = id1'; reblogged = true; reblog = None; _ }; + _; + } = + reblog `Waq ~token ~id:id1 + in + let%lwt { id = id2'; reblog = Some { id = id1''; _ }; _ } = + reblog `Waq ~token ~id:id1 + in + let%lwt { id = id2''; reblog = Some { id = id1'''; _ }; _ } = + reblog `Waq ~token ~id:id2 + in + assert (id1 = id1' && id1 = id1'' && id1 = id1'''); + assert (id2 = id2' && id2 = id2''); + expected_ids := [ id1; id2 ]; + + let%lwt { reblogs_count; _ } = get_status `Waq ~token id1 in + assert (reblogs_count = 1); + + Lwt.return_unit + in + + let ws_recv_msgs = + ws_recv_msgs |> List.map (Yojson.Safe.from_string |.> expect_assoc) + in + let ws_recv_ids, ws_recv_notfs = + ws_recv_msgs + |> List.fold_left + (fun (ws_recv_ids, ws_recv_notfs) l -> + let payload = + List.assoc "payload" l |> expect_string |> Yojson.Safe.from_string + in + match (List.assoc "stream" l, List.assoc "event" l) with + | `List [ `String "user" ], `String "update" -> + let s = payload |> status_of_yojson in + (s.id :: ws_recv_ids, ws_recv_notfs) + | `List [ `String "user" ], `String "notification" -> + let n = payload |> notification_of_yojson in + (ws_recv_ids, n :: ws_recv_notfs) + | _ -> (ws_recv_ids, ws_recv_notfs)) + ([], []) + in + + assert (List.sort compare !expected_ids = List.sort compare ws_recv_ids); + assert (ws_recv_notfs = []); + + Lwt.return_unit + [@@warning "-8"] diff --git a/e2e/src/waq_5_fav.ml b/e2e/src/waq_5_fav.ml new file mode 100644 index 0000000..fb1ed3d --- /dev/null +++ b/e2e/src/waq_5_fav.ml @@ -0,0 +1,67 @@ +open Common + +let f = + make_waq_scenario @@ fun token -> + let%lwt user1_id, _, _ = lookup `Waq ~token ~username:"user1" () in + let%lwt user2_id, _, _ = lookup `Waq ~token ~username:"user2" () in + let%lwt user3_id, _, _ = lookup `Waq ~token ~username:"user3" () in + let%lwt token2 = fetch_access_token ~username:"user2" in + let%lwt token3 = fetch_access_token ~username:"user3" in + + let%lwt { id; _ } = post `Waq ~token () in + let%lwt { favourited; _ } = fav `Waq ~token ~id in + assert favourited; + let%lwt { favourited; _ } = fav `Waq ~token:token2 ~id in + assert favourited; + let%lwt { favourited; favourites_count; _ } = fav `Waq ~token:token3 ~id in + assert favourited; + assert (favourites_count = 3); + + let%lwt l = get_favourited_by `Waq ~token ~id in + assert (List.length l = 3); + assert ( + l |> List.find_opt (fun (a : account) -> a.id = user1_id) |> Option.is_some); + assert ( + l |> List.find_opt (fun (a : account) -> a.id = user2_id) |> Option.is_some); + assert ( + l |> List.find_opt (fun (a : account) -> a.id = user3_id) |> Option.is_some); + + (match%lwt get_notifications `Waq ~token with + | [ + { + typ = "favourite"; + account = { id = account_id3; _ }; + status = Some { id = status_id3; _ }; + _; + }; + { + typ = "favourite"; + account = { id = account_id2; _ }; + status = Some { id = status_id2; _ }; + _; + }; + ] -> + assert (account_id3 = user3_id); + assert (account_id2 = user2_id); + assert (status_id3 = id); + assert (status_id2 = id); + Lwt.return_unit + | _ -> assert false);%lwt + + let%lwt { favourited; _ } = unfav `Waq ~token ~id in + assert (not favourited); + let%lwt { favourited; _ } = unfav `Waq ~token:token2 ~id in + assert (not favourited); + let%lwt { favourited; favourites_count; _ } = unfav `Waq ~token:token3 ~id in + assert (not favourited); + assert (favourites_count = 0); + + (match%lwt get_favourited_by `Waq ~token ~id with + | [] -> Lwt.return_unit + | _ -> assert false);%lwt + + (match%lwt get_notifications `Waq ~token with + | [] -> Lwt.return_unit + | _ -> assert false);%lwt + + Lwt.return_unit diff --git a/e2e/src/waq_6_rel.ml b/e2e/src/waq_6_rel.ml new file mode 100644 index 0000000..03ef7f5 --- /dev/null +++ b/e2e/src/waq_6_rel.ml @@ -0,0 +1,158 @@ +open Common + +let expect_followers account_id expected_follower_ids = + let%lwt l = get_followers `Waq account_id in + let got = l |> List.map (fun (a : account) -> a.id) in + assert (got = expected_follower_ids); + Lwt.return_unit + +let expect_following account_id expected_follower_ids = + let%lwt l = get_following `Waq account_id in + let got = l |> List.map (fun (a : account) -> a.id) in + assert (got = expected_follower_ids); + Lwt.return_unit + +let f = + make_waq_scenario @@ fun token -> + (* Connect WebSocket *) + let%lwt ws_recv_msgs = + websocket_stack `Waq ~token @@ fun _pushf -> + let%lwt token' = fetch_access_token ~username:"user2" in + let%lwt user1_id, _, _ = lookup `Waq ~token:token' ~username:"user1" () in + let%lwt user2_id, _, _ = lookup `Waq ~token ~username:"user2" () in + let%lwt user3_id, _, _ = lookup `Waq ~token ~username:"user3" () in + + (* user1: Try to follow myself, which should be forbidden *) + (try%lwt + follow `Waq ~token user1_id;%lwt + assert false + with Httpq.Client.FetchFailure (Some (`Forbidden, _, _)) -> + Lwt.return_unit);%lwt + + (* user1: Follow @user2 *) + follow `Waq ~token user2_id;%lwt + expect_followers user2_id [ user1_id ];%lwt + expect_following user1_id [ user2_id ];%lwt + + (* user1: check relationship *) + (match%lwt get_relationships `Waq ~token [ user2_id; user3_id ] with + | [ rel2; rel3 ] -> + assert (rel2.id = user2_id); + assert (rel3.id = user3_id); + assert rel2.following; + assert (not rel2.followed_by); + Lwt.return_unit + | _ -> assert false);%lwt + + (* check accounts *) + let%lwt a = get_account `Waq user1_id in + assert (a.followers_count = 0); + assert (a.following_count = 1); + let%lwt a = get_account `Waq user2_id in + assert (a.followers_count = 1); + assert (a.following_count = 0); + + (* check notifications *) + (match%lwt get_notifications `Waq ~token:token' with + | [ { typ = "follow"; account = a; _ } ] -> + assert (a.id = user1_id); + Lwt.return_unit + | _ -> assert false);%lwt + + (* user2: follow @user1 *) + follow `Waq ~token:token' user1_id;%lwt + expect_followers user1_id [ user2_id ];%lwt + expect_following user2_id [ user1_id ];%lwt + + (* user1: check relationship *) + (match%lwt get_relationships `Waq ~token [ user2_id ] with + | [ rel ] -> + assert (rel.id = user2_id); + assert rel.following; + assert rel.followed_by; + Lwt.return_unit + | _ -> assert false);%lwt + + (* check accounts *) + let%lwt a = get_account `Waq user1_id in + assert (a.followers_count = 1); + assert (a.following_count = 1); + let%lwt a = get_account `Waq user2_id in + assert (a.followers_count = 1); + assert (a.following_count = 1); + + (* check notifications *) + (match%lwt get_notifications `Waq ~token with + | [ { typ = "follow"; account = a; _ } ] -> + assert (a.id = user2_id); + Lwt.return_unit + | _ -> assert false);%lwt + + (* user1: Unfollow @user2 *) + unfollow `Waq ~token user2_id;%lwt + expect_followers user2_id [];%lwt + expect_following user1_id [];%lwt + + (* user1: check relationship *) + (match%lwt get_relationships `Waq ~token [ user2_id ] with + | [ rel ] -> + assert (rel.id = user2_id); + assert (not rel.following); + assert rel.followed_by; + Lwt.return_unit + | _ -> assert false);%lwt + + (* check accounts *) + let%lwt a = get_account `Waq user1_id in + assert (a.followers_count = 1); + assert (a.following_count = 0); + let%lwt a = get_account `Waq user2_id in + assert (a.followers_count = 0); + assert (a.following_count = 1); + + (* user2: Unfollow @user1 *) + unfollow `Waq ~token:token' user1_id;%lwt + expect_followers user1_id [];%lwt + expect_following user2_id [];%lwt + + (* user1: check relationship *) + (match%lwt get_relationships `Waq ~token [ user2_id ] with + | [ rel ] -> + assert (rel.id = user2_id); + assert (not rel.following); + assert (not rel.followed_by); + Lwt.return_unit + | _ -> assert false);%lwt + + (* check accounts *) + let%lwt a = get_account `Waq user1_id in + assert (a.followers_count = 0); + assert (a.following_count = 0); + let%lwt a = get_account `Waq user2_id in + assert (a.followers_count = 0); + assert (a.following_count = 0); + + Lwt.return_unit + in + + let ws_notifications = + ws_recv_msgs + |> List.map (Yojson.Safe.from_string |.> expect_assoc) + |> List.filter_map (fun (l : (string * Yojson.Safe.t) list) -> + if + List.assoc "stream" l = `List [ `String "user" ] + && List.assoc "event" l = `String "notification" + then + Some + (List.assoc "payload" l |> expect_string + |> Yojson.Safe.from_string |> notification_of_yojson) + else None) + in + let%lwt got_notifications = get_notifications `Waq ~token in + assert ( + got_notifications + |> List.map (fun r -> r.id) + |> List.sort compare + = (ws_notifications |> List.map (fun r -> r.id) |> List.sort compare)); + + Lwt.return_unit diff --git a/e2e/src/waq_7_reblog.ml b/e2e/src/waq_7_reblog.ml new file mode 100644 index 0000000..22325c2 --- /dev/null +++ b/e2e/src/waq_7_reblog.ml @@ -0,0 +1,47 @@ +open Common + +let f = + make_waq_scenario @@ fun token -> + let%lwt user2_id, _, _ = lookup `Waq ~token ~username:"user2" () in + let%lwt token2 = fetch_access_token ~username:"user2" in + let%lwt token3 = fetch_access_token ~username:"user3" in + let%lwt { id; _ } = post `Waq ~token () in + let%lwt _ = reblog `Waq ~token ~id in + let%lwt _ = reblog `Waq ~token:token2 ~id in + + let%lwt ntfs = get_notifications `Waq ~token in + (match ntfs with + | [ + { + typ = "reblog"; + account = { id = account_id2; _ }; + status = Some { id = status_id2; reblogs_count; _ }; + _; + }; + ] -> + assert (account_id2 = user2_id); + assert (status_id2 = id); + assert (reblogs_count = 2); + Lwt.return_unit + | _ -> assert false);%lwt + + (* Wrong unreblog *) + expect_exc_lwt (fun () -> unreblog `Waq ~token:token3 ~id);%lwt + let%lwt { reblogs_count; _ } = get_status `Waq ~token id in + assert (reblogs_count = 2); + + (* Actual unreblogs *) + let%lwt { id = unreblog_id; reblogs_count; reblogged; _ } = + unreblog `Waq ~token:token2 ~id + in + assert (unreblog_id = id); + assert (reblogs_count = 1); + assert (not reblogged); + let%lwt { id = unreblog_id; reblogs_count; reblogged; _ } = + unreblog `Waq ~token ~id + in + assert (unreblog_id = id); + assert (reblogs_count = 0); + assert (not reblogged); + + Lwt.return_unit diff --git a/e2e/src/waq_8_delete.ml b/e2e/src/waq_8_delete.ml new file mode 100644 index 0000000..1134114 --- /dev/null +++ b/e2e/src/waq_8_delete.ml @@ -0,0 +1,49 @@ +open Common + +let expect_no_status kind id = + try%lwt + get_status kind id |> ignore_lwt;%lwt + assert false + with Httpq.Client.FetchFailure (Some (`Not_found, _, _)) -> Lwt.return_unit + +let f = + make_waq_scenario @@ fun token -> + let%lwt token' = fetch_access_token ~username:"user2" in + let%lwt ws_recv_msgs = + websocket_stack `Waq ~token @@ fun _pushf -> + let%lwt { id; _ } = post `Waq ~token () in + let%lwt s = get_status `Waq id in + assert (s.id = id); + + (* Wrong delete *) + expect_exc_lwt (fun () -> delete_status `Waq ~token:token' id);%lwt + (* Should remain *) + get_status `Waq id |> ignore_lwt;%lwt + + (* Actual delete *) + let%lwt s = delete_status `Waq ~token id in + assert (s.id = id); + expect_no_status `Waq id;%lwt + + let%lwt { id; _ } = post `Waq ~token () in + let%lwt s = reblog `Waq ~token ~id in + delete_status `Waq ~token id |> ignore_lwt;%lwt + expect_no_status `Waq id;%lwt + expect_no_status `Waq s.id;%lwt + + Lwt.return_unit + in + let ws_delete_events = + ws_recv_msgs + |> List.map (Yojson.Safe.from_string |.> expect_assoc) + |> List.filter_map (fun (l : (string * Yojson.Safe.t) list) -> + if + List.assoc "stream" l = `List [ `String "user" ] + && List.assoc "event" l = `String "delete" + then Some (List.assoc "payload" l |> expect_string) + else None) + in + assert ( + List.sort compare ws_delete_events = List.sort compare [ "1"; "2"; "3" ]); + + Lwt.return_unit diff --git a/e2e/src/waq_9_ap.ml b/e2e/src/waq_9_ap.ml new file mode 100644 index 0000000..0ac8d30 --- /dev/null +++ b/e2e/src/waq_9_ap.ml @@ -0,0 +1,29 @@ +open Common + +let f = + make_waq_scenario @@ fun _token -> + let%lwt r = fetch_exn (waq "/users/user1/outbox") in + let l = Yojson.Safe.from_string r |> expect_assoc in + assert (List.assoc "type" l |> expect_string = "OrderedCollection"); + assert (List.assoc "totalItems" l |> expect_int = 0); + assert ( + List.assoc "first" l |> expect_string = waq "/users/user1/outbox?page=true"); + assert ( + List.assoc "last" l |> expect_string + = waq "/users/user1/outbox?min_id=0&page=true"); + + let%lwt r = fetch_exn (waq "/users/user1/following") in + let l = Yojson.Safe.from_string r |> expect_assoc in + assert (List.assoc "type" l |> expect_string = "OrderedCollection"); + assert (List.assoc "totalItems" l |> expect_int = 0); + assert ( + List.assoc "first" l |> expect_string = waq "/users/user1/following?page=1"); + + let%lwt r = fetch_exn (waq "/users/user1/followers") in + let l = Yojson.Safe.from_string r |> expect_assoc in + assert (List.assoc "type" l |> expect_string = "OrderedCollection"); + assert (List.assoc "totalItems" l |> expect_int = 0); + assert ( + List.assoc "first" l |> expect_string = waq "/users/user1/followers?page=1"); + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_1.ml b/e2e/src/waq_mstdn_1.ml new file mode 100644 index 0000000..7684b9e --- /dev/null +++ b/e2e/src/waq_mstdn_1.ml @@ -0,0 +1,78 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Connect WebSocket *) + let ws_statuses = ref [] in + let _set_current_state, handler = + websocket_handler_state_machine ~init:`Recv + ~states: + [ + ( `Recv, + fun l _pushf -> + assert (List.assoc "stream" l = `List [ `String "user" ]); + assert (List.assoc "event" l |> expect_string = "update"); + let payload = List.assoc "payload" l |> expect_string in + ws_statuses := + (Yojson.Safe.from_string payload |> expect_assoc) + :: !ws_statuses; + Lwt.return `Recv ); + ] + () + in + let uris = ref [] in + websocket `Waq ~token:waq_token handler (fun pushf -> + (* Lookup @admin@localhost:3000 *) + let%lwt admin_id, username, acct = + lookup `Waq ~token:waq_token ~username:"admin" ~domain:"localhost:3000" + () + in + assert (username = "admin"); + assert (acct = "admin@localhost:3000"); + + (* Follow @admin@localhost:3000 *) + follow `Waq ~token:waq_token admin_id;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Post by @admin@localhost:3000 *) + let%lwt { uri; _ } = post `Mstdn ~token:mstdn_token () in + uris := uri :: !uris; + Lwt_unix.sleep 1.0;%lwt + + (* Post by me *) + let%lwt { uri = uri2; _ } = post `Waq ~token:waq_token () in + uris := uri2 :: !uris; + Lwt_unix.sleep 1.0;%lwt + + (* Get my home timeline and check *) + (home_timeline `Waq ~token:waq_token >|= function + | [ `Assoc l2; `Assoc l ] -> + (* Check if the timeline is correct *) + assert (uri = (l |> List.assoc "uri" |> expect_string)); + assert (uri2 = (l2 |> List.assoc "uri" |> expect_string)); + () + | _ -> assert false);%lwt + + (* Unfollow @admin@localhost:3000 *) + unfollow `Waq ~token:waq_token admin_id;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Get my home timeline and check again *) + (home_timeline `Waq ~token:waq_token >|= function + | [ `Assoc l2 ] -> + (* Check if the timeline is correct *) + assert (uri2 = (l2 |> List.assoc "uri" |> expect_string)); + () + | _ -> assert false);%lwt + + pushf None);%lwt + + let expected_uris = List.sort compare !uris in + let got_uris = + !ws_statuses + |> List.map (fun s -> s |> List.assoc "uri" |> expect_string) + |> List.sort compare + in + assert (expected_uris = got_uris); + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_10_attachment.ml b/e2e/src/waq_mstdn_10_attachment.ml new file mode 100644 index 0000000..deaa751 --- /dev/null +++ b/e2e/src/waq_mstdn_10_attachment.ml @@ -0,0 +1,76 @@ +open Common2 + +let f (a0 : agent) (a1 : agent) = + (* a0: Follow a1 *) + follow_agent a0 a1;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* a1: Post with attachments *) + let%lwt { id = media_id; _ } = + upload_media a1 ~filename:"test0.png" ~data:test_image + ~content_type:"image/png" + in + let%lwt { id = media_id2; _ } = + upload_media a1 ~filename:"test1.png" ~data:test_image + ~content_type:"image/png" + in + let%lwt { uri; media_attachments; _ } = + post a1 ~media_ids:[ media_id; media_id2 ] () + in + assert ( + media_attachments + |> List.map (fun (a : media_attachment) -> a.id) + = [ media_id; media_id2 ]); + Lwt_unix.sleep 1.0;%lwt + + (* a0: Get the post *) + let%lwt a0_post = + match%lwt search a0 uri with + | _, [ s ], _ -> Lwt.return s + | _ -> assert false + in + + (* a0: Check the post *) + let ats = a0_post.media_attachments in + assert (List.length ats = 2); + assert (ats |> List.for_all (fun (a : media_attachment) -> a.type_ = "image")); + + Lwt.return_unit + +let f_waq_mstdn = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + f a0 a1;%lwt + Lwt.return_unit + +let f_mstdn_waq = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + let a1 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit + +let f_waq_waq = + make_waq_scenario @@ fun token -> + let%lwt token2 = fetch_access_token ~username:"user2" in + let a0 = + make_agent ~kind:`Waq ~token ~username:"user1" ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Waq ~token:token2 ~username:"user2" + ~domain:waq_server_domain + in + f a0 a1 diff --git a/e2e/src/waq_mstdn_11_mention.ml b/e2e/src/waq_mstdn_11_mention.ml new file mode 100644 index 0000000..a6584ad --- /dev/null +++ b/e2e/src/waq_mstdn_11_mention.ml @@ -0,0 +1,65 @@ +open Common2 + +let f (a0 : agent) (a1 : agent) (a2 : agent) = + (* a0: Post with mentions *) + let%lwt { uri; _ } = + post a0 + ~content: + (Printf.sprintf "@%s @%s てすと" + (acct_of_agent ~from:a0 a1) + (acct_of_agent ~from:a0 a2)) + () + in + Lwt_unix.sleep 10.0;%lwt + + (* a1: Check home timeline, which should be empty *) + let%lwt [] = home_timeline a1 in + + (* a2: Check home timeline, which should be empty *) + let%lwt [] = home_timeline a2 in + + (* a1: Check its notification *) + let%lwt [ n ] = + get_notifications a1 + >|= List.filter (fun (n : notification) -> n.typ = "mention") + in + assert ((Option.get n.status).uri = uri); + assert (n.account.acct = acct_of_agent ~from:a1 a0); + assert (List.length (Option.get n.status).mentions = 2); + + (* a2: Check its notification *) + let%lwt [ n ] = get_notifications a2 in + assert ((Option.get n.status).uri = uri); + assert (n.account.acct = acct_of_agent ~from:a2 a0); + assert (List.length (Option.get n.status).mentions = 2); + + Lwt.return_unit + [@@warning "-8"] + +let f_waq_mstdn_waq () = + launch_waq_and_mstdn @@ fun ctxt -> + let a0 = generate_waq_agent ctxt in + let a1 = generate_mstdn_agent ctxt in + let a2 = generate_waq_agent ctxt in + f a0 a1 a2 + +let f_mstdn_waq_waq () = + launch_waq_and_mstdn @@ fun ctxt -> + let a0 = generate_mstdn_agent ctxt in + let a1 = generate_waq_agent ctxt in + let a2 = generate_waq_agent ctxt in + f a0 a1 a2 + +let f_waq_waq_waq () = + launch_waq @@ fun ctxt -> + let a0 = generate_waq_agent ctxt in + let a1 = generate_waq_agent ctxt in + let a2 = generate_waq_agent ctxt in + f a0 a1 a2 + +let f_mstdn_waq_mstdn () = + launch_waq_and_mstdn @@ fun ctxt -> + let a0 = generate_mstdn_agent ctxt in + let a1 = generate_waq_agent ctxt in + let a2 = generate_mstdn_agent ctxt in + f a0 a1 a2 diff --git a/e2e/src/waq_mstdn_12_summary.ml b/e2e/src/waq_mstdn_12_summary.ml new file mode 100644 index 0000000..948799c --- /dev/null +++ b/e2e/src/waq_mstdn_12_summary.ml @@ -0,0 +1,53 @@ +open Common2 + +let f (a0 : agent) (a1 : agent) = + let spoiler_text = "すぽいらーてきすと" in + + (* a0: Post with summary (spoiler_text) *) + let%lwt { uri; _ } = post a0 ~spoiler_text () in + + (* a1: Check the post by lookup *) + let%lwt _, [ s ], _ = search a1 uri in + assert (s.spoiler_text = spoiler_text); + + Lwt.return_unit + [@@warning "-8"] + +let f_mstdn_waq = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + let a1 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit + +let f_waq_mstdn = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + f a0 a1;%lwt + Lwt.return_unit + +let f_waq_waq = + make_waq_scenario @@ fun token -> + let%lwt token2 = fetch_access_token ~username:"user2" in + let a0 = + make_agent ~kind:`Waq ~token ~username:"user1" ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Waq ~token:token2 ~username:"user2" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_13_v2_search.ml b/e2e/src/waq_mstdn_13_v2_search.ml new file mode 100644 index 0000000..30c98cb --- /dev/null +++ b/e2e/src/waq_mstdn_13_v2_search.ml @@ -0,0 +1,22 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token _mstdn_token -> + (* Lookup @user1 *) + (match%lwt search `Waq "@user1" with + | [ a ], _, _ -> + assert (a.acct = "user1"); + Lwt.return_unit + | _ -> assert false);%lwt + + (* Lookup @admin@localhost:3000 without token, which should fail *) + (match%lwt search `Waq "@admin@localhost:3000" with + | [], _, _ -> Lwt.return_unit + | _ -> assert false);%lwt + + (* With token, it will succeed *) + (match%lwt search `Waq ~token:waq_token "@admin@localhost:3000" with + | [ _ ], _, _ -> Lwt.return_unit + | _ -> assert false);%lwt + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_14_preview_card.ml b/e2e/src/waq_mstdn_14_preview_card.ml new file mode 100644 index 0000000..d010be3 --- /dev/null +++ b/e2e/src/waq_mstdn_14_preview_card.ml @@ -0,0 +1,57 @@ +open Common2 + +let get_preview_card_from_a1 (a0 : agent) (a1 : agent) content = + (* a1: Follow a0 *) + follow_agent a1 a0;%lwt + + (* a0: Post link *) + let%lwt { uri; _ } = post a0 ~content () in + Lwt_unix.sleep 2.0;%lwt + + (* a1: Check the post. The post should have been fetched in advance because a1 follows a0. *) + let%lwt _, [ s ], _ = search a1 uri in + Lwt.return s + [@@warning "-8"] + +let f_case1 (a0 : agent) (a1 : agent) = + let url = "https://www.youtube.com/watch?v=OMv_EPMED8Y" in + let%lwt s = get_preview_card_from_a1 a0 a1 url in + assert (Option.is_some s.card); + let c = Option.get s.card in + assert (c.url = url); + Lwt.return_unit + +let f_case2 (a0 : agent) (a1 : agent) = + let content = "@" ^ acct_of_agent ~from:a0 a1 in + let%lwt s = get_preview_card_from_a1 a0 a1 content in + assert (List.length s.mentions = 1); + assert (Option.is_none s.card); + Lwt.return_unit + +let f_mstdn_waq = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + let a1 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + f_case1 a0 a1;%lwt + f_case2 a0 a1;%lwt + Lwt.return_unit + +let f_waq_waq = + make_waq_scenario @@ fun token -> + let%lwt token2 = fetch_access_token ~username:"user2" in + let a0 = + make_agent ~kind:`Waq ~token ~username:"user1" ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Waq ~token:token2 ~username:"user2" + ~domain:waq_server_domain + in + f_case1 a0 a1;%lwt + f_case2 a0 a1;%lwt + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_15_text.ml b/e2e/src/waq_mstdn_15_text.ml new file mode 100644 index 0000000..a4342d1 --- /dev/null +++ b/e2e/src/waq_mstdn_15_text.ml @@ -0,0 +1,57 @@ +open Common2 + +let f (a0 : agent) (a1 : agent) = + let url = "https://www.youtube.com/watch?v=OMv_EPMED8Y" in + + (* a1: Follow a0 *) + follow_agent a1 a0;%lwt + + (* a0: Post link *) + let%lwt { uri; _ } = post a0 ~content:url () in + Lwt_unix.sleep 1.0;%lwt + + (* a1: Check the post. The post should have been fetched in advance because a1 follows a0. *) + let%lwt _, [ s ], _ = search a1 uri in + assert (List.length Soup.(parse (Option.get s.content) $$ "a" |> to_list) = 1); + + Lwt.return_unit + [@@warning "-8"] + +let f_mstdn_waq = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + let a1 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit + +let f_waq_mstdn = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + f a0 a1;%lwt + Lwt.return_unit + +let f_waq_waq = + make_waq_scenario @@ fun token -> + let%lwt token2 = fetch_access_token ~username:"user2" in + let a0 = + make_agent ~kind:`Waq ~token ~username:"user1" ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Waq ~token:token2 ~username:"user2" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_16_cred.ml b/e2e/src/waq_mstdn_16_cred.ml new file mode 100644 index 0000000..aec60e1 --- /dev/null +++ b/e2e/src/waq_mstdn_16_cred.ml @@ -0,0 +1,82 @@ +open Common2 + +let strip_html_tags s = Soup.(s |> parse |> texts |> String.concat "") + +let f (a0 : agent) (a1 : agent) = + (* a0: Follow a1 *) + follow_agent a0 a1;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* a1: Update display name *) + let modified_display_name = "modified display name" in + let%lwt a = update_credentials a1 ~display_name:modified_display_name () in + assert (a.display_name = modified_display_name); + + (* a1: Update credentials *) + assert (not a.bot); + let%lwt old_avatar_url, old_header_url = + search a0 (acct_of_agent ~from:a0 a1) >|= fun ([ a ], _, _) -> + (a.avatar, a.header) + in + let modified_note = "modified note" in + let modified_avatar = test_image in + let modified_header = test_image in + let modified_bot = true in + let%lwt a = + update_credentials a1 ~note:modified_note ~avatar:modified_avatar + ~header:modified_header ~bot:modified_bot () + in + assert (a.display_name = modified_display_name); + assert (strip_html_tags a.note = modified_note); + assert a.bot; + Lwt_unix.sleep 1.0;%lwt + + (* a0: Check a1's info *) + let%lwt [ a ], _, _ = search a0 (acct_of_agent ~from:a0 a1) in + assert (a.display_name = modified_display_name); + assert (strip_html_tags a.note = modified_note); + assert (a.avatar <> old_avatar_url); + assert (a.header <> old_header_url); + assert a.bot; + + Lwt.return_unit + [@@warning "-8"] + +let f_mstdn_waq = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + let a1 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit + +let f_waq_mstdn = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + f a0 a1;%lwt + Lwt.return_unit + +let f_waq_waq = + make_waq_scenario @@ fun token -> + let%lwt token2 = fetch_access_token ~username:"user2" in + let a0 = + make_agent ~kind:`Waq ~token ~username:"user1" ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Waq ~token:token2 ~username:"user2" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_2.ml b/e2e/src/waq_mstdn_2.ml new file mode 100644 index 0000000..bfe2e51 --- /dev/null +++ b/e2e/src/waq_mstdn_2.ml @@ -0,0 +1,55 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Lookup me from localhost:3000 *) + let%lwt aid, _, _ = + lookup `Mstdn ~token:mstdn_token ~username:"user1" ~domain:waq_server_domain + () + in + + (* Follow me from @admin@localhost:3000 *) + follow `Mstdn ~token:mstdn_token aid;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Check notifications *) + (match%lwt get_notifications `Waq ~token:waq_token with + | [ { typ = "follow"; account = a; _ } ] -> + let%lwt id, _, _ = + lookup `Waq ~token:waq_token ~username:"admin" ~domain:"localhost:3000" + () + in + assert (a.id = id); + Lwt.return_unit + | _ -> assert false);%lwt + + (* Post by @admin@localhost:3000 *) + let%lwt { uri; _ } = post `Mstdn ~token:mstdn_token () in + Lwt_unix.sleep 1.0;%lwt + + (* Post by me *) + let%lwt { uri = uri2; _ } = post `Waq ~token:waq_token () in + Lwt_unix.sleep 1.0;%lwt + + (* Get home timeline of @admin@localhost:3000 and check *) + (home_timeline `Mstdn ~token:mstdn_token >|= function + | [ `Assoc l2; `Assoc l ] -> + (* Check if the timeline is correct *) + assert (uri = (List.assoc "uri" l |> expect_string)); + assert (uri2 = (List.assoc "uri" l2 |> expect_string)); + () + | _ -> assert false);%lwt + + (* Unfollow me from @admin@localhost:3000 *) + unfollow `Mstdn ~token:mstdn_token aid;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Get home timeline of @admin@localhost:3000 and check again *) + (home_timeline `Mstdn ~token:mstdn_token >|= function + | [ `Assoc l ] -> + (* Check if the timeline is correct *) + assert (uri = (List.assoc "uri" l |> expect_string)); + () + | _ -> assert false);%lwt + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_3_reply.ml b/e2e/src/waq_mstdn_3_reply.ml new file mode 100644 index 0000000..1e6c931 --- /dev/null +++ b/e2e/src/waq_mstdn_3_reply.ml @@ -0,0 +1,73 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Lookup me from localhost:3000 *) + let%lwt aid, _, _ = + lookup `Mstdn ~token:mstdn_token ~username:"user1" ~domain:waq_server_domain + () + in + + (* Lookup @admin@localhost:3000 *) + let%lwt admin_id, _username, _acct = + lookup `Waq ~token:waq_token ~username:"admin" ~domain:"localhost:3000" () + in + + (* Follow @admin@localhost:3000 *) + follow `Waq ~token:waq_token admin_id;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Follow me from @admin@localhost:3000 *) + follow `Mstdn ~token:mstdn_token aid;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Post by me *) + let%lwt { uri; _ } = post `Waq ~token:waq_token () in + Lwt_unix.sleep 1.0;%lwt + + (* Get home timeline of @admin@localhost:3000 and obtain the status's id *) + let%lwt id = + home_timeline `Mstdn ~token:mstdn_token >|= function + | [ `Assoc l ] -> + (* Check if the timeline is correct *) + assert (uri = (List.assoc "uri" l |> expect_string)); + List.assoc "id" l |> expect_string + | _ -> assert false + in + + (* Reply by @admin@localhost:3000 *) + let%lwt { uri; _ } = post `Mstdn ~token:mstdn_token ~in_reply_to_id:id () in + Lwt_unix.sleep 1.0;%lwt + + (* Get home timeline of me and obtain the reply's id *) + let%lwt id = + home_timeline `Waq ~token:waq_token >|= function + | [ `Assoc l; `Assoc l2 ] -> + assert (uri = (List.assoc "uri" l |> expect_string)); + assert (List.assoc "id" l2 = List.assoc "in_reply_to_id" l); + assert ( + List.assoc "account" l2 |> expect_assoc |> List.assoc "id" + = List.assoc "in_reply_to_account_id" l); + List.assoc "id" l |> expect_string + | _ -> assert false + in + + (* Reply by me *) + let%lwt { uri; _ } = post `Waq ~token:waq_token ~in_reply_to_id:id () in + Lwt_unix.sleep 1.0;%lwt + + (* Get home timeline of @admin@localhost:3000 and check *) + let%lwt _ = + home_timeline `Mstdn ~token:mstdn_token >|= function + | [ `Assoc l; `Assoc l2; `Assoc _ ] -> + (* Check if the timeline is correct *) + assert (uri = (List.assoc "uri" l |> expect_string)); + assert (List.assoc "id" l2 = List.assoc "in_reply_to_id" l); + assert ( + List.assoc "account" l2 |> expect_assoc |> List.assoc "id" + = List.assoc "in_reply_to_account_id" l); + List.assoc "id" l |> expect_string + | _ -> assert false + in + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_4_reblog.ml b/e2e/src/waq_mstdn_4_reblog.ml new file mode 100644 index 0000000..9db8b2e --- /dev/null +++ b/e2e/src/waq_mstdn_4_reblog.ml @@ -0,0 +1,36 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Lookup me from localhost:3000 *) + let%lwt aid, _, _ = + lookup `Mstdn ~token:mstdn_token ~username:"user1" ~domain:waq_server_domain + () + in + + (* Follow me from @admin@localhost:3000 *) + follow `Mstdn ~token:mstdn_token aid;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Post by user2 *) + let%lwt waq_token' = fetch_access_token ~username:"user2" in + let%lwt { id; uri; _ } = post `Waq ~token:waq_token' () in + + (* Reblog by me (user1) *) + let%lwt _ = reblog `Waq ~token:waq_token ~id in + Lwt_unix.sleep 2.0;%lwt + + (* Get home timeline of @admin@localhost:3000 *) + let%lwt _ = + home_timeline `Mstdn ~token:mstdn_token >|= function + | [ `Assoc l ] -> + (* Check if the timeline is correct *) + let reblog_uri = + l |> List.assoc "reblog" |> expect_assoc |> List.assoc "uri" + |> expect_string + in + assert (uri = reblog_uri) + | _ -> assert false + in + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_5_reblog.ml b/e2e/src/waq_mstdn_5_reblog.ml new file mode 100644 index 0000000..e18cccf --- /dev/null +++ b/e2e/src/waq_mstdn_5_reblog.ml @@ -0,0 +1,51 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Lookup @admin@localhost:3000 *) + let%lwt admin_id, _username, _acct = + lookup `Waq ~token:waq_token ~username:"admin" ~domain:"localhost:3000" () + in + + (* Follow @admin@localhost:3000 *) + follow `Waq ~token:waq_token admin_id;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Post by user1 *) + let%lwt { uri; id = post_id; _ } = post `Waq ~token:waq_token () in + Lwt_unix.sleep 1.0;%lwt + + (* Reblog the post by @admin@locahost:3000 *) + (match%lwt search `Mstdn ~token:mstdn_token uri with + | _, [ status ], _ -> + reblog `Mstdn ~token:mstdn_token ~id:status.id |> ignore_lwt + | _ -> assert false);%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Check home timeline *) + (home_timeline `Waq ~token:waq_token >|= function + | [ `Assoc l1; `Assoc l2 ] -> + (* Check if the timeline is correct *) + assert (uri = (l2 |> List.assoc "uri" |> expect_string)); + assert ( + uri + = (l1 |> List.assoc "reblog" |> expect_assoc |> List.assoc "uri" + |> expect_string)); + () + | _ -> assert false);%lwt + + (* Check notifications *) + (get_notifications `Waq ~token:waq_token >|= function + | [ + { + typ = "reblog"; + account = { id = account_id; _ }; + status = Some { id = status_id; _ }; + _; + }; + ] -> + assert (account_id = admin_id); + assert (status_id = post_id) + | _ -> assert false);%lwt + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_6_fav.ml b/e2e/src/waq_mstdn_6_fav.ml new file mode 100644 index 0000000..af0b8d8 --- /dev/null +++ b/e2e/src/waq_mstdn_6_fav.ml @@ -0,0 +1,55 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Lookup @admin@localhost:3000 *) + let%lwt admin_id, _username, _acct = + lookup `Waq ~token:waq_token ~username:"admin" ~domain:"localhost:3000" () + in + (* Follow @admin@localhost:3000 *) + follow `Waq ~token:waq_token admin_id;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Get user1's id on localhost:3000 *) + let%lwt mstdn_user1_id, _, _ = + lookup `Mstdn ~token:mstdn_token ~username:"user1" () + in + + (* Post by @admin@localhost:3000 *) + let%lwt { id = mstdn_post_id; _ } = post `Mstdn ~token:mstdn_token () in + Lwt_unix.sleep 1.0;%lwt + + (* Get id of the post *) + let%lwt id = + home_timeline `Waq ~token:waq_token >|= function + | [ `Assoc l ] -> List.assoc "id" l |> expect_string + | _ -> assert false + in + + (* Favourite the post by me *) + let%lwt s = fav `Waq ~token:waq_token ~id in + Lwt_unix.sleep 1.0;%lwt + assert s.favourited; + let%lwt s = get_status `Waq ~token:waq_token id in + assert s.favourited; + + (* Check if the post is favourited in localhost:3000 *) + (match%lwt get_favourited_by `Mstdn ~token:mstdn_token ~id:mstdn_post_id with + | [ a ] -> + assert (a.id = mstdn_user1_id); + Lwt.return_unit + | _ -> assert false);%lwt + + (* Unfavourite the post *) + let%lwt s = unfav `Waq ~token:waq_token ~id in + Lwt_unix.sleep 1.0;%lwt + assert (not s.favourited); + let%lwt s = get_status `Waq ~token:waq_token id in + assert (not s.favourited); + + (* Check if the post is unfavourited *) + (match%lwt get_favourited_by `Mstdn ~token:mstdn_token ~id:mstdn_post_id with + | [] -> Lwt.return_unit + | _ -> assert false);%lwt + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_7_fav.ml b/e2e/src/waq_mstdn_7_fav.ml new file mode 100644 index 0000000..3e9cf86 --- /dev/null +++ b/e2e/src/waq_mstdn_7_fav.ml @@ -0,0 +1,66 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Lookup me from localhost:3000 *) + let%lwt aid, _, _ = + lookup `Mstdn ~token:mstdn_token ~username:"user1" ~domain:waq_server_domain + () + in + (* Lookup @admin@localhost:3000 *) + let%lwt admin_id, _username, _acct = + lookup `Waq ~token:waq_token ~username:"admin" ~domain:"localhost:3000" () + in + (* Follow me from @admin@localhost:3000 *) + follow `Mstdn ~token:mstdn_token aid;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* Post by me *) + let%lwt { id = waq_status_id; _ } = post `Waq ~token:waq_token () in + Lwt_unix.sleep 1.0;%lwt + + (* Get id of the post *) + let%lwt mstdn_status_id = + home_timeline `Mstdn ~token:mstdn_token >|= function + | [ `Assoc l ] -> List.assoc "id" l |> expect_string + | _ -> assert false + in + + (* Favourite the post by @admin@localhost:3000 *) + let%lwt _ = fav `Mstdn ~token:mstdn_token ~id:mstdn_status_id in + Lwt_unix.sleep 1.0;%lwt + + (* Check if the post is favourited *) + (match%lwt get_favourited_by `Waq ~token:waq_token ~id:waq_status_id with + | [ a ] -> + assert (a.id = admin_id); + Lwt.return_unit + | _ -> assert false);%lwt + + (* Check notification *) + (match%lwt get_notifications `Waq ~token:waq_token with + | [ + { + typ = "favourite"; + account = { id = account_id; _ }; + status = Some { id = status_id; _ }; + _; + }; + { typ = "follow"; account = { id = account_id'; _ }; _ }; + ] -> + assert (account_id = admin_id); + assert (status_id = waq_status_id); + assert (account_id' = admin_id); + Lwt.return_unit + | _ -> assert false);%lwt + + (* Unfavourite the post *) + let%lwt _ = unfav `Mstdn ~token:mstdn_token ~id:mstdn_status_id in + Lwt_unix.sleep 1.0;%lwt + + (* Check if the post is unfavourited *) + (match%lwt get_favourited_by `Waq ~token:waq_token ~id:waq_status_id with + | [] -> Lwt.return_unit + | _ -> assert false);%lwt + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_8_lookup_search.ml b/e2e/src/waq_mstdn_8_lookup_search.ml new file mode 100644 index 0000000..83911cf --- /dev/null +++ b/e2e/src/waq_mstdn_8_lookup_search.ml @@ -0,0 +1,56 @@ +open Common + +let f = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + (* Lookup @admin@localhost:3000 *) + let%lwt res1 = + lookup `Waq ~token:waq_token ~username:"admin" ~domain:"localhost:3000" () + in + let%lwt res2 = + lookup_via_v1_accounts_search `Waq ~token:waq_token ~username:"admin" + ~domain:"localhost:3000" () + in + let%lwt res3 = + lookup_via_v1_accounts_lookup `Waq ~token:waq_token ~username:"admin" + ~domain:"localhost:3000" () + in + let%lwt res4 = + search `Waq ~token:waq_token "http://localhost:3000/users/admin" + in + assert (res1 = res2); + assert (res1 = res3); + assert ( + match res4 with + | [ acct ], _, _ when res1 = (acct.id, acct.username, acct.acct) -> true + | _ -> false); + + (* No token should cause an error *) + expect_exc_lwt (fun () -> + lookup_via_v1_accounts_search `Waq ~username:"admin" + ~domain:"localhost:3000" ());%lwt + + (* Lookup me *) + let%lwt res1 = lookup `Waq ~token:waq_token ~username:"user1" () in + let%lwt res2 = + lookup_via_v1_accounts_search `Waq ~token:waq_token ~username:"user1" () + in + let%lwt res3 = + lookup_via_v1_accounts_lookup `Waq ~token:waq_token ~username:"user1" () + in + let%lwt res4 = + search `Waq ~token:waq_token (waq_server_name ^/ "users/user1") + in + assert (res1 = res2); + assert (res1 = res3); + assert ( + match res4 with + | [ acct ], _, _ when res1 = (acct.id, acct.username, acct.acct) -> true + | _ -> false); + + (* Lookup post of @admin@localhost:3000 *) + let%lwt { uri; _ } = post `Mstdn ~token:mstdn_token () in + let%lwt res = search `Waq ~token:waq_token uri in + assert ( + match res with _, [ status ], _ when status.uri = uri -> true | _ -> false); + + Lwt.return_unit diff --git a/e2e/src/waq_mstdn_9_delete.ml b/e2e/src/waq_mstdn_9_delete.ml new file mode 100644 index 0000000..e6f5e08 --- /dev/null +++ b/e2e/src/waq_mstdn_9_delete.ml @@ -0,0 +1,102 @@ +open Common2 + +let f (a0 : agent) (a1 : agent) = + (* a0: Follow a1 *) + follow_agent a0 a1;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* a1: Post *) + let%lwt { uri; id = a1_post_id; _ } = post a1 () in + Lwt_unix.sleep 1.0;%lwt + + (* a0: Get the post id *) + let%lwt a0_post_id = + match%lwt search a0 uri with + | _, [ s ], _ -> Lwt.return s.id + | _ -> assert false + in + + (* a0: Reblog the post *) + let%lwt a0_reblog_id = reblog a0 ~id:a0_post_id >|= fun r -> r.id in + Lwt_unix.sleep 1.0;%lwt + + (* a0: Check the posts *) + let%lwt _ = get_status a0 a0_post_id in + let%lwt _ = get_status a0 a0_reblog_id in + + (* a1: Delete the post *) + delete_status a1 a1_post_id |> ignore_lwt;%lwt + Lwt_unix.sleep 2.0;%lwt + + (* a0: Check the posts *) + expect_no_status a0 a0_post_id;%lwt + expect_no_status a0 a0_reblog_id;%lwt + + (***************************) + + (* a0: Follow a1 *) + follow_agent a1 a0;%lwt + + (* a1: Post *) + let%lwt { uri; id = post_id; _ } = post a1 () in + Lwt_unix.sleep 1.0;%lwt + + (* a0: Get the post id *) + let%lwt a0_post_id = + match%lwt search a0 uri with + | _, [ s ], _ -> Lwt.return s.id + | _ -> assert false + in + + (* a0: Reblog the post *) + let%lwt a0_reblog_id = reblog a0 ~id:a0_post_id >|= fun r -> r.id in + Lwt_unix.sleep 1.0;%lwt + + (* a0: Check the posts *) + let%lwt _ = get_status a0 a0_post_id in + let%lwt _ = get_status a0 a0_reblog_id in + + (* a1: Check if a0 reblogged a0_post_id *) + let%lwt { reblogs_count; _ } = get_status a1 post_id in + assert (reblogs_count = 1); + + (* a0: Unreblog the post *) + unreblog a0 ~id:a0_post_id |> ignore_lwt;%lwt + Lwt_unix.sleep 1.0;%lwt + + (* a0: Check the posts *) + let%lwt _ = get_status a0 a0_post_id in + expect_no_status a0 a0_reblog_id;%lwt + + (* + (* a1: Check if a0 unreblogged a0_post_id *) + let%lwt { reblogs_count; _ } = get_status a1 post_id in + assert (reblogs_count = 0); + *) + Lwt.return_unit + +let f_waq_mstdn = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + let a1 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + f a0 a1;%lwt + Lwt.return_unit + +let f_mstdn_waq = + make_waq_and_mstdn_scenario @@ fun waq_token mstdn_token -> + let a0 = + make_agent ~kind:`Mstdn ~token:mstdn_token ~username:"admin" + ~domain:"localhost:3000" + in + let a1 = + make_agent ~kind:`Waq ~token:waq_token ~username:"user1" + ~domain:waq_server_domain + in + f a0 a1;%lwt + Lwt.return_unit