├── .gitmodules ├── dune-project ├── .ocamlformat ├── lib ├── controller │ ├── api_v1 │ │ ├── media.ml │ │ ├── accounts │ │ │ ├── verify_credentials.ml │ │ │ ├── root.ml │ │ │ ├── lookup.ml │ │ │ ├── relationships.ml │ │ │ ├── search.ml │ │ │ ├── unfollow.ml │ │ │ ├── following.ml │ │ │ ├── update_credentials.ml │ │ │ ├── statuses.ml │ │ │ └── follow.ml │ │ ├── apps │ │ │ ├── verify_credentials.ml │ │ │ └── root.ml │ │ ├── statuses │ │ │ ├── favourited_by.ml │ │ │ ├── unreblog.ml │ │ │ ├── context.ml │ │ │ ├── unfavourite.ml │ │ │ ├── favourite.ml │ │ │ └── reblog.ml │ │ ├── instance.ml │ │ ├── notifications │ │ │ └── root.ml │ │ ├── timelines │ │ │ └── home.ml │ │ ├── push │ │ │ └── subscription.ml │ │ ├── streaming.ml │ │ └── markers.ml │ ├── well_known │ │ ├── host_meta.ml │ │ ├── nodeinfo.ml │ │ └── webfinger.ml │ ├── users │ │ ├── statuses.ml │ │ ├── outbox.ml │ │ ├── following.ml │ │ └── root.ml │ ├── root.ml │ ├── nodeinfo.ml │ ├── static.ml │ ├── api_v2 │ │ ├── media.ml │ │ └── search.ml │ └── oauth │ │ ├── token.ml │ │ └── authorize.ml ├── migrations.cppo.ml ├── migrate │ ├── m20230519_142558_add_url_to_statuses.ml │ ├── m20230516_125248_add_actor_type.ml │ ├── m20230511_225300_add_blurhash.ml │ ├── m20230506_172100_add_blurhash.ml │ ├── m20230502_220400_add_note.ml │ ├── m20230506_145100_add_file_file_name.ml │ ├── m20230410_193300_add_spoiler_text.ml │ ├── m20230427_205000_create_preview_cards_statuses.ml │ ├── m20230318_232000_add_avatar_header_remote_url.ml │ ├── m20230321_215500_create_unique_index_on_accounts_username_domain.ml │ ├── m20230315_100000_add_updated_at_column.ml │ ├── m20230121_195200_create_oauth_applications.ml │ ├── m20230328_233800_create_mentions.ml │ ├── m20230331_183000_create_markers.ml │ ├── m20221230_220001_create_users.ml │ ├── m20230209_204400_create_favourites.ml │ ├── m20230225_174100_create_status_stats.ml │ ├── m20230321_215501_create_media_attachments.ml │ ├── m20221230_220003_create_follows.ml │ ├── m20230225_173800_create_account_stats.ml │ ├── m20221230_220004_create_follow_requests.ml │ ├── m20230212_175600_create_notifications.ml │ ├── m20230416_182600_create_web_push_subscriptions.ml │ ├── m20230121_195201_create_oauth_access_tokens.ml │ ├── m20221230_220000_create_accounts.ml │ ├── m20230427_204200_create_preview_cards.ml │ ├── m20221230_220002_create_statuses.ml │ └── m20230122_183000_create_oauth_access_grants.ml ├── worker │ ├── delivery.ml │ ├── announce.ml │ ├── create_note.ml │ ├── insert_to_feed.ml │ ├── accept.ml │ ├── account_update.ml │ ├── local_notify.ml │ ├── removal.ml │ └── distribute.ml ├── migration.ml ├── otel.ml ├── crypto.ml ├── regex.ml ├── webpush_helper.ml ├── dune ├── k.ml ├── oauth_helper.ml ├── migrations.inc ├── job.ml ├── streaming.ml ├── throttle_fetch.ml ├── db.ml ├── text_helper.ml ├── image.ml ├── util.ml └── router.ml ├── lib_sqlx ├── error.ml ├── otel.ml ├── ppx │ └── dune ├── test │ ├── dune │ └── common.ml ├── dune ├── util.ml ├── connection.ml └── value.ml ├── lib_webpush ├── test │ ├── dune │ ├── test_webpush.ml │ └── test_vapid.ml ├── dune ├── util.ml ├── jwt.ml └── vapid.ml ├── static ├── avatars │ └── original │ │ └── missing.png └── headers │ └── original │ └── missing.png ├── Makefile ├── test ├── dune ├── test_ogp_youtube.json ├── test_regex.ml ├── test_model.ml ├── test_util.ml ├── test_ogp_flickr.json ├── test_ogp_eow_alc.html └── test_text_helper.ml ├── .dockerignore ├── bin └── dune ├── e2e ├── src │ ├── dune │ ├── waq_11_marker.ml │ ├── waq_mstdn_13_v2_search.ml │ ├── waq_mstdn_18_account.ml │ ├── waq_10_mention.ml │ ├── waq_mstdn_4_reblog.ml │ ├── waq_9_ap.ml │ ├── waq_7_reblog.ml │ ├── waq_mstdn_12_summary.ml │ ├── waq_8_delete.ml │ ├── waq_mstdn_15_text.ml │ ├── waq_mstdn_5_reblog.ml │ ├── waq_mstdn_14_preview_card.ml │ ├── waq_mstdn_8_lookup_search.ml │ ├── waq_1.ml │ ├── waq_mstdn_6_fav.ml │ ├── waq_mstdn_2.ml │ ├── waq_2_ws.ml │ ├── waq_mstdn_11_mention.ml │ ├── waq_mstdn_17_status.ml │ ├── waq_4_reblog.ml │ ├── waq_mstdn_7_fav.ml │ ├── waq_mstdn_10_attachment.ml │ ├── waq_5_fav.ml │ ├── waq_mstdn_16_cred.ml │ ├── waq_mstdn_3_reply.ml │ ├── waq_mstdn_9_delete.ml │ ├── waq_3.ml │ ├── waq_mstdn_1.ml │ └── main.ml └── manifests │ ├── reset-waq-database.yaml │ ├── socks5-proxy.yaml │ ├── elk.yaml │ ├── jaeger.yaml │ ├── magout-values.yaml │ ├── certificate.yaml │ ├── postgres.yaml │ └── reset-mastodon-database.yaml ├── .gitignore ├── .github └── workflows │ ├── test.yaml │ ├── e2e-test.yaml │ └── push-ghcr.yaml ├── nix ├── kneesocks.nix └── docker.nix ├── LICENSE └── waq.opam /.gitmodules: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.7) 2 | 3 | (name waq) 4 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = default 2 | version = 0.27.0 3 | -------------------------------------------------------------------------------- /lib/controller/api_v1/media.ml: -------------------------------------------------------------------------------- 1 | let post = Api_v2.Media.post 2 | -------------------------------------------------------------------------------- /lib_sqlx/error.ml: -------------------------------------------------------------------------------- 1 | exception NoRowFound 2 | exception NotLoaded 3 | -------------------------------------------------------------------------------- /lib_sqlx/otel.ml: -------------------------------------------------------------------------------- 1 | let with_span ?attrs ~__FUNCTION__ f = 2 | Opentelemetry.Trace.with_ ?attrs __FUNCTION__ f 3 | -------------------------------------------------------------------------------- /lib_webpush/test/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_vapid test_webpush) 3 | (libraries alcotest webpush mirage-crypto-rng.unix)) 4 | -------------------------------------------------------------------------------- /static/avatars/original/missing.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ushitora-anqou/waq/HEAD/static/avatars/original/missing.png -------------------------------------------------------------------------------- /static/headers/original/missing.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ushitora-anqou/waq/HEAD/static/headers/original/missing.png -------------------------------------------------------------------------------- /lib_sqlx/ppx/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_sqlx) 3 | (kind ppx_rewriter) 4 | (preprocess 5 | (pps ppxlib.metaquot)) 6 | (libraries ppxlib)) 7 | -------------------------------------------------------------------------------- /lib/migrations.cppo.ml: -------------------------------------------------------------------------------- 1 | let migrations : (int * (module Sqlx.Migration.S)) list = 2 | Migrate. 3 | [ 4 | #include "migrations.inc" 5 | ] 6 | -------------------------------------------------------------------------------- /lib_sqlx/test/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_sqlx test_example) 3 | (preprocess 4 | (pps lwt_ppx ppx_sqlx)) 5 | (libraries alcotest alcotest-lwt sqlx)) 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: build 2 | build: 3 | dune build 4 | 5 | .PHONY: test 6 | test: 7 | dune runtest 8 | 9 | .PHONY: fmt 10 | fmt: 11 | dune fmt 12 | -------------------------------------------------------------------------------- /lib/migrate/m20230519_142558_add_url_to_statuses.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = add_column ~table_name:"statuses" ~name:"url" ~spec:"TEXT" 4 | -------------------------------------------------------------------------------- /lib/migrate/m20230516_125248_add_actor_type.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = add_column ~table_name:"accounts" ~name:"actor_type" ~spec:"TEXT" 4 | -------------------------------------------------------------------------------- /lib/migrate/m20230511_225300_add_blurhash.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | add_column ~table_name:"preview_cards" ~name:"blurhash" ~spec:"TEXT" 5 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_util test_text_helper test_regex test_ogp test_model) 3 | (preprocess 4 | (pps lwt_ppx)) 5 | (libraries alcotest alcotest-lwt waq)) 6 | -------------------------------------------------------------------------------- /lib/migrate/m20230506_172100_add_blurhash.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | add_column ~table_name:"media_attachments" ~name:"blurhash" ~spec:"TEXT" 5 | -------------------------------------------------------------------------------- /lib/migrate/m20230502_220400_add_note.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | add_column ~table_name:"accounts" ~name:"note" 5 | ~spec:"TEXT NOT NULL DEFAULT ''" 6 | -------------------------------------------------------------------------------- /lib/migrate/m20230506_145100_add_file_file_name.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | add_column ~table_name:"media_attachments" ~name:"file_file_name" ~spec:"TEXT" 5 | -------------------------------------------------------------------------------- /.dockerignore: -------------------------------------------------------------------------------- 1 | .dockerignore 2 | .git 3 | .github 4 | .gitignore 5 | .gitmodules 6 | .ocamlformat 7 | .opam 8 | LICENSE 9 | README.md 10 | _build/ 11 | e2e/ 12 | misc/ 13 | test/ 14 | -------------------------------------------------------------------------------- /lib_webpush/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name webpush) 3 | (libraries 4 | uri 5 | base64 6 | cstruct 7 | digestif 8 | yojson 9 | mirage-crypto 10 | mirage-crypto-ec 11 | unix)) 12 | -------------------------------------------------------------------------------- /lib/migrate/m20230410_193300_add_spoiler_text.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | add_column ~table_name:"statuses" ~name:"spoiler_text" 5 | ~spec:"TEXT NOT NULL DEFAULT ''" 6 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (public_name waq) 3 | (name main) 4 | (preprocess 5 | (pps lwt_ppx)) 6 | (libraries cmdliner lwt lwt.unix waq) 7 | (flags :standard -open Ppx_yojson_conv_lib.Yojson_conv.Primitives)) 8 | -------------------------------------------------------------------------------- /lib_sqlx/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name sqlx) 3 | (preprocess 4 | (pps lwt_ppx ppx_deriving.enum ppx_deriving.make ppx_deriving.show)) 5 | (libraries lwt lwt.unix ptime logs logs.fmt opentelemetry postgresql re uri)) 6 | -------------------------------------------------------------------------------- /lib/controller/api_v1/accounts/verify_credentials.ml: -------------------------------------------------------------------------------- 1 | open Entity 2 | open Helper 3 | 4 | let get _ req = 5 | let self = authenticate_account req in 6 | make_credential_account_from_model self |> yojson_of_account |> respond_yojson 7 | -------------------------------------------------------------------------------- /lib/migrate/m20230427_205000_create_preview_cards_statuses.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"preview_cards_statuses" 5 | ~schema: 6 | [ {|preview_card_id BIGINT NOT NULL|}; {|status_id BIGINT NOT NULL|} ] 7 | -------------------------------------------------------------------------------- /lib_sqlx/util.ml: -------------------------------------------------------------------------------- 1 | include Lwt.Infix 2 | 3 | let failwithf f = Printf.ksprintf failwith f 4 | let ( |.> ) f g x = f x |> g 5 | let ignore_lwt p = Lwt.map (fun _ -> ()) p 6 | 7 | let iota n = 8 | let rec f acc = function 0 -> acc | n -> f ((n - 1) :: acc) (n - 1) in 9 | f [] n 10 | -------------------------------------------------------------------------------- /lib/migrate/m20230318_232000_add_avatar_header_remote_url.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | add_column ~table_name:"accounts" ~name:"avatar_remote_url" ~spec:"TEXT" 5 | *> add_column ~table_name:"accounts" ~name:"header_remote_url" 6 | ~spec:"TEXT NOT NULL DEFAULT ''" 7 | -------------------------------------------------------------------------------- /lib/migrate/m20230321_215500_create_unique_index_on_accounts_username_domain.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_unique_index ~name:"unique_index_accounts_username_domain" 5 | ~table_name:"accounts" 6 | ~schema:[ {|LOWER(username)|}; {|COALESCE(LOWER(domain), '')|} ] 7 | -------------------------------------------------------------------------------- /lib/worker/delivery.ml: -------------------------------------------------------------------------------- 1 | open Activity 2 | 3 | let kick env ~(activity : t) ~(url : string) ~(src : Db.Account.t) = 4 | Job.kick env ~name:__FUNCTION__ @@ fun () -> 5 | let body = activity |> to_yojson |> Yojson.Safe.to_string in 6 | post_activity_json env ~body ~sign:(sign_spec_of_account src) ~url 7 | -------------------------------------------------------------------------------- /lib/worker/announce.ml: -------------------------------------------------------------------------------- 1 | open Activity 2 | 3 | (* Send Announce to POST /users/:name/inbox *) 4 | let kick env ~(url : string) ~(status : Db.Status.t) = 5 | let activity = announce_of_status status |> announce in 6 | let src = Db.e (Model.Account.get_one ~id:status#account_id) in 7 | Delivery.kick env ~activity ~src ~url 8 | -------------------------------------------------------------------------------- /lib/worker/create_note.ml: -------------------------------------------------------------------------------- 1 | open Activity 2 | 3 | (* Send Create/Note to POST /users/:name/inbox *) 4 | let kick env ~(url : string) ~(status : Db.Status.t) = 5 | let activity = create_note_of_status status |> create in 6 | let src = Db.e (Model.Account.get_one ~id:status#account_id) in 7 | Delivery.kick env ~activity ~src ~url 8 | -------------------------------------------------------------------------------- /e2e/src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (preprocess 4 | (pps ppx_deriving.make ppx_yojson_conv)) 5 | (libraries 6 | eio 7 | eio_main 8 | lambdasoup 9 | logs 10 | logs.fmt 11 | mirage-crypto-rng 12 | mirage-crypto-rng.unix 13 | pcre 14 | yojson 15 | yume) 16 | (flags :standard -open Ppx_yojson_conv_lib.Yojson_conv.Primitives)) 17 | -------------------------------------------------------------------------------- /lib/migrate/m20230315_100000_add_updated_at_column.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | add_column ~table_name:"oauth_access_grants" ~name:"updated_at" 5 | ~spec:"TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT now()" 6 | *> add_column ~table_name:"oauth_access_tokens" ~name:"updated_at" 7 | ~spec:"TIMESTAMP WITHOUT TIME ZONE NOT NULL DEFAULT now()" 8 | -------------------------------------------------------------------------------- /lib/controller/api_v1/apps/verify_credentials.ml: -------------------------------------------------------------------------------- 1 | type res = { name : string } [@@deriving make, yojson] 2 | 3 | let get _ req = 4 | let token = Helper.authenticate_bearer req in 5 | let app = 6 | Db.(e OAuthApplication.(get_one ~id:(Option.get token#application_id))) 7 | in 8 | make_res ~name:app#name |> yojson_of_res |> Yojson.Safe.to_string 9 | |> Yume.Server.respond 10 | -------------------------------------------------------------------------------- /lib/migration.ml: -------------------------------------------------------------------------------- 1 | open Migrations 2 | 3 | let config = Sqlx.Migration.{ schema_migrations = "waq_schema_migrations" } 4 | 5 | let verify_migration_status () = 6 | Db.e @@ Sqlx.Migration.verify_migration_status ~config ~migrations 7 | 8 | let migrate () = Db.e @@ Sqlx.Migration.migrate ~config ~migrations 9 | 10 | let rollback ?(n = 1) () = 11 | Db.e @@ Sqlx.Migration.rollback ~config ~migrations ~n 12 | -------------------------------------------------------------------------------- /lib/controller/api_v1/accounts/root.ml: -------------------------------------------------------------------------------- 1 | open Entity 2 | open Helper 3 | 4 | let get _ req = 5 | let id = 6 | req |> Yume.Server.param ":id" |> int_of_string |> Model.Account.ID.of_int 7 | in 8 | match Db.e (Model.Account.get_one ~id) with 9 | | exception Sqlx.Error.NoRowFound -> 10 | Yume.Server.raise_error_response `Not_found 11 | | a -> make_account_from_model a |> yojson_of_account |> respond_yojson 12 | -------------------------------------------------------------------------------- /lib/migrate/m20230121_195200_create_oauth_applications.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"oauth_applications" 5 | ~schema: 6 | [ 7 | {|name TEXT NOT NULL|}; 8 | {|uid TEXT NOT NULL|}; 9 | {|secret TEXT NOT NULL|}; 10 | {|redirect_uri TEXT NOT NULL|}; 11 | {|scopes TEXT NOT NULL|}; 12 | (* *) 13 | {|UNIQUE (uid)|}; 14 | ] 15 | -------------------------------------------------------------------------------- /lib/migrate/m20230328_233800_create_mentions.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"mentions" 5 | ~schema: 6 | [ 7 | {|status_id BIGINT|}; 8 | {|account_id BIGINT|}; 9 | (* *) 10 | {|FOREIGN KEY ( account_id ) REFERENCES accounts ( id ) ON DELETE CASCADE|}; 11 | {|FOREIGN KEY ( status_id ) REFERENCES statuses ( id ) ON DELETE CASCADE|}; 12 | ] 13 | -------------------------------------------------------------------------------- /lib/migrate/m20230331_183000_create_markers.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"markers" 5 | ~schema: 6 | [ 7 | {|user_id BIGINT|}; 8 | {|timeline TEXT NOT NULL|}; 9 | {|last_read_id BIGINT NOT NULL|}; 10 | (* *) 11 | {|FOREIGN KEY ( user_id ) REFERENCES users ( id ) ON DELETE CASCADE|}; 12 | {|UNIQUE ( user_id, timeline )|}; 13 | ] 14 | -------------------------------------------------------------------------------- /lib/controller/api_v1/accounts/lookup.ml: -------------------------------------------------------------------------------- 1 | open Entity 2 | open Helper 3 | 4 | let parse_req req = req |> Yume.Server.query "acct" |> parse_webfinger_address 5 | 6 | let get _ req = 7 | let username, domain = parse_req req in 8 | let a = 9 | try Db.e (Model.Account.get_one ~domain ~username) 10 | with Sqlx.Error.NoRowFound -> Yume.Server.raise_error_response `Not_found 11 | in 12 | make_account_from_model a |> yojson_of_account |> respond_yojson 13 | -------------------------------------------------------------------------------- /lib/migrate/m20221230_220001_create_users.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"users" 5 | ~schema: 6 | [ 7 | "email TEXT NOT NULL"; 8 | "encrypted_password TEXT NOT NULL"; 9 | "account_id BIGINT NOT NULL"; 10 | "UNIQUE (email)"; 11 | (* *) 12 | "FOREIGN KEY (account_id) REFERENCES accounts (id) ON UPDATE CASCADE \ 13 | ON DELETE CASCADE"; 14 | ] 15 | -------------------------------------------------------------------------------- /lib/controller/api_v1/statuses/favourited_by.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | open Helper 3 | 4 | let get _ req = 5 | let status_id = 6 | req |> Yume.Server.param ":id" |> int_of_string |> Model.Status.ID.of_int 7 | in 8 | let accts = Db.(e @@ get_favourited_by ~status_id) in 9 | let accts = 10 | accts 11 | |> List.map (fun (a : Db.Account.t) -> a#id) 12 | |> Entity.load_accounts_from_db 13 | |> List.map Entity.yojson_of_account 14 | in 15 | `List accts |> respond_yojson 16 | -------------------------------------------------------------------------------- /lib/controller/well_known/host_meta.ml: -------------------------------------------------------------------------------- 1 | (* Recv GET /.well-known/host-meta *) 2 | let get _env _req = 3 | let url = Config.url [ ".well-known"; "webfinger" ] in 4 | Jingoo.Jg_template.from_string 5 | ~models:[ ("url", Tstr url) ] 6 | {| 7 | 8 | 9 | |} 10 | |> Yume.Server.respond ~headers:[ Helper.content_type_app_xrd_xml ] 11 | -------------------------------------------------------------------------------- /lib/otel.ml: -------------------------------------------------------------------------------- 1 | let with_setup f = 2 | if Config.(is_enabled (enable_otel ())) then ( 3 | Opentelemetry.Globals.service_name := "waq"; 4 | (*Opentelemetry.GC_metrics.basic_setup ();*) 5 | Opentelemetry_ambient_context.set_storage_provider 6 | (Opentelemetry_ambient_context_eio.storage ()); 7 | Opentelemetry_client_ocurl.with_setup () @@ fun () -> f ()) 8 | else f () 9 | 10 | let with_span ?attrs ~__FUNCTION__ f = 11 | Opentelemetry.Trace.with_ ?attrs __FUNCTION__ f 12 | -------------------------------------------------------------------------------- /lib/controller/users/statuses.ml: -------------------------------------------------------------------------------- 1 | open Activity 2 | open Helper 3 | 4 | let get _ req = 5 | let _username = req |> Yume.Server.param ":name" in 6 | let status_id = 7 | req |> Yume.Server.param ":id" |> int_of_string |> Model.Status.ID.of_int 8 | in 9 | match Db.e (Model.Status.get_one ~id:status_id) with 10 | | exception Sqlx.Error.NoRowFound -> 11 | Yume.Server.raise_error_response `Not_found 12 | | s -> note_of_status s |> of_note |> to_yojson |> respond_activity_yojson 13 | -------------------------------------------------------------------------------- /lib/worker/insert_to_feed.ml: -------------------------------------------------------------------------------- 1 | open Entity 2 | 3 | let kick env ~status_id ~account_id ~user_id ~stream = 4 | Job.kick env ~name:__FUNCTION__ @@ fun () -> 5 | assert (stream = `User); 6 | let key = Streaming.make_key ~user_id ~stream in 7 | let payload = 8 | Db.e (Model.Status.get_one ~id:status_id) 9 | |> make_status_from_model ~self_id:account_id 10 | |> yojson_of_status |> Yojson.Safe.to_string 11 | in 12 | Streaming.push ~key ~event:"update" ~payload (); 13 | () 14 | -------------------------------------------------------------------------------- /lib/migrate/m20230209_204400_create_favourites.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"favourites" 5 | ~schema: 6 | [ 7 | {|account_id BIGINT NOT NULL|}; 8 | {|status_id BIGINT NOT NULL|}; 9 | (* *) 10 | {|FOREIGN KEY (account_id) REFERENCES accounts(id) ON DELETE CASCADE|}; 11 | {|FOREIGN KEY (status_id) REFERENCES statuses(id) ON DELETE CASCADE|}; 12 | {|UNIQUE (account_id, status_id)|}; 13 | ] 14 | -------------------------------------------------------------------------------- /lib/migrate/m20230225_174100_create_status_stats.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"status_stats" 5 | ~schema: 6 | [ 7 | {|status_id BIGINT NOT NULL|}; 8 | {|replies_count BIGINT NOT NULL|}; 9 | {|reblogs_count BIGINT NOT NULL|}; 10 | {|favourites_count BIGINT NOT NULL|}; 11 | (* *) 12 | {|FOREIGN KEY (status_id) REFERENCES statuses(id) ON DELETE CASCADE|}; 13 | {|UNIQUE (status_id)|}; 14 | ] 15 | -------------------------------------------------------------------------------- /e2e/manifests/reset-waq-database.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | apiVersion: batch/v1 3 | kind: Job 4 | metadata: 5 | name: reset-waq-database 6 | namespace: e2e 7 | spec: 8 | template: 9 | spec: 10 | restartPolicy: Never 11 | containers: 12 | - name: reset-waq-database 13 | image: ghcr.io/ushitora-anqou/waq:dev 14 | imagePullPolicy: IfNotPresent 15 | args: 16 | - db:reset 17 | envFrom: 18 | - secretRef: 19 | name: waq-secret-env 20 | -------------------------------------------------------------------------------- /lib/controller/well_known/nodeinfo.ml: -------------------------------------------------------------------------------- 1 | open Helper 2 | 3 | let get _ _req = 4 | `Assoc 5 | [ 6 | ( "links", 7 | `List 8 | [ 9 | `Assoc 10 | [ 11 | ( "rel", 12 | `String "http://nodeinfo.diaspora.software/ns/schema/2.0" ); 13 | ( "href", 14 | `String ("https://" ^ Config.server_name () ^ "/nodeinfo/2.0") 15 | ); 16 | ]; 17 | ] ); 18 | ] 19 | |> respond_yojson 20 | -------------------------------------------------------------------------------- /lib/crypto.ml: -------------------------------------------------------------------------------- 1 | let initialize _env f = 2 | Mirage_crypto_rng_unix.use_default (); 3 | f () 4 | 5 | module SecureRandom = struct 6 | let generate len = Mirage_crypto_rng.generate len 7 | 8 | let unique_token () = 9 | (* Thanks to: Doorkeeper::OAuth::Helpers::UniqueToken 10 | https://github.com/doorkeeper-gem/doorkeeper/blob/47037da4def738e4cfd930bd433f35629a5869f6/lib/doorkeeper/oauth/helpers/unique_token.rb *) 11 | generate 32 12 | |> Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet 13 | end 14 | -------------------------------------------------------------------------------- /lib/migrate/m20230321_215501_create_media_attachments.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"media_attachments" 5 | ~schema: 6 | [ 7 | {|status_id BIGINT|}; 8 | {|account_id BIGINT|}; 9 | {|remote_url TEXT NOT NULL|}; 10 | {|type INTEGER NOT NULL|}; 11 | (* *) 12 | {|FOREIGN KEY ( account_id ) REFERENCES accounts ( id ) ON DELETE SET NULL|}; 13 | {|FOREIGN KEY ( status_id ) REFERENCES statuses ( id ) ON DELETE SET NULL|}; 14 | ] 15 | -------------------------------------------------------------------------------- /lib_webpush/util.ml: -------------------------------------------------------------------------------- 1 | let b64_url_encode str = 2 | let r = Base64.encode ~pad:false ~alphabet:Base64.uri_safe_alphabet str in 3 | match r with 4 | | Ok s -> s 5 | | Error _ -> 6 | failwith 7 | (Printf.sprintf "Something wrong happened while encoding\n %s" str) 8 | 9 | let b64_url_decode str = 10 | let r = Base64.decode ~pad:false ~alphabet:Base64.uri_safe_alphabet str in 11 | match r with 12 | | Ok s -> s 13 | | Error _ -> 14 | failwith 15 | (Printf.sprintf "Something wrong happened while decoding\n %s" str) 16 | -------------------------------------------------------------------------------- /lib/worker/accept.ml: -------------------------------------------------------------------------------- 1 | open Activity 2 | 3 | (* Send Accept to POST inbox *) 4 | let kick env ~(f : Db.Follow.t) ~(followee : Db.Account.t) 5 | ~(follower : Db.Account.t) = 6 | let id = 7 | followee#uri ^ "#accepts/follows/" 8 | ^ (f#id |> Model.Follow.ID.to_int |> string_of_int) 9 | in 10 | let obj = 11 | make_follow ~id:f#uri ~actor:follower#uri ~obj:followee#uri |> follow 12 | in 13 | let activity = make_accept ~id ~actor:(`String followee#uri) ~obj |> accept in 14 | Delivery.kick env ~activity ~src:followee ~url:follower#inbox_url 15 | -------------------------------------------------------------------------------- /e2e/manifests/socks5-proxy.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | apiVersion: apps/v1 3 | kind: Deployment 4 | metadata: 5 | name: socks5-proxy 6 | namespace: e2e 7 | spec: 8 | replicas: 1 9 | selector: 10 | matchLabels: 11 | app: socks5-proxy 12 | template: 13 | metadata: 14 | labels: 15 | app: socks5-proxy 16 | spec: 17 | containers: 18 | - name: socks5-proxy 19 | image: serjs/go-socks5-proxy 20 | imagePullPolicy: IfNotPresent 21 | ports: 22 | - containerPort: 1080 23 | name: socks 24 | -------------------------------------------------------------------------------- /lib/controller/api_v1/accounts/relationships.ml: -------------------------------------------------------------------------------- 1 | open Entity 2 | open Helper 3 | 4 | let get _ req = 5 | let self = authenticate_account req in 6 | let account_ids = 7 | req 8 | |> Yume.Server.query_many "id" 9 | |> List.map (fun s -> s |> int_of_string |> Model.Account.ID.of_int) 10 | in 11 | account_ids 12 | |> List.map (fun account_id -> 13 | Db.e (Model.Account.get_one ~id:account_id) 14 | |> make_relationship_from_model self) 15 | |> List.map yojson_of_relationship 16 | |> (fun l -> `List l) 17 | |> respond_yojson 18 | -------------------------------------------------------------------------------- /lib/migrate/m20221230_220003_create_follows.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"follows" 5 | ~schema: 6 | [ 7 | {|account_id BIGINT|}; 8 | {|target_account_id BIGINT|}; 9 | {|uri TEXT|}; 10 | (* *) 11 | {|FOREIGN KEY (account_id) REFERENCES accounts (id) ON UPDATE CASCADE ON DELETE CASCADE|}; 12 | {|FOREIGN KEY (target_account_id) REFERENCES accounts (id) ON UPDATE CASCADE ON DELETE CASCADE|}; 13 | {|UNIQUE (account_id, target_account_id)|}; 14 | ] 15 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | 11 | # ocamlbuild working directory 12 | _build/ 13 | 14 | # ocamlbuild targets 15 | *.byte 16 | *.native 17 | 18 | # oasis generated files 19 | setup.data 20 | setup.log 21 | 22 | # Merlin configuring file for Vim and Emacs 23 | .merlin 24 | 25 | # Dune generated files 26 | *.install 27 | 28 | # Local OPAM switch 29 | _opam/ 30 | 31 | # Written for Waq 32 | /misc/ 33 | e2e/_test* 34 | e2e/_bin 35 | e2e/.kubeconfig 36 | e2e/.env 37 | .direnv 38 | result 39 | .envrc 40 | -------------------------------------------------------------------------------- /lib/migrate/m20230225_173800_create_account_stats.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"account_stats" 5 | ~schema: 6 | [ 7 | {|account_id BIGINT NOT NULL|}; 8 | {|statuses_count BIGINT NOT NULL|}; 9 | {|following_count BIGINT NOT NULL|}; 10 | {|followers_count BIGINT NOT NULL|}; 11 | {|last_status_at TIMESTAMP WITHOUT TIME ZONE|}; 12 | (* *) 13 | {|FOREIGN KEY (account_id) REFERENCES accounts(id) ON DELETE CASCADE|}; 14 | {|UNIQUE (account_id)|}; 15 | ] 16 | -------------------------------------------------------------------------------- /lib/migrate/m20221230_220004_create_follow_requests.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"follow_requests" 5 | ~schema: 6 | [ 7 | {|account_id BIGINT|}; 8 | {|target_account_id BIGINT|}; 9 | {|uri TEXT|}; 10 | (* *) 11 | {|FOREIGN KEY (account_id) REFERENCES accounts (id) ON UPDATE CASCADE ON DELETE CASCADE|}; 12 | {|FOREIGN KEY (target_account_id) REFERENCES accounts (id) ON UPDATE CASCADE ON DELETE CASCADE|}; 13 | {|UNIQUE (account_id, target_account_id)|}; 14 | ] 15 | -------------------------------------------------------------------------------- /lib/migrate/m20230212_175600_create_notifications.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"notifications" 5 | ~schema: 6 | [ 7 | {|activity_id BIGINT NOT NULL|}; 8 | {|activity_type TEXT NOT NULL|}; 9 | {|account_id BIGINT NOT NULL|}; 10 | {|from_account_id BIGINT NOT NULL|}; 11 | {|type TEXT NOT NULL|}; 12 | (* *) 13 | {|FOREIGN KEY (account_id) REFERENCES accounts (id) ON DELETE CASCADE|}; 14 | {|FOREIGN KEY (from_account_id) REFERENCES accounts (id) ON DELETE CASCADE|}; 15 | ] 16 | -------------------------------------------------------------------------------- /lib/controller/users/outbox.ml: -------------------------------------------------------------------------------- 1 | open Helper 2 | 3 | let get _ req = 4 | (* FIXME: Support ?page and ?min_id *) 5 | let username = Yume.Server.param ":name" req in 6 | let acct = Db.e (Model.Account.get_one ~username ~domain:None) in 7 | let id = acct#outbox_url in 8 | let totalItems = Db.(e @@ Status.count ~account_id:(`Eq acct#id)) in 9 | let first = acct#outbox_url ^ "?page=true" in 10 | let last = acct#outbox_url ^ "?min_id=0&page=true" in 11 | Activity.( 12 | make_ordered_collection ~id ~totalItems ~first ~last () 13 | |> ordered_collection |> to_yojson) 14 | |> respond_yojson 15 | -------------------------------------------------------------------------------- /lib/migrate/m20230416_182600_create_web_push_subscriptions.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"web_push_subscriptions" 5 | ~schema: 6 | [ 7 | {|endpoint TEXT NOT NULL|}; 8 | {|key_p256dh TEXT NOT NULL|}; 9 | {|key_auth TEXT NOT NULL|}; 10 | {|access_token_id BIGINT|}; 11 | {|user_id BIGINT|}; 12 | (* *) 13 | {|FOREIGN KEY ( user_id ) REFERENCES users ( id ) ON DELETE CASCADE|}; 14 | {|FOREIGN KEY ( access_token_id ) REFERENCES oauth_access_tokens ( id ) ON DELETE CASCADE|}; 15 | ] 16 | -------------------------------------------------------------------------------- /e2e/src/waq_11_marker.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | let f = 4 | make_waq_scenario @@ fun env token -> 5 | let Some { last_read_id = "0"; _ }, Some { last_read_id = "0"; _ } = 6 | get_markers env ~token `Waq [ "home"; "notifications" ] 7 | in 8 | let Some { last_read_id = "1"; _ }, None = 9 | post_markers env ~token `Waq [ ("home", "1") ] 10 | in 11 | let None, Some { last_read_id = "2"; _ } = 12 | post_markers env ~token `Waq [ ("notifications", "2") ] 13 | in 14 | let Some { last_read_id = "1"; _ }, Some { last_read_id = "2"; _ } = 15 | get_markers env ~token `Waq [ "home"; "notifications" ] 16 | in 17 | () 18 | [@@warning "-8"] 19 | -------------------------------------------------------------------------------- /.github/workflows/test.yaml: -------------------------------------------------------------------------------- 1 | name: Run unit/integration tests 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - master 8 | 9 | permissions: read-all 10 | 11 | jobs: 12 | test: 13 | runs-on: ubuntu-latest 14 | steps: 15 | - name: Checkout tree 16 | uses: actions/checkout@v4 17 | - uses: cachix/install-nix-action@v27 18 | with: 19 | nix_path: nixpkgs=channel:nixos-unstable 20 | - uses: cachix/cachix-action@v14 21 | with: 22 | name: waq 23 | authToken: "${{ secrets.CACHIX_AUTH_TOKEN }}" 24 | - uses: nicknovitski/nix-develop@v1 25 | - run: make test 26 | -------------------------------------------------------------------------------- /lib/worker/account_update.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | let kick env ~account_id ~updated_at = 4 | Job.kick env ~name:__FUNCTION__ @@ fun () -> 5 | let src = Db.e (Model.Account.get_one ~id:account_id) in 6 | let id = src#uri ^ "#updates" ^/ (Ptime.to_int updated_at |> string_of_int) in 7 | let actor = src#uri in 8 | let to_ = [ "https://www.w3.org/ns/activitystreams#Public" ] in 9 | let obj = Activity.(person_of_account src |> person) in 10 | let activity = Activity.(make_update ~id ~actor ~to_ ~obj |> update) in 11 | Db.(e @@ get_remote_followers ~account_id) 12 | |> Db.Account.preferred_inbox_urls 13 | |> List.iter (fun url -> Delivery.kick env ~src ~url ~activity) 14 | -------------------------------------------------------------------------------- /lib/migrate/m20230121_195201_create_oauth_access_tokens.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table_not_model ~table_name:"oauth_access_tokens" 5 | ~schema: 6 | [ 7 | {|id SERIAL PRIMARY KEY|}; 8 | {|token TEXT NOT NULL|}; 9 | {|created_at TIMESTAMP WITHOUT TIME ZONE NOT NULL|}; 10 | {|scopes TEXT|}; 11 | {|application_id BIGINT|}; 12 | {|resource_owner_id BIGINT|}; 13 | (* *) 14 | {|UNIQUE (token)|}; 15 | {|FOREIGN KEY (resource_owner_id) REFERENCES users (id) ON DELETE CASCADE|}; 16 | {|FOREIGN KEY (application_id) REFERENCES oauth_applications (id) ON DELETE CASCADE|}; 17 | ] 18 | -------------------------------------------------------------------------------- /lib/regex.ml: -------------------------------------------------------------------------------- 1 | type group = { offset : int; length : int; substr : string } [@@deriving make] 2 | 3 | let groups_of_substrings sub = 4 | Pcre.get_substrings sub 5 | |> Array.mapi (fun i s -> 6 | (try Some (Pcre.get_substring_ofs sub i) with Not_found -> None) 7 | |> Option.map (fun (off1, off2) -> 8 | make_group ~offset:off1 ~length:(off2 - off1) ~substr:s)) 9 | 10 | let e ptn = Pcre.regexp ptn 11 | 12 | let match_ rex s = 13 | (try Pcre.exec_all ~rex s with Not_found -> [||]) 14 | |> Array.map groups_of_substrings 15 | |> Array.to_list 16 | 17 | let replace rex f s = 18 | let subst sub = f (groups_of_substrings sub) in 19 | Pcre.substitute_substrings ~rex ~subst s 20 | -------------------------------------------------------------------------------- /e2e/src/waq_mstdn_13_v2_search.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | let f = 4 | make_waq_and_mstdn_scenario @@ fun env waq_token _mstdn_token -> 5 | (* Lookup @user1 *) 6 | (match search env `Waq "@user1" with 7 | | [ a ], _, _ -> 8 | assert (a.acct = "user1"); 9 | () 10 | | _ -> assert false); 11 | 12 | (* Lookup @mstdn1@mstdn_server_domain without token, which should fail *) 13 | (match search env `Waq ("@mstdn1@" ^ mstdn_server_domain) with 14 | | [], _, _ -> () 15 | | _ -> assert false); 16 | 17 | (* With token, it will succeed *) 18 | (match 19 | search env `Waq ~token:waq_token ("@mstdn1@" ^ mstdn_server_domain) 20 | with 21 | | [ _ ], _, _ -> () 22 | | _ -> assert false); 23 | 24 | () 25 | -------------------------------------------------------------------------------- /lib_webpush/jwt.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | let build ~aud ~exp ~sub ~priv_key = 4 | let header = 5 | `Assoc [ ("typ", `String "JWT"); ("alg", `String "ES256") ] 6 | |> Yojson.Safe.to_string |> b64_url_encode 7 | in 8 | let payload = 9 | `Assoc [ ("aud", `String aud); ("exp", `Int exp); ("sub", `String sub) ] 10 | |> Yojson.Safe.to_string |> b64_url_encode 11 | in 12 | let header_dot_payload = header ^ "." ^ payload in 13 | let signature = 14 | header_dot_payload |> Digestif.SHA256.digest_string 15 | |> Digestif.SHA256.to_raw_string 16 | |> Mirage_crypto_ec.P256.Dsa.sign ~key:priv_key 17 | |> (fun (r, s) -> r ^ s) 18 | |> b64_url_encode 19 | in 20 | header_dot_payload ^ "." ^ signature 21 | -------------------------------------------------------------------------------- /lib_sqlx/test/common.ml: -------------------------------------------------------------------------------- 1 | let with_postgres ~container_name ~host_port f = 2 | match 3 | Unix.system 4 | ("docker run -d --rm --name " ^ container_name 5 | ^ " -e POSTGRES_PASSWORD=password -p 127.0.0.1:" ^ string_of_int host_port 6 | ^ ":5432 postgres:16 &> /dev/null") 7 | with 8 | | Unix.WEXITED 0 -> 9 | Unix.sleep 20; 10 | Fun.protect 11 | ~finally:(fun () -> 12 | Unix.system ("docker stop " ^ container_name ^ " &> /dev/null") 13 | |> ignore) 14 | (fun () -> 15 | let dsn = 16 | "postgresql://postgres:password@localhost:" 17 | ^ string_of_int host_port ^ "/postgres" 18 | in 19 | f dsn) 20 | | _ -> assert false 21 | -------------------------------------------------------------------------------- /lib/migrate/m20221230_220000_create_accounts.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"accounts" 5 | ~schema: 6 | [ 7 | "username TEXT NOT NULL"; 8 | "domain TEXT"; 9 | "private_key TEXT"; 10 | "public_key TEXT NOT NULL"; 11 | "display_name TEXT NOT NULL"; 12 | "uri TEXT NOT NULL"; 13 | "url TEXT"; 14 | "inbox_url TEXT NOT NULL"; 15 | "outbox_url TEXT NOT NULL"; 16 | "shared_inbox_url TEXT NOT NULL"; 17 | "followers_url TEXT NOT NULL"; 18 | ] 19 | *> create_index ~name:"index_accounts_20221230_220000" ~table_name:"accounts" 20 | ~schema:[ "LOWER(username)"; "COALESCE(LOWER(domain), '')" ] 21 | -------------------------------------------------------------------------------- /lib/migrate/m20230427_204200_create_preview_cards.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"preview_cards" 5 | ~schema: 6 | [ 7 | {|url TEXT NOT NULL|}; 8 | {|title TEXT NOT NULL|}; 9 | {|description TEXT NOT NULL|}; 10 | {|image_url TEXT|}; 11 | {|type INT NOT NULL|}; 12 | {|html TEXT NOT NULL|}; 13 | {|author_name TEXT NOT NULL|}; 14 | {|author_url TEXT NOT NULL|}; 15 | {|provider_name TEXT NOT NULL|}; 16 | {|provider_url TEXT NOT NULL|}; 17 | {|width INT NOT NULL|}; 18 | {|height INT NOT NULL|}; 19 | {|embed_url TEXT NOT NULL|}; 20 | (* *) 21 | {|UNIQUE ( url )|}; 22 | ] 23 | -------------------------------------------------------------------------------- /lib/migrate/m20221230_220002_create_statuses.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table ~table_name:"statuses" 5 | ~schema: 6 | [ 7 | {|uri TEXT NOT NULL|}; 8 | {|text TEXT NOT NULL|}; 9 | {|deleted_at TIMESTAMP WITHOUT TIME ZONE|}; 10 | {|in_reply_to_id BIGINT|}; 11 | {|reblog_of_id BIGINT|}; 12 | {|account_id BIGINT NOT NULL|}; 13 | (* *) 14 | {|FOREIGN KEY (account_id) REFERENCES accounts (id) ON UPDATE CASCADE ON DELETE CASCADE|}; 15 | {|FOREIGN KEY (in_reply_to_id) REFERENCES statuses (id) ON DELETE SET NULL|}; 16 | {|FOREIGN KEY (reblog_of_id) REFERENCES statuses (id) ON DELETE CASCADE|}; 17 | {|UNIQUE (uri)|}; 18 | ] 19 | -------------------------------------------------------------------------------- /test/test_ogp_youtube.json: -------------------------------------------------------------------------------- 1 | {"title":"\u266a Brand New Friend (Christmas Song!)","author_name":"YOGSCAST Lewis \u0026 Simon","author_url":"https://www.youtube.com/@yogscast","type":"video","height":113,"width":200,"version":"1.0","provider_name":"YouTube","provider_url":"https://www.youtube.com/","thumbnail_height":360,"thumbnail_width":480,"thumbnail_url":"https://i.ytimg.com/vi/OMv_EPMED8Y/hqdefault.jpg","html":"\u003ciframe width=\u0022200\u0022 height=\u0022113\u0022 src=\u0022https://www.youtube.com/embed/OMv_EPMED8Y?feature=oembed\u0022 frameborder=\u00220\u0022 allow=\u0022accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture; web-share\u0022 allowfullscreen title=\u0022\u266a Brand New Friend (Christmas Song!)\u0022\u003e\u003c/iframe\u003e"} -------------------------------------------------------------------------------- /nix/kneesocks.nix: -------------------------------------------------------------------------------- 1 | { 2 | makeWrapper, 3 | stdenv, 4 | fetchFromGitHub, 5 | }: 6 | stdenv.mkDerivation { 7 | name = "kneesocks"; 8 | src = fetchFromGitHub { 9 | owner = "inaz2"; 10 | repo = "kneesocks"; 11 | rev = "e54c447fa1a98af67872a08db18e3f0d1a2cd311"; 12 | hash = "sha256-XUJGLIrQU0NjCOaWGT9etm/A6j08XMoIYB61tlu21dY="; 13 | }; 14 | nativeBuildInputs = [makeWrapper]; 15 | buildPhase = '' 16 | cc -O2 -Wall -Werror -shared -fPIC -o libkneesocks.so libkneesocks.c -ldl 17 | ''; 18 | installPhase = '' 19 | install -D -m 755 kneesocks $out/bin/kneesocks 20 | install -D -m 644 libkneesocks.so $out/lib/kneesocks/libkneesocks.so 21 | 22 | wrapProgram $out/bin/kneesocks --prefix LD_LIBRARY_PATH : $out/lib/kneesocks 23 | ''; 24 | } 25 | -------------------------------------------------------------------------------- /.github/workflows/e2e-test.yaml: -------------------------------------------------------------------------------- 1 | name: Run e2e tests 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - master 8 | 9 | permissions: read-all 10 | 11 | jobs: 12 | e2e-test: 13 | runs-on: ubuntu-latest 14 | steps: 15 | - name: Checkout tree 16 | uses: actions/checkout@v4 17 | - uses: cachix/install-nix-action@v27 18 | with: 19 | nix_path: nixpkgs=channel:nixos-unstable 20 | - uses: cachix/cachix-action@v14 21 | with: 22 | name: waq 23 | authToken: "${{ secrets.CACHIX_AUTH_TOKEN }}" 24 | - uses: nicknovitski/nix-develop@v1 25 | - run: make -C e2e create-cluster 26 | - run: make -C e2e test 27 | - run: make -C e2e logs-deploy-waq-web 28 | if: always() 29 | -------------------------------------------------------------------------------- /lib/migrate/m20230122_183000_create_oauth_access_grants.ml: -------------------------------------------------------------------------------- 1 | open Sqlx.Migration.Helper 2 | 3 | let change = 4 | create_table_not_model ~table_name:"oauth_access_grants" 5 | ~schema: 6 | [ 7 | {|id SERIAL PRIMARY KEY|}; 8 | {|token TEXT NOT NULL|}; 9 | {|expires_in INTEGER NOT NULL|}; 10 | {|redirect_uri TEXT NOT NULL|}; 11 | {|created_at TIMESTAMP WITHOUT TIME ZONE NOT NULL|}; 12 | {|scopes TEXT|}; 13 | {|application_id BIGINT|}; 14 | {|resource_owner_id BIGINT|}; 15 | (* *) 16 | {|UNIQUE (token)|}; 17 | {|FOREIGN KEY (resource_owner_id) REFERENCES users (id) ON DELETE CASCADE|}; 18 | {|FOREIGN KEY (application_id) REFERENCES oauth_applications (id) ON DELETE CASCADE|}; 19 | ] 20 | -------------------------------------------------------------------------------- /test/test_regex.ml: -------------------------------------------------------------------------------- 1 | open Waq 2 | open Regex 3 | 4 | let test_replace () = 5 | let r = replace in 6 | assert ( 7 | "foo bar baz baz" |> r (e "baz") (fun _ -> "2000") = "foo bar 2000 2000"); 8 | () 9 | 10 | let test_match () = 11 | let m = match_ in 12 | assert ( 13 | m (e "a") "a" = [ [| Some { offset = 0; length = 1; substr = "a" } |] ]); 14 | assert ( 15 | m (e "a(b)") "ab" 16 | = [ 17 | [| 18 | Some { offset = 0; length = 2; substr = "ab" }; 19 | Some { offset = 1; length = 1; substr = "b" }; 20 | |]; 21 | ]); 22 | () 23 | 24 | let () = 25 | let open Alcotest in 26 | run "regex" 27 | [ 28 | ("replace", [ test_case "case1" `Quick test_replace ]); 29 | ("match", [ test_case "case1" `Quick test_match ]); 30 | ] 31 | -------------------------------------------------------------------------------- /lib/controller/root.ml: -------------------------------------------------------------------------------- 1 | open Helper 2 | 3 | let get _ _req = 4 | let open Jingoo.Jg_types in 5 | let models = [ ("server_name", Tstr (Config.server_name ())) ] in 6 | {| 7 | 8 | 9 | 10 | 11 | {{ server_name }} - Waq 12 | 13 | 14 | 15 |

{{ server_name }} - Waq

16 |

Waq is a pretty new ActivityPub (AP) server implementation written in OCaml. Please let me (@anqou@mstdn.anqou.net) know if you encounter any problems with Waq, especially when communicating with other AP server implementations.

17 | 18 | 19 | |} 20 | |> Jingoo.Jg_template.from_string ~models 21 | |> String.trim |> respond_html 22 | -------------------------------------------------------------------------------- /e2e/src/waq_mstdn_18_account.ml: -------------------------------------------------------------------------------- 1 | open Common2 2 | 3 | let f env (a0 : agent) = 4 | (* Check /api/v1/accounts/:id/statuses *) 5 | let s0 = post env a0 ~content:"てすと" () in 6 | 7 | let ss = get_account_statuses env a0 s0.account.id in 8 | assert (List.length ss = 1); 9 | assert ((List.hd ss).id = s0.id); 10 | 11 | let ss = get_account_statuses env a0 ~pinned:true s0.account.id in 12 | assert (List.length ss = 0); 13 | 14 | () 15 | 16 | let f_waq = 17 | make_waq_scenario @@ fun env token -> 18 | let a0 = 19 | make_agent ~kind:`Waq ~token ~username:"user1" ~domain:waq_server_domain 20 | in 21 | f env a0 22 | 23 | let f_mstdn = 24 | make_mstdn_scenario @@ fun env token -> 25 | let a0 = 26 | make_agent ~kind:`Mstdn ~token ~username:"user1" ~domain:mstdn_server_domain 27 | in 28 | f env a0 29 | -------------------------------------------------------------------------------- /test/test_model.ml: -------------------------------------------------------------------------------- 1 | open Waq.Model 2 | 3 | let test_sort_statuses_by_dfs () = 4 | let make_status ~id ?in_reply_to_id () = 5 | Status.make ~spoiler_text:"" ~account_id:(Account.ID.of_int 0) ~text:"" 6 | ~uri:"" ~id:(Status.ID.of_int id) 7 | ?in_reply_to_id:(in_reply_to_id |> Option.map Status.ID.of_int) 8 | () 9 | in 10 | let s0 = make_status ~id:0 () in 11 | let s1 = make_status ~id:1 ~in_reply_to_id:0 () in 12 | let s2 = make_status ~id:2 ~in_reply_to_id:1 () in 13 | assert (Status.sort_statuses_by_dfs s0#id [ s0 ] = [ s0 ]); 14 | assert (Status.sort_statuses_by_dfs s1#id [ s2 ] = [ s2 ]); 15 | 16 | () 17 | 18 | let () = 19 | let open Alcotest in 20 | run "model" 21 | [ 22 | ( "sort_statuses_by_dfs", 23 | [ test_case "case1" `Quick test_sort_statuses_by_dfs ] ); 24 | ] 25 | -------------------------------------------------------------------------------- /lib_webpush/test/test_webpush.ml: -------------------------------------------------------------------------------- 1 | open Webpush 2 | 3 | let test_main_case1 () = 4 | let endpoint = "https://updates.push.services.mozilla.com/wpush/v2/gAAAAA" in 5 | let subscriber = "mailto:example@example.com" in 6 | let vapid_priv_key = "IQ9Ur0ykXoHS9gzfYX0aBjy9lvdrjx_PFUXmie9YRcY" in 7 | let p256dh_key = 8 | "BNNL5ZaTfK81qhXOx23-wewhigUeFb632jN6LvRWCFH1ubQr77FE_9qV1FuojuRmHP42zmf34rXgW80OvUVDgTk" 9 | in 10 | let auth_key = "zqbxT6JKstKSY9JKibZLSQ" in 11 | let message = "Test" in 12 | match 13 | construct_request ~message ~auth_key ~p256dh_key ~subscriber ~endpoint 14 | ~vapid_priv_key 15 | with 16 | | Error _ -> assert false 17 | | Ok _ -> () 18 | 19 | let () = 20 | let open Alcotest in 21 | Mirage_crypto_rng_unix.use_default (); 22 | run "webpush" [ ("main", [ test_case "case1" `Quick test_main_case1 ]) ] 23 | -------------------------------------------------------------------------------- /lib_sqlx/connection.ml: -------------------------------------------------------------------------------- 1 | class type t = object ('a) 2 | method query : 3 | ?p:Value.null_t list -> string -> (string * Value.t) list list Lwt.t 4 | 5 | method query_row : 6 | ?p:Value.null_t list -> string -> (string * Value.t) list Lwt.t 7 | 8 | method execute : ?p:Value.null_t list -> string -> unit Lwt.t 9 | 10 | method named_query : 11 | ?p:(string * Value.null_t) list -> 12 | string -> 13 | (string * Value.t) list list Lwt.t 14 | 15 | method named_query_row : 16 | ?p:(string * Value.null_t) list -> string -> (string * Value.t) list Lwt.t 17 | 18 | method named_execute : ?p:(string * Value.null_t) list -> string -> unit Lwt.t 19 | method enqueue_task_after_commit : ('a -> unit Lwt.t) -> unit Lwt.t 20 | method transaction : ('a -> unit Lwt.t) -> bool Lwt.t 21 | (*method enqueued_tasks_after_commit : ('a -> unit Lwt.t) list*) 22 | end 23 | -------------------------------------------------------------------------------- /e2e/src/waq_10_mention.ml: -------------------------------------------------------------------------------- 1 | open Common 2 | 3 | let f = 4 | make_waq_scenario @@ fun env token -> 5 | let user1_id, _, _ = lookup env `Waq ~token ~username:"user1" () in 6 | let token2 = fetch_access_token env ~username:"user2" in 7 | let ({ id; _ } : status) = post env `Waq ~token ~content:"@user2 てすと" () in 8 | 9 | let ntfs = get_notifications env `Waq ~token:token2 in 10 | (match ntfs with 11 | | [ 12 | { 13 | typ = "mention"; 14 | account = { id = account_id; _ }; 15 | status = Some { id = status_id; _ }; 16 | _; 17 | }; 18 | ] -> 19 | assert (account_id = user1_id); 20 | assert (status_id = id); 21 | () 22 | | _ -> assert false); 23 | 24 | (* Handle invalid mentions correctly *) 25 | let _ = post env `Waq ~token ~content:"@not_found_user test" () in 26 | home_timeline env `Waq ~token |> ignore; 27 | 28 | () 29 | -------------------------------------------------------------------------------- /lib/controller/nodeinfo.ml: -------------------------------------------------------------------------------- 1 | open Helper 2 | 3 | let get_2_0 _ _req = 4 | (* FIXME: Fill in correct values *) 5 | `Assoc 6 | [ 7 | ("version", `String "2.0"); 8 | ( "software", 9 | `Assoc [ ("name", `String "waq"); ("version", `String "0.1.0") ] ); 10 | ("protocols", `List [ `String "activitypub" ]); 11 | ("services", `Assoc [ ("outbound", `List []); ("inbound", `List []) ]); 12 | ( "usage", 13 | `Assoc 14 | [ 15 | ( "users", 16 | `Assoc 17 | [ 18 | ("total", `Int 1); 19 | ("activeMonth", `Int 1); 20 | ("activeHalfyear", `Int 1); 21 | ] ); 22 | ("localPosts", `Int 1); 23 | ] ); 24 | ("openRegistrations", `Bool false); 25 | ("metadata", `Assoc []); 26 | ] 27 | |> respond_yojson 28 | -------------------------------------------------------------------------------- /e2e/manifests/elk.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | apiVersion: v1 3 | kind: Service 4 | metadata: 5 | name: elk 6 | namespace: e2e 7 | spec: 8 | selector: 9 | app: elk 10 | ports: 11 | - port: 5314 12 | --- 13 | apiVersion: apps/v1 14 | kind: Deployment 15 | metadata: 16 | name: elk 17 | namespace: e2e 18 | spec: 19 | replicas: 1 20 | selector: 21 | matchLabels: 22 | app: elk 23 | template: 24 | metadata: 25 | labels: 26 | app: elk 27 | spec: 28 | containers: 29 | - name: elk 30 | image: ghcr.io/elk-zone/elk:v0.12.1 31 | imagePullPolicy: IfNotPresent 32 | ports: 33 | - name: http 34 | containerPort: 5314 35 | protocol: TCP 36 | volumeMounts: 37 | - mountPath: /elk/data 38 | name: data 39 | volumes: 40 | - name: data 41 | emptyDir: {} 42 | -------------------------------------------------------------------------------- /lib/controller/api_v1/apps/root.ml: -------------------------------------------------------------------------------- 1 | type res = { 2 | id : string; 3 | name : string; 4 | website : string option; 5 | redirect_uri : string; 6 | vapid_key : string; 7 | client_id : string; 8 | client_secret : string; 9 | } 10 | [@@deriving make, yojson] 11 | 12 | let post _ req = 13 | let client_name = req |> Yume.Server.query "client_name" in 14 | let redirect_uris = req |> Yume.Server.query "redirect_uris" in 15 | let scopes = req |> Yume.Server.query ~default:"read" "scopes" in 16 | 17 | let app = 18 | Oauth_helper.generate_application ~name:client_name 19 | ~redirect_uri:redirect_uris ~scopes 20 | in 21 | make_res 22 | ~id:(app#id |> Model.OAuthApplication.ID.to_int |> string_of_int) 23 | ~name:app#name ~redirect_uri:app#redirect_uri ~client_id:app#uid 24 | ~client_secret:app#secret 25 | ~vapid_key:(Config.vapid_public_key ()) 26 | () 27 | |> yojson_of_res |> Helper.respond_yojson 28 | -------------------------------------------------------------------------------- /lib/controller/api_v1/statuses/unreblog.ml: -------------------------------------------------------------------------------- 1 | open Helper 2 | open Entity 3 | 4 | let post env req = 5 | let self = authenticate_account req in 6 | let status_id = 7 | req |> Yume.Server.param ":id" |> int_of_string |> Model.Status.ID.of_int 8 | in 9 | try 10 | let status = Db.e (Model.Status.get_one ~id:status_id) in 11 | let reblog = 12 | Db.( 13 | e 14 | Model.Status.( 15 | get_one ~reblog_of_id:(Some status_id) ~account_id:self#id)) 16 | in 17 | let entity = make_status_from_model ~self_id:self#id status in 18 | Worker.Removal.kick env ~account_id:self#id ~status_id:reblog#id; 19 | let entity = 20 | { 21 | entity with 22 | reblogged = Some false; 23 | reblogs_count = entity.reblogs_count - 1; 24 | } 25 | in 26 | yojson_of_status entity |> respond_yojson 27 | with Sqlx.Error.NoRowFound -> Yume.Server.raise_error_response `Not_found 28 | -------------------------------------------------------------------------------- /lib_webpush/test/test_vapid.ml: -------------------------------------------------------------------------------- 1 | open Webpush 2 | 3 | let test_main_case1 () = 4 | (* Thanks to: https://github.com/pimeys/rust-web-push/blob/c5a8e1250b3fc85c5005dcb321e01ba4253b584d/src/vapid/builder.rs#L351-L362 *) 5 | let endpoint = 6 | "https://updates.push.services.mozilla.com/wpush/v2/gAAAAABaso4Vajy4STM25r5y5oFfyN451rUmES6mhQngxABxbZB5q_o75WpG25oKdrlrh9KdgWFKdYBc-buLPhvCTqR5KdsK8iCZHQume-ndtZJWKOgJbQ20GjbxHmAT1IAv8AIxTwHO-JTQ2Np2hwkKISp2_KUtpnmwFzglLP7vlCd16hTNJ2I" 7 | in 8 | let subscriber = "mailto:example@example.com" in 9 | let priv_key = "IQ9Ur0ykXoHS9gzfYX0aBjy9lvdrjx_PFUXmie9YRcY" in 10 | match Vapid.build ~endpoint ~subscriber ~priv_key with 11 | | Error _ -> assert false 12 | | Ok r -> 13 | assert ( 14 | r.k 15 | = "BMjQIp55pdbU8pfCBKyXcZjlmER_mXt5LqNrN1hrXbdBS5EnhIbMu3Au-RV53iIpztzNXkGI56BFB1udQ8Bq_H4") 16 | 17 | let () = 18 | let open Alcotest in 19 | run "vapid" [ ("main", [ test_case "case1" `Quick test_main_case1 ]) ] 20 | -------------------------------------------------------------------------------- /test/test_util.ml: -------------------------------------------------------------------------------- 1 | open Waq.Util 2 | 3 | let test_iota () = assert (iota 10 = [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 ]) 4 | 5 | let test_take () = 6 | assert (List.take 0 [ 0; 1; 2; 3 ] = []); 7 | assert (List.take 1 [ 0; 1; 2; 3 ] = [ 0 ]); 8 | assert (List.take 2 [ 0; 1; 2; 3; 4; 5 ] = [ 0; 1 ]) 9 | 10 | let test_lwt_list_partition_map_p () = 11 | let left, right = 12 | Lwt_main.run 13 | ([ 1; 2; 3; 4; 5 ] 14 | |> Lwt_list.partition_map_p (fun x -> 15 | if x mod 2 = 0 then Either.Left x |> Lwt.return 16 | else Either.Right x |> Lwt.return)) 17 | in 18 | assert (left = [ 2; 4 ]); 19 | assert (right = [ 1; 3; 5 ]); 20 | () 21 | 22 | let () = 23 | let open Alcotest in 24 | run "util" 25 | [ 26 | ("iota", [ test_case "case1" `Quick test_iota ]); 27 | ("take", [ test_case "case1" `Quick test_take ]); 28 | ( "lwt_list_partition_map_p", 29 | [ test_case "case1" `Quick test_lwt_list_partition_map_p ] ); 30 | ] 31 | -------------------------------------------------------------------------------- /lib/controller/static.ml: -------------------------------------------------------------------------------- 1 | open Helper 2 | 3 | let get_content_type = function 4 | | ".html" | ".htm" -> "text/html" 5 | | ".png" -> "image/png" 6 | | ".jpg" | ".jpeg" -> "image/jpeg" 7 | | _ -> raise_error_response `Not_found 8 | 9 | let get_body path = 10 | (* FIXME: Use stream *) 11 | try 12 | let ic = open_in_bin path in 13 | let s = In_channel.input_all ic in 14 | close_in ic; 15 | s 16 | with _ -> raise_error_response `Not_found 17 | 18 | let get _ req = 19 | let root = Config.static_root () |> Unix.realpath in 20 | let path = 21 | try Filename.concat root (Yume.Server.path req) |> Unix.realpath 22 | with Unix.Unix_error (Unix.ENOENT, "realpath", _) -> 23 | raise_error_response `Not_found 24 | in 25 | if not (String.starts_with ~prefix:root path) then 26 | raise_error_response `Not_found 27 | else 28 | Yume.Server.respond 29 | ~headers:[ (`Content_type, Filename.extension path |> get_content_type) ] 30 | (get_body path) 31 | -------------------------------------------------------------------------------- /e2e/manifests/jaeger.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | apiVersion: v1 3 | kind: Namespace 4 | metadata: 5 | name: jaeger 6 | --- 7 | apiVersion: apps/v1 8 | kind: Deployment 9 | metadata: 10 | name: jaeger 11 | namespace: jaeger 12 | spec: 13 | replicas: 1 14 | selector: 15 | matchLabels: 16 | app: jaeger 17 | template: 18 | metadata: 19 | labels: 20 | app: jaeger 21 | spec: 22 | containers: 23 | - name: jaeger 24 | image: jaegertracing/all-in-one:1.66.0 25 | imagePullPolicy: IfNotPresent 26 | ports: 27 | - name: otel-http 28 | containerPort: 4318 29 | protocol: TCP 30 | - name: web-ui 31 | containerPort: 16686 32 | protocol: TCP 33 | --- 34 | apiVersion: v1 35 | kind: Service 36 | metadata: 37 | name: jaeger 38 | namespace: jaeger 39 | spec: 40 | ports: 41 | - port: 4318 42 | name: otel-http 43 | - port: 16686 44 | name: web-ui 45 | selector: 46 | app: jaeger 47 | -------------------------------------------------------------------------------- /lib/controller/users/following.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | open Helper 3 | 4 | let get_followers _env req = 5 | (* FIXME: Support ?page and ?min_id *) 6 | let username = Yume.Server.param ":name" req in 7 | let acct = Db.e (Model.Account.get_one ~username ~domain:None) in 8 | let id = acct#followers_url in 9 | let totalItems = Db.(e @@ count_followers ~account_id:acct#id) in 10 | let first = acct#followers_url ^ "?page=1" in 11 | Activity.( 12 | make_ordered_collection ~id ~totalItems ~first () 13 | |> ordered_collection |> to_yojson) 14 | |> respond_yojson 15 | 16 | let get_following _env req = 17 | (* FIXME: Support ?page and ?min_id *) 18 | let username = Yume.Server.param ":name" req in 19 | let acct = Db.e (Model.Account.get_one ~username ~domain:None) in 20 | let id = acct#uri ^/ "following" in 21 | let totalItems = Db.(e @@ count_following ~account_id:acct#id) in 22 | let first = id ^ "?page=1" in 23 | Activity.( 24 | make_ordered_collection ~id ~totalItems ~first () 25 | |> ordered_collection |> to_yojson) 26 | |> respond_yojson 27 | -------------------------------------------------------------------------------- /test/test_ogp_flickr.json: -------------------------------------------------------------------------------- 1 | {"type":"photo","flickr_type":"photo","title":"Oregon","author_name":"Tom Fenske Photography","author_url":"https:\/\/www.flickr.com\/photos\/tomfenskephotography\/","width":1024,"height":427,"url":"https:\/\/live.staticflickr.com\/65535\/49088768431_6a4322b3bb_b.jpg","web_page":"https:\/\/www.flickr.com\/photos\/tomfenskephotography\/49088768431\/","thumbnail_url":"https:\/\/live.staticflickr.com\/65535\/49088768431_6a4322b3bb_q.jpg","thumbnail_width":150,"thumbnail_height":150,"web_page_short_url":"https:\/\/flic.kr\/p\/2hMNLCp","license":"All Rights Reserved","license_id":0,"html":"\"Oregon\"<\/a>