From 50975c03ca59c0828e1caf4b28d4d283aa373f77 Mon Sep 17 00:00:00 2001 From: kengirie Date: Wed, 6 May 2026 01:31:14 -0700 Subject: [PATCH] feat: Add GET /list/ endpoint (BUD-12) Co-Authored-By: Claude Opus 4.7 (1M context) --- e2e/dune | 2 +- e2e/main.ml | 3 + e2e/nostr_signer.ml | 22 +++ e2e/test_list.ml | 282 +++++++++++++++++++++++++++++++++++++ lib/core/auth.ml | 3 +- lib/shell/blossom_db.ml | 48 +++++++ lib/shell/db_intf.ml | 14 ++ lib/shell/http_response.ml | 21 ++- lib/shell/http_server.ml | 69 ++++++++- test/test_http_response.ml | 54 +++++++ 10 files changed, 512 insertions(+), 6 deletions(-) create mode 100644 e2e/test_list.ml diff --git a/e2e/dune b/e2e/dune index f1c9362..a2b9a02 100644 --- a/e2e/dune +++ b/e2e/dune @@ -1,6 +1,6 @@ (library (name e2e) - (modules config nostr_signer http_client test_upload test_delete test_cors test_get test_head_upload test_mirror) + (modules config nostr_signer http_client test_upload test_delete test_cors test_get test_head_upload test_mirror test_list) (libraries blossoML.core piaf diff --git a/e2e/main.ml b/e2e/main.ml index 7134e72..9ed96b7 100644 --- a/e2e/main.ml +++ b/e2e/main.ml @@ -35,4 +35,7 @@ let () = Eio.traceln "\nMirror Tests (BUD-04):"; List.iter (run_test ~sw ~env) E2e.Test_mirror.tests; + Eio.traceln "\nList Tests (BUD-12):"; + List.iter (run_test ~sw ~env) E2e.Test_list.tests; + Eio.traceln "\nDone." diff --git a/e2e/nostr_signer.ml b/e2e/nostr_signer.ml index 4083b91..c834cf3 100644 --- a/e2e/nostr_signer.ml +++ b/e2e/nostr_signer.ml @@ -77,6 +77,28 @@ let create_delete_auth ~keypair ~sha256 ~created_at ~expiration = | Ok (sig_, _) -> { Nostr_event.id; pubkey = keypair.pubkey; created_at; kind; tags; content; sig_ } +(** Create a BUD-12 list authentication event (kind 24242). + The event authorizes listing blobs for the requesting pubkey. *) +let create_list_auth ~keypair ~created_at ~expiration = + let created_at = Int64.of_float created_at in + let tags = [ + ["t"; "list"]; + ["expiration"; Int64.to_string expiration]; + ] in + let content = "List blobs" in + let kind = 24242 in + let id = Nostr_event.compute_id + ~pubkey:keypair.pubkey + ~created_at + ~kind + ~tags + ~content + in + match Bip340.sign ~secret_key:keypair.secret_key ~msg:id with + | Error _ -> failwith "Failed to sign list auth event" + | Ok (sig_, _) -> + { Nostr_event.id; pubkey = keypair.pubkey; created_at; kind; tags; content; sig_ } + (** Convert a Nostr event to JSON string. *) let event_to_json event = let open Nostr_event in diff --git a/e2e/test_list.ml b/e2e/test_list.ml new file mode 100644 index 0000000..1034fcc --- /dev/null +++ b/e2e/test_list.ml @@ -0,0 +1,282 @@ +(** E2E tests for BUD-12 GET /list/. *) + +let sha256_hex content = + let hash = Digestif.SHA256.digest_string content in + Digestif.SHA256.to_hex hash + +(** Upload a single blob with the given keypair. Returns the response sha256. *) +let upload_blob ~sw ~env ~keypair ~content ~now = + let base_url = Config.base_url in + let sha256 = sha256_hex content in + let expiration = Int64.of_float (now +. 3600.) in + let auth_event = Nostr_signer.create_upload_auth ~keypair ~sha256 ~created_at:now ~expiration in + let auth_header = Nostr_signer.to_auth_header auth_event in + let upload_url = base_url ^ "/upload" in + let result = Http_client.put + ~sw ~env + ~url:upload_url + ~headers:[ + ("Authorization", auth_header); + ("Content-Type", "application/octet-stream"); + ] + ~body:content + () + in + match result with + | Error e -> failwith ("Upload failed: " ^ e) + | Ok response -> + if response.status <> 200 then + failwith (Printf.sprintf "Upload returned %d: %s" response.status response.body); + let json = Yojson.Safe.from_string response.body in + match json with + | `Assoc fields -> + (match List.assoc_opt "sha256" fields with + | Some (`String s) -> s + | _ -> failwith "No sha256 in upload response") + | _ -> failwith "Invalid upload response" + +(** Parse list response body into list of (sha256, size, type, uploaded). *) +let parse_list_response body = + let json = Yojson.Safe.from_string body in + match json with + | `List items -> + List.map (fun item -> + match item with + | `Assoc fields -> + let sha = match List.assoc_opt "sha256" fields with + | Some (`String s) -> s | _ -> failwith "missing sha256" + in + let size = match List.assoc_opt "size" fields with + | Some (`Int n) -> n | _ -> failwith "missing size" + in + let typ = match List.assoc_opt "type" fields with + | Some (`String s) -> s | _ -> failwith "missing type" + in + let uploaded = match List.assoc_opt "uploaded" fields with + | Some (`Int n) -> n | _ -> failwith "missing uploaded" + in + let url = match List.assoc_opt "url" fields with + | Some (`String s) -> s | _ -> failwith "missing url" + in + (sha, size, typ, uploaded, url) + | _ -> failwith "list item not an object" + ) items + | _ -> failwith "list response is not an array" + +(** Test: upload 3 blobs for the same pubkey and list them. *) +let test_list_returns_owned_blobs ~sw ~env = + let base_url = Config.base_url in + let clock = Eio.Stdenv.clock env in + let now = Eio.Time.now clock in + + let keypair = Nostr_signer.generate_keypair () in + let _ = upload_blob ~sw ~env ~keypair ~content:("list-test-1-" ^ string_of_float now) ~now in + let _ = upload_blob ~sw ~env ~keypair ~content:("list-test-2-" ^ string_of_float now) ~now in + let _ = upload_blob ~sw ~env ~keypair ~content:("list-test-3-" ^ string_of_float now) ~now in + + let list_url = base_url ^ "/list/" ^ keypair.pubkey in + let result = Http_client.get ~sw ~env ~url:list_url () in + match result with + | Error e -> failwith ("List failed: " ^ e) + | Ok response -> + if response.status <> 200 then + failwith (Printf.sprintf "List returned %d: %s" response.status response.body); + let items = parse_list_response response.body in + if List.length items < 3 then + failwith (Printf.sprintf "Expected >= 3 items, got %d" (List.length items)); + (* Verify URL is fully-qualified and includes base_url *) + let (_, _, _, _, first_url) = List.hd items in + if String.length first_url < String.length base_url + || String.sub first_url 0 (String.length base_url) <> base_url then + failwith (Printf.sprintf "URL should start with base_url, got: %s" first_url); + (* Verify uploaded is descending *) + let uploaded_values = List.map (fun (_, _, _, u, _) -> u) items in + let rec is_desc = function + | [] | [_] -> true + | a :: (b :: _ as rest) -> a >= b && is_desc rest + in + if not (is_desc uploaded_values) then + failwith "List is not sorted by uploaded DESC" + +(** Test: list for an unknown pubkey returns empty array. *) +let test_list_unknown_pubkey ~sw ~env = + let base_url = Config.base_url in + let unknown_pubkey = String.make 64 'a' in + let list_url = base_url ^ "/list/" ^ unknown_pubkey in + let result = Http_client.get ~sw ~env ~url:list_url () in + match result with + | Error e -> failwith ("List failed: " ^ e) + | Ok response -> + if response.status <> 200 then + failwith (Printf.sprintf "Expected 200, got %d" response.status); + let items = parse_list_response response.body in + if List.length items <> 0 then + failwith (Printf.sprintf "Expected empty list, got %d items" (List.length items)) + +(** Test: list with malformed pubkey returns 400. *) +let test_list_invalid_pubkey ~sw ~env = + let base_url = Config.base_url in + let list_url = base_url ^ "/list/not-a-hex-pubkey" in + let result = Http_client.get ~sw ~env ~url:list_url () in + match result with + | Error e -> failwith ("Request failed: " ^ e) + | Ok response -> + if response.status <> 400 then + failwith (Printf.sprintf "Expected 400, got %d" response.status) + +(** Test: list with limit and cursor pagination returns expected slices. *) +let test_list_cursor_pagination ~sw ~env = + let base_url = Config.base_url in + let clock = Eio.Stdenv.clock env in + let now = Eio.Time.now clock in + + let keypair = Nostr_signer.generate_keypair () in + let _ = upload_blob ~sw ~env ~keypair ~content:("list-cursor-1-" ^ string_of_float now) ~now in + let _ = upload_blob ~sw ~env ~keypair ~content:("list-cursor-2-" ^ string_of_float now) ~now in + let _ = upload_blob ~sw ~env ~keypair ~content:("list-cursor-3-" ^ string_of_float now) ~now in + + (* First page: limit=2 *) + let url1 = Printf.sprintf "%s/list/%s?limit=2" base_url keypair.pubkey in + let r1 = Http_client.get ~sw ~env ~url:url1 () in + let items1 = match r1 with + | Error e -> failwith ("First page failed: " ^ e) + | Ok response -> + if response.status <> 200 then + failwith (Printf.sprintf "First page returned %d" response.status); + parse_list_response response.body + in + if List.length items1 <> 2 then + failwith (Printf.sprintf "First page expected 2 items, got %d" (List.length items1)); + + (* Second page: cursor = last sha256 of first page *) + let (last_sha, _, _, _, _) = List.nth items1 1 in + let url2 = Printf.sprintf "%s/list/%s?limit=2&cursor=%s" base_url keypair.pubkey last_sha in + let r2 = Http_client.get ~sw ~env ~url:url2 () in + let items2 = match r2 with + | Error e -> failwith ("Second page failed: " ^ e) + | Ok response -> + if response.status <> 200 then + failwith (Printf.sprintf "Second page returned %d: %s" response.status response.body); + parse_list_response response.body + in + if List.length items2 < 1 then + failwith (Printf.sprintf "Second page expected >= 1 item, got %d" (List.length items2)); + (* Cursor blob itself MUST NOT appear in next page *) + List.iter (fun (sha, _, _, _, _) -> + if sha = last_sha then + failwith "Cursor blob leaked into next page" + ) items2 + +(** Test: list with invalid cursor (not hex 64) returns 400. *) +let test_list_invalid_cursor ~sw ~env = + let base_url = Config.base_url in + let pubkey = String.make 64 'b' in + let url = Printf.sprintf "%s/list/%s?cursor=not-a-cursor" base_url pubkey in + let result = Http_client.get ~sw ~env ~url () in + match result with + | Error e -> failwith ("Request failed: " ^ e) + | Ok response -> + if response.status <> 400 then + failwith (Printf.sprintf "Expected 400 for invalid cursor, got %d" response.status) + +(** Test: list with since/until range filters by uploaded timestamp. *) +let test_list_since_until ~sw ~env = + let base_url = Config.base_url in + let clock = Eio.Stdenv.clock env in + let now = Eio.Time.now clock in + + let keypair = Nostr_signer.generate_keypair () in + let _ = upload_blob ~sw ~env ~keypair ~content:("list-since-" ^ string_of_float now) ~now in + + (* until=0 should yield empty (no blobs uploaded before unix=0) *) + let url = Printf.sprintf "%s/list/%s?until=0" base_url keypair.pubkey in + let result = Http_client.get ~sw ~env ~url () in + match result with + | Error e -> failwith ("Request failed: " ^ e) + | Ok response -> + if response.status <> 200 then + failwith (Printf.sprintf "Expected 200, got %d" response.status); + let items = parse_list_response response.body in + if List.length items <> 0 then + failwith (Printf.sprintf "Expected 0 with until=0, got %d" (List.length items)) + +(** Test: list with malformed since query param returns 400. *) +let test_list_invalid_since ~sw ~env = + let base_url = Config.base_url in + let pubkey = String.make 64 'c' in + let url = Printf.sprintf "%s/list/%s?since=abc" base_url pubkey in + let result = Http_client.get ~sw ~env ~url () in + match result with + | Error e -> failwith ("Request failed: " ^ e) + | Ok response -> + if response.status <> 400 then + failwith (Printf.sprintf "Expected 400, got %d" response.status) + +(** Test: list with valid Authorization header (t=list) returns 200. *) +let test_list_with_valid_auth ~sw ~env = + let base_url = Config.base_url in + let clock = Eio.Stdenv.clock env in + let now = Eio.Time.now clock in + + let keypair = Nostr_signer.generate_keypair () in + let expiration = Int64.of_float (now +. 3600.) in + let auth_event = Nostr_signer.create_list_auth ~keypair ~created_at:now ~expiration in + let auth_header = Nostr_signer.to_auth_header auth_event in + + let url = base_url ^ "/list/" ^ keypair.pubkey in + let result = Http_client.get ~sw ~env ~url ~headers:[("Authorization", auth_header)] () in + match result with + | Error e -> failwith ("Request failed: " ^ e) + | Ok response -> + if response.status <> 200 then + failwith (Printf.sprintf "Expected 200 with valid auth, got %d" response.status) + +(** Test: list with invalid Authorization header returns 401. *) +let test_list_with_invalid_auth ~sw ~env = + let base_url = Config.base_url in + let pubkey = String.make 64 'd' in + let url = base_url ^ "/list/" ^ pubkey in + (* Garbage base64 → 401 *) + let result = Http_client.get ~sw ~env ~url + ~headers:[("Authorization", "Nostr !!!invalid!!!")] () + in + match result with + | Error e -> failwith ("Request failed: " ^ e) + | Ok response -> + if response.status <> 401 then + failwith (Printf.sprintf "Expected 401 for invalid auth, got %d" response.status) + +(** Test: list with auth event whose t tag is not "list" returns 401. *) +let test_list_with_wrong_t_tag ~sw ~env = + let base_url = Config.base_url in + let clock = Eio.Stdenv.clock env in + let now = Eio.Time.now clock in + + let keypair = Nostr_signer.generate_keypair () in + let expiration = Int64.of_float (now +. 3600.) in + (* Send an upload-style auth event when listing → should be rejected *) + let auth_event = Nostr_signer.create_upload_auth + ~keypair ~sha256:(String.make 64 '0') ~created_at:now ~expiration + in + let auth_header = Nostr_signer.to_auth_header auth_event in + + let url = base_url ^ "/list/" ^ keypair.pubkey in + let result = Http_client.get ~sw ~env ~url ~headers:[("Authorization", auth_header)] () in + match result with + | Error e -> failwith ("Request failed: " ^ e) + | Ok response -> + if response.status <> 401 then + failwith (Printf.sprintf "Expected 401 for wrong t tag, got %d" response.status) + +let tests = [ + ("list returns owned blobs sorted DESC", test_list_returns_owned_blobs); + ("list unknown pubkey returns empty", test_list_unknown_pubkey); + ("list with invalid pubkey returns 400", test_list_invalid_pubkey); + ("list cursor pagination", test_list_cursor_pagination); + ("list with invalid cursor returns 400", test_list_invalid_cursor); + ("list with since/until range filter", test_list_since_until); + ("list with invalid since returns 400", test_list_invalid_since); + ("list with valid t=list auth header", test_list_with_valid_auth); + ("list with invalid auth header returns 401", test_list_with_invalid_auth); + ("list with wrong t tag returns 401", test_list_with_wrong_t_tag); +] diff --git a/lib/core/auth.ml b/lib/core/auth.ml index 5a12a9e..000ab3c 100644 --- a/lib/core/auth.ml +++ b/lib/core/auth.ml @@ -1,11 +1,12 @@ (** Blossom authentication for kind 24242 events (BUD-01/BUD-02). *) -type action = Upload | Download | Delete +type action = Upload | Download | Delete | List let action_to_string = function | Upload -> "upload" | Download -> "get" | Delete -> "delete" + | List -> "list" (* Validate that x tag contains the specified hash *) let validate_x_tag event ~sha256 = diff --git a/lib/shell/blossom_db.ml b/lib/shell/blossom_db.ml index 679db11..05efe67 100644 --- a/lib/shell/blossom_db.ml +++ b/lib/shell/blossom_db.ml @@ -101,6 +101,28 @@ module Db = struct @@ {sql| SELECT pubkey FROM blob_owners WHERE sha256 = $1 |sql} + + (* list_blobs_by_pubkey: BUD-12 cursor-based pagination. + Args: pubkey, since, until, cursor_uploaded (0 = no cursor sentinel), + cursor_sha256, limit. + Returns: (sha256, uploaded_at, mime_type, size) sorted DESC. *) + let list_blobs_by_pubkey = + (t6 string int64 int64 int64 string int + ->* t4 string int64 (option string) (option int64)) + @@ {sql| + SELECT b.sha256, b.uploaded_at, b.mime_type, b.size + FROM blobs b + JOIN blob_owners o ON o.sha256 = b.sha256 + WHERE o.pubkey = $1 + AND b.status = 'stored' + AND b.uploaded_at >= $2 + AND b.uploaded_at <= $3 + AND ( $4 = 0 + OR b.uploaded_at < $4 + OR (b.uploaded_at = $4 AND b.sha256 < $5) ) + ORDER BY b.uploaded_at DESC, b.sha256 DESC + LIMIT $6 + |sql} end type t = (Caqti_eio.connection, Caqti_error.t) Caqti_eio.Pool.t @@ -214,6 +236,31 @@ let list_owners (pool : t) ~sha256 = | Ok owners -> Ok owners | Error e -> Error (Domain.Storage_error (Caqti_error.show e)) +let list_by_pubkey (pool : t) ~pubkey ~since ~until ~cursor ~limit = + let cursor_uploaded, cursor_sha256 = match cursor with + | None -> 0L, "" + | Some (u, s) -> u, s + in + let result = + Caqti_eio.Pool.use (fun (module C : Caqti_eio.CONNECTION) -> + C.collect_list Db.list_blobs_by_pubkey + (pubkey, since, until, cursor_uploaded, cursor_sha256, limit) + ) pool + in + match result with + | Ok rows -> + let descriptors = List.map (fun (sha, uploaded_at, mime, size) -> + { + Domain.sha256 = sha; + size = Option.value ~default:0 (Option.map Int64.to_int size); + mime_type = Option.value ~default:"application/octet-stream" mime; + uploaded = uploaded_at; + url = "/"; (* URL is filled in by Http_server *) + }) rows + in + Ok descriptors + | Error e -> Error (Domain.Storage_error (Caqti_error.show e)) + (** Db_intf.S を満たすモジュール *) module Impl : Db_intf.S with type t = t = struct type nonrec t = t @@ -225,4 +272,5 @@ module Impl : Db_intf.S with type t = t = struct let remove_owner = remove_owner let count_owners = count_owners let list_owners = list_owners + let list_by_pubkey = list_by_pubkey end diff --git a/lib/shell/db_intf.ml b/lib/shell/db_intf.ml index 5372ee5..efb6f76 100644 --- a/lib/shell/db_intf.ml +++ b/lib/shell/db_intf.ml @@ -59,4 +59,18 @@ module type S = sig t -> sha256:string -> (string list, Domain.error) result + + (** 指定pubkeyが所有するBlobのリストを取得する（BUD-12）。 + [since]/[until] は uploaded_at の閉区間フィルタ（包含）。 + [cursor] は (uploaded_at, sha256) の組で、それより降順で「後ろ」のものを返す。 + [limit] は返す最大件数。 + 結果は uploaded_at 降順、同値時は sha256 降順でソートされる。 *) + val list_by_pubkey : + t -> + pubkey:string -> + since:int64 -> + until:int64 -> + cursor:(int64 * string) option -> + limit:int -> + (Domain.blob_descriptor list, Domain.error) result end diff --git a/lib/shell/http_response.ml b/lib/shell/http_response.ml index 4644910..72a3f63 100644 --- a/lib/shell/http_response.ml +++ b/lib/shell/http_response.ml @@ -17,6 +17,8 @@ type response_kind = (** Blobメタデータの取得成功（HEADリクエスト用） *) | Success_upload of Domain.blob_descriptor (** Blobアップロード成功 *) + | Success_list of Domain.blob_descriptor list + (** Blob list取得成功（BUD-12 GET /list/） *) | Success_delete (** Blob削除成功 *) | Success_upload_check @@ -59,8 +61,8 @@ let cors_headers = [ ("access-control-max-age", "86400"); ] -(** blob descriptorをJSON文字列に変換する純粋関数 *) -let descriptor_to_json (descriptor : Domain.blob_descriptor) = +(** blob descriptorをYojson値に変換する純粋関数 *) +let descriptor_to_yojson (descriptor : Domain.blob_descriptor) : Yojson.Basic.t = `Assoc [ ("url", `String descriptor.url); ("sha256", `String descriptor.sha256); @@ -68,7 +70,10 @@ let descriptor_to_json (descriptor : Domain.blob_descriptor) = ("type", `String descriptor.mime_type); ("uploaded", `Int (Int64.to_int descriptor.uploaded)); ] - |> Yojson.Basic.to_string + +(** blob descriptorをJSON文字列に変換する純粋関数 *) +let descriptor_to_json (descriptor : Domain.blob_descriptor) = + descriptor_to_yojson descriptor |> Yojson.Basic.to_string (** レスポンスの種類から実際のHTTPレスポンスを生成する純粋関数 @@ -105,6 +110,16 @@ let create = function ]) in Response.create ~headers ~body:(Body.of_string json) `OK + | Success_list descriptors -> + let json = + `List (List.map descriptor_to_yojson descriptors) + |> Yojson.Basic.to_string + in + let headers = Headers.of_list (cors_headers @ [ + ("content-type", "application/json"); + ]) in + Response.create ~headers ~body:(Body.of_string json) `OK + | Success_delete -> let json = `Assoc [("message", `String "Deleted")] |> Yojson.Basic.to_string in let headers = Headers.of_list (cors_headers @ [ diff --git a/lib/shell/http_server.ml b/lib/shell/http_server.ml index 1cab587..ee296a9 100644 --- a/lib/shell/http_server.ml +++ b/lib/shell/http_server.ml @@ -45,7 +45,9 @@ let request_handler ~sw ~env ~clock ~data_dir ~db ~base_url { Server.Handler.req | `OPTIONS, _ -> Http_response.Cors_preflight - | `GET, path -> + | `GET, target -> + let uri = Uri.of_string target in + let path = Uri.path uri in let path_parts = String.split_on_char '/' path |> List.filter (fun s -> s <> "") in Eio.traceln "Path parts: [%s]" (String.concat "; " path_parts); (match path_parts with @@ -62,6 +64,71 @@ let request_handler ~sw ~env ~clock ~data_dir ~db ~base_url { Server.Handler.req size = metadata.size; } | Error e -> error_to_response_kind e) + | ["list"; pubkey] -> + (* BUD-12: GET /list/ *) + if not (Integrity.validate_hash pubkey) then + Http_response.Error_bad_request "Invalid pubkey format" + else + let parse_int64_param name = + match Uri.get_query_param uri name with + | None -> Ok None + | Some s -> + (match Int64.of_string_opt s with + | Some n when n >= 0L -> Ok (Some n) + | _ -> Error (Printf.sprintf "Invalid %s parameter" name)) + in + let parse_int_param name = + match Uri.get_query_param uri name with + | None -> Ok None + | Some s -> + (match int_of_string_opt s with + | Some n -> Ok (Some n) + | None -> Error (Printf.sprintf "Invalid %s parameter" name)) + in + (match parse_int64_param "since", parse_int64_param "until", parse_int_param "limit" with + | Error msg, _, _ | _, Error msg, _ | _, _, Error msg -> + Http_response.Error_bad_request msg + | Ok since_opt, Ok until_opt, Ok limit_opt -> + let since = Option.value since_opt ~default:0L in + let until = Option.value until_opt ~default:Int64.max_int in + let limit = match limit_opt with + | Some n -> max 1 (min 1000 n) + | None -> 50 + in + let cursor_result = + match Uri.get_query_param uri "cursor" with + | None -> Ok None + | Some sha -> + if not (Integrity.validate_hash sha) then + Error "Invalid cursor" + else + (match BlobService.get_metadata ~storage:data_dir ~db ~sha256:sha with + | Ok meta -> Ok (Some (meta.uploaded, sha)) + | Error _ -> Error "Invalid cursor") + in + (match cursor_result with + | Error msg -> Http_response.Error_bad_request msg + | Ok cursor -> + (* Authorization is optional for /list (BUD-11/BUD-12) *) + let auth_check = + match Headers.get request.headers "authorization" with + | None -> Ok () + | Some auth_header -> + let current_time = Int64.of_float (Eio.Time.now clock) in + (match Auth.validate_auth ~header:auth_header ~action:Auth.List ~current_time with + | Ok _ -> Ok () + | Error e -> Error e) + in + (match auth_check with + | Error e -> error_to_response_kind e + | Ok () -> + match Blossom_db.list_by_pubkey db ~pubkey ~since ~until ~cursor ~limit with + | Error e -> error_to_response_kind e + | Ok descriptors -> + let descriptors = List.map (fun (d : Domain.blob_descriptor) -> + { d with Domain.url = Printf.sprintf "%s/%s" base_url d.sha256 } + ) descriptors in + Http_response.Success_list descriptors))) | _ -> Http_response.Error_not_found "Invalid path") | `HEAD, "/upload" -> diff --git a/test/test_http_response.ml b/test/test_http_response.ml index e450cb6..05d0009 100644 --- a/test/test_http_response.ml +++ b/test/test_http_response.ml @@ -107,6 +107,58 @@ let test_error_internal () = check (option string) "X-Reason header" (Some "Database error") (get_header response "x-reason"); check_cors_headers response +(* Success_list レスポンステスト（空配列） *) +let test_success_list_empty () = + let response = Http_response.create (Success_list []) in + check int "Status code" 200 (get_status response); + check (option string) "Content-Type header" (Some "application/json") (get_header response "content-type"); + check_cors_headers response; + let body = match Response.body response |> Body.to_string with + | Ok s -> s + | Error _ -> failwith "Failed to read body" + in + check string "Empty array body" "[]" body + +(* Success_list レスポンステスト（複数） *) +let test_success_list_populated () = + let descriptors = [ + { + Domain.url = "http://localhost:8082/aaa"; + sha256 = "aaa"; + size = 100; + mime_type = "text/plain"; + uploaded = 1000L; + }; + { + Domain.url = "http://localhost:8082/bbb"; + sha256 = "bbb"; + size = 200; + mime_type = "image/png"; + uploaded = 2000L; + }; + ] in + let response = Http_response.create (Success_list descriptors) in + check int "Status code" 200 (get_status response); + check (option string) "Content-Type header" (Some "application/json") (get_header response "content-type"); + check_cors_headers response; + let body = match Response.body response |> Body.to_string with + | Ok s -> s + | Error _ -> failwith "Failed to read body" + in + let json = Yojson.Basic.from_string body in + let open Yojson.Basic.Util in + let items = json |> to_list in + check int "Array length" 2 (List.length items); + let first = List.nth items 0 in + check string "First sha256" "aaa" (first |> member "sha256" |> to_string); + check string "First url" "http://localhost:8082/aaa" (first |> member "url" |> to_string); + check int "First size" 100 (first |> member "size" |> to_int); + check string "First type" "text/plain" (first |> member "type" |> to_string); + check int "First uploaded" 1000 (first |> member "uploaded" |> to_int); + let second = List.nth items 1 in + check string "Second sha256" "bbb" (second |> member "sha256" |> to_string); + check string "Second type" "image/png" (second |> member "type" |> to_string) + (* descriptor_to_json テスト *) let test_descriptor_to_json () = let descriptor = { @@ -172,6 +224,8 @@ let tests = [ test_case "Success_blob response" `Quick test_success_blob; test_case "Success_metadata response" `Quick test_success_metadata; test_case "Success_upload response" `Quick test_success_upload; + test_case "Success_list empty response" `Quick test_success_list_empty; + test_case "Success_list populated response" `Quick test_success_list_populated; test_case "Success_delete response" `Quick test_success_delete; test_case "Success_upload_check response" `Quick test_success_upload_check; test_case "Cors_preflight response" `Quick test_cors_preflight;