Replace hand-written PeerTube library with OpenAPI-generated code

+1 -1

bin/dune

··· 1 1 (executable 2 2 (name openapi_cli) 3 3 (public_name openapi-gen) 4 - (libraries openapi cmdliner fmt logs logs.fmt fmt.tty unix)) 4 + (libraries openapi yamlt cmdliner fmt logs logs.fmt fmt.tty unix))

+19 -3

bin/openapi_cli.ml

··· 12 12 close_in ic; 13 13 s 14 14 15 - (** Parse spec file and run action, handling errors uniformly *) 15 + (** Check if a file appears to be YAML based on extension or content *) 16 + let is_yaml_file path content = 17 + let ext = Filename.extension path |> String.lowercase_ascii in 18 + ext = ".yaml" || ext = ".yml" || 19 + (* Also detect YAML by content if no clear extension *) 20 + (ext <> ".json" && String.length content > 0 && 21 + (content.[0] = '#' || String.sub content 0 (min 7 (String.length content)) = "openapi")) 22 + 23 + (** Parse spec file and run action, handling errors uniformly. 24 + Automatically handles both JSON and YAML formats using jsont codecs. *) 16 25 let with_spec spec_path f = 17 26 let spec_content = read_file spec_path in 18 - match Openapi.Spec.of_string spec_content with 27 + let result = 28 + if is_yaml_file spec_path spec_content then begin 29 + Logs.info (fun m -> m "Detected YAML format"); 30 + Yamlt.decode_string Openapi.Spec.jsont spec_content 31 + end else 32 + Openapi.Spec.of_string spec_content 33 + in 34 + match result with 19 35 | Error e -> 20 36 Logs.err (fun m -> m "Failed to parse OpenAPI spec: %s" e); 21 37 1 ··· 81 97 open Cmdliner 82 98 83 99 let spec_path = 84 - let doc = "Path to the OpenAPI specification file (JSON)." in 100 + let doc = "Path to the OpenAPI specification file (JSON or YAML)." in 85 101 Arg.(required & pos 0 (some file) None & info [] ~docv:"SPEC" ~doc) 86 102 87 103 let output_dir =

+142 -41

lib/openapi_codegen.ml

··· 175 175 (** {1 Topological Sort} *) 176 176 177 177 (** Kahn's algorithm for topological sorting. 178 - Returns nodes in dependency order (dependencies first). *) 178 + Returns nodes in dependency order (dependencies first). 179 + Self-dependencies are ignored (they don't affect ordering). *) 179 180 let topological_sort (nodes : string list) (deps : string -> string list) : string list = 180 181 (* Build adjacency list and in-degree map *) 181 182 let nodes_set = StringSet.of_list nodes in ··· 185 186 let adj = List.fold_left (fun m node -> 186 187 StringMap.add node [] m 187 188 ) StringMap.empty nodes in 188 - (* Add edges: if A depends on B, add edge B -> A *) 189 + (* Add edges: if A depends on B, add edge B -> A 190 + Ignore self-dependencies (node depending on itself) *) 189 191 let (in_degree, adj) = List.fold_left (fun (in_degree, adj) node -> 190 - let node_deps = deps node |> List.filter (fun d -> StringSet.mem d nodes_set) in 192 + let node_deps = deps node 193 + |> List.filter (fun d -> StringSet.mem d nodes_set && d <> node) in 191 194 let in_degree = StringMap.add node (List.length node_deps) in_degree in 192 195 let adj = List.fold_left (fun adj dep -> 193 196 let existing = Option.value ~default:[] (StringMap.find_opt dep adj) in ··· 233 236 is_enum : bool; 234 237 enum_variants : (string * string) list; (* ocaml_name, json_value *) 235 238 description : string option; 239 + is_recursive : bool; (* true if schema references itself *) 236 240 } 237 241 238 242 type operation_info = { ··· 336 340 let description = get_string_member "description" field_json in 337 341 { ocaml_name; json_name = field_name; ocaml_type; base_type; is_optional; is_required; description } 338 342 ) schema.properties in 343 + (* Check if schema references itself *) 344 + let deps = find_schema_dependencies schema in 345 + let is_recursive = List.mem name deps in 339 346 { original_name = name; prefix; suffix; schema; fields; is_enum; enum_variants; 340 - description = schema.description } 347 + description = schema.description; is_recursive } 341 348 342 349 (** {1 Operation Processing} *) 343 350 ··· 440 447 let build_module_tree (schemas : schema_info list) (operations : operation_info list) : module_node * string list = 441 448 let root = empty_node "Root" in 442 449 450 + (* Build set of known schema names for validation *) 451 + let known_schemas = StringSet.of_list (List.map (fun s -> s.original_name) schemas) in 452 + 443 453 (* Add schemas to tree and track dependencies *) 444 454 let root = List.fold_left (fun root schema -> 445 455 let prefix_mod = Name.to_module_name schema.prefix in ··· 457 467 { root with children = StringMap.add prefix_mod child root.children } 458 468 ) root schemas in 459 469 460 - (* Add operations to tree based on response type, and track operation dependencies *) 470 + (* Add operations to tree based on response type, and track operation dependencies. 471 + Only use response_schema_ref if the schema actually exists in components/schemas. *) 461 472 let root = List.fold_left (fun root op -> 462 - match op.response_schema_ref with 473 + (* Check if response schema actually exists *) 474 + let valid_response_ref = match op.response_schema_ref with 475 + | Some name when StringSet.mem name known_schemas -> Some name 476 + | _ -> None 477 + in 478 + match valid_response_ref with 463 479 | Some ref_name -> 464 480 let prefix, _ = Name.split_schema_name ref_name in 465 481 let prefix_mod = Name.to_module_name prefix in ··· 476 492 } in 477 493 { root with children = StringMap.add prefix_mod child root.children } 478 494 | None -> 479 - (* Put in Client module for operations without typed response *) 495 + (* Put in Client module for operations without valid typed response *) 480 496 let child = match StringMap.find_opt "Client" root.children with 481 497 | Some c -> c 482 498 | None -> empty_node "Client" ··· 537 553 in 538 554 Printf.sprintf "%s\n\nval jsont : t Jsont.t" type_def 539 555 540 - (** Localize an OCaml type string by stripping the current_prefix module *) 541 - let localize_type ~current_prefix (type_str : string) : string = 542 - (* Handle patterns like "User.ResponseDto.t" -> "ResponseDto.t" if current_prefix = "User" *) 556 + (** Localize an OCaml type string by stripping the current_prefix and current_suffix modules. 557 + When generating code inside a submodule, self-references need to be unqualified. *) 558 + let localize_type ~current_prefix ~current_suffix (type_str : string) : string = 559 + (* Handle patterns like "User.ResponseDto.t" -> "ResponseDto.t" if current_prefix = "User" 560 + And further "ResponseDto.t" -> "t" if current_suffix = "ResponseDto" *) 543 561 let prefix_dot = current_prefix ^ "." in 562 + let suffix_dot = current_suffix ^ "." in 563 + let full_path = current_prefix ^ "." ^ current_suffix ^ "." in 544 564 let strip_prefix s = 545 - if String.length s >= String.length prefix_dot && 565 + (* First try to strip full path (Prefix.Suffix.) *) 566 + if String.length s >= String.length full_path && 567 + String.sub s 0 (String.length full_path) = full_path then 568 + String.sub s (String.length full_path) (String.length s - String.length full_path) 569 + (* Then try just prefix *) 570 + else if String.length s >= String.length prefix_dot && 546 571 String.sub s 0 (String.length prefix_dot) = prefix_dot then 547 - String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot) 572 + let rest = String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot) in 573 + (* If the rest starts with our suffix, strip that too *) 574 + if String.length rest >= String.length suffix_dot && 575 + String.sub rest 0 (String.length suffix_dot) = suffix_dot then 576 + String.sub rest (String.length suffix_dot) (String.length rest - String.length suffix_dot) 577 + else rest 548 578 else s 549 579 in 550 580 (* Handle "X list", "X option", and nested combinations *) ··· 560 590 in 561 591 localize type_str 562 592 563 - (** Localize a jsont codec string by stripping the current_prefix module *) 564 - let rec localize_jsont ~current_prefix (jsont_str : string) : string = 593 + (** Localize a jsont codec string by stripping the current_prefix and current_suffix modules *) 594 + let rec localize_jsont ~current_prefix ~current_suffix (jsont_str : string) : string = 565 595 let prefix_dot = current_prefix ^ "." in 566 - (* Handle patterns like "User.ResponseDto.jsont" -> "ResponseDto.jsont" *) 567 - (* Also handle "(Jsont.list User.ResponseDto.jsont)" *) 568 - if String.length jsont_str >= String.length prefix_dot then 569 - if String.sub jsont_str 0 (String.length prefix_dot) = prefix_dot then 570 - String.sub jsont_str (String.length prefix_dot) (String.length jsont_str - String.length prefix_dot) 571 - else if String.length jsont_str > 12 && String.sub jsont_str 0 12 = "(Jsont.list " then 572 - let inner = String.sub jsont_str 12 (String.length jsont_str - 13) in 573 - "(Jsont.list " ^ localize_jsont ~current_prefix inner ^ ")" 574 - else 575 - jsont_str 596 + let suffix_dot = current_suffix ^ "." in 597 + let full_path = current_prefix ^ "." ^ current_suffix ^ "." in 598 + let strip_prefix s = 599 + (* First try to strip full path (Prefix.Suffix.) *) 600 + if String.length s >= String.length full_path && 601 + String.sub s 0 (String.length full_path) = full_path then 602 + String.sub s (String.length full_path) (String.length s - String.length full_path) 603 + (* Then try just prefix *) 604 + else if String.length s >= String.length prefix_dot && 605 + String.sub s 0 (String.length prefix_dot) = prefix_dot then 606 + let rest = String.sub s (String.length prefix_dot) (String.length s - String.length prefix_dot) in 607 + (* If the rest starts with our suffix, strip that too *) 608 + if String.length rest >= String.length suffix_dot && 609 + String.sub rest 0 (String.length suffix_dot) = suffix_dot then 610 + String.sub rest (String.length suffix_dot) (String.length rest - String.length suffix_dot) 611 + else rest 612 + else s 613 + in 614 + (* Handle patterns like "User.ResponseDto.jsont" -> "ResponseDto.jsont" -> "jsont" 615 + Also handle "(Jsont.list User.ResponseDto.jsont)" *) 616 + if String.length jsont_str > 12 && String.sub jsont_str 0 12 = "(Jsont.list " then 617 + let inner = String.sub jsont_str 12 (String.length jsont_str - 13) in 618 + "(Jsont.list " ^ localize_jsont ~current_prefix ~current_suffix inner ^ ")" 576 619 else 577 - jsont_str 620 + strip_prefix jsont_str 578 621 579 - let gen_record_impl ~current_prefix (schema : schema_info) : string = 580 - let loc_type = localize_type ~current_prefix in 581 - let loc_jsont = localize_jsont ~current_prefix in 622 + let gen_record_impl ~current_prefix ~current_suffix (schema : schema_info) : string = 623 + (* For recursive schemas, self-referential fields need to use Jsont.json 624 + to avoid OCaml's let rec restrictions on non-functional values *) 625 + let loc_type s = 626 + let localized = localize_type ~current_prefix ~current_suffix s in 627 + if schema.is_recursive && localized = "t" then "Jsont.json" 628 + else if schema.is_recursive && localized = "t list" then "Jsont.json list" 629 + else if schema.is_recursive && localized = "t option" then "Jsont.json option" 630 + else if schema.is_recursive && localized = "t list option" then "Jsont.json list option" 631 + else localized 632 + in 633 + let loc_jsont s = 634 + let localized = localize_jsont ~current_prefix ~current_suffix s in 635 + if schema.is_recursive && localized = "jsont" then "Jsont.json" 636 + else if schema.is_recursive && localized = "(Jsont.list jsont)" then 637 + "(Jsont.list Jsont.json)" 638 + else localized 639 + in 582 640 let doc = format_doc schema.description in 583 641 if schema.fields = [] then 584 642 Printf.sprintf "%stype t = Jsont.json\n\nlet jsont = Jsont.json\n\nlet v () = Jsont.Null ((), Jsont.Meta.none)" doc ··· 640 698 |> Jsont.Object.finish|} 641 699 type_def v_func accessors schema.original_name make_params v_body jsont_members 642 700 643 - let gen_record_intf ~current_prefix (schema : schema_info) : string = 644 - let loc_type = localize_type ~current_prefix in 701 + let gen_record_intf ~current_prefix ~current_suffix (schema : schema_info) : string = 702 + (* For recursive schemas, self-referential fields need to use Jsont.json 703 + to avoid OCaml's let rec restrictions on non-functional values *) 704 + let loc_type s = 705 + let localized = localize_type ~current_prefix ~current_suffix s in 706 + if schema.is_recursive && localized = "t" then "Jsont.json" 707 + else if schema.is_recursive && localized = "t list" then "Jsont.json list" 708 + else if schema.is_recursive && localized = "t option" then "Jsont.json option" 709 + else if schema.is_recursive && localized = "t list option" then "Jsont.json list option" 710 + else localized 711 + in 645 712 let doc = format_doc schema.description in 646 713 if schema.fields = [] then 647 714 Printf.sprintf "%stype t\n\nval jsont : t Jsont.t\n\nval v : unit -> t" doc ··· 687 754 else 688 755 Printf.sprintf "%s.%s.jsont" prefix_mod suffix_mod 689 756 757 + (** Check if a schema exists - used to validate refs before generating code *) 758 + let schema_exists_ref = ref (fun (_ : string) -> true) 759 + let set_known_schemas (schemas : schema_info list) = 760 + let known = StringSet.of_list (List.map (fun s -> s.original_name) schemas) in 761 + schema_exists_ref := (fun name -> StringSet.mem name known) 762 + 690 763 let gen_operation_impl ~current_prefix (op : operation_info) : string = 691 764 let doc = format_doc_block ~summary:op.summary ?description:op.description () in 692 765 let param_docs = String.concat "" ··· 694 767 (List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in 695 768 let full_doc = if param_docs = "" then doc 696 769 else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs 697 - else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in 770 + else String.sub doc 0 (String.length doc - 3) ^ "\n" ^ param_docs ^ "*)\n" in 771 + 772 + (* Only use body/response refs if schema actually exists *) 773 + let valid_body_ref = match op.body_schema_ref with 774 + | Some name when !schema_exists_ref name -> Some name 775 + | _ -> None 776 + in 777 + let valid_response_ref = match op.response_schema_ref with 778 + | Some name when !schema_exists_ref name -> Some name 779 + | _ -> None 780 + in 698 781 699 782 let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "~%s" n) op.path_params in 700 783 let query_args = List.map (fun (n, _, _, req) -> ··· 702 785 ) op.query_params in 703 786 (* DELETE and HEAD don't support body in the requests library *) 704 787 let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in 705 - let body_arg = match op.body_schema_ref, method_supports_body with 788 + let body_arg = match valid_body_ref, method_supports_body with 706 789 | Some _, true -> ["~body"] 707 790 | _ -> [] 708 791 in ··· 729 812 in 730 813 731 814 let method_lower = String.lowercase_ascii op.method_ in 732 - let body_codec = match op.body_schema_ref with 815 + let body_codec = match valid_body_ref with 733 816 | Some name -> format_jsont_ref ~current_prefix name 734 817 | None -> "Jsont.json" 735 818 in 736 819 (* DELETE and HEAD don't support body in the requests library *) 737 - let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in 738 - let http_call = match op.body_schema_ref, method_supports_body with 820 + let method_supports_body' = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in 821 + let http_call = match valid_body_ref, method_supports_body' with 739 822 | Some _, true -> 740 823 Printf.sprintf "Requests.%s client.session ~body:(Requests.Body.json (Openapi.Runtime.Json.encode_json %s body)) url" 741 824 method_lower body_codec ··· 746 829 Printf.sprintf "Requests.%s client.session url" method_lower 747 830 in 748 831 749 - let response_codec = match op.response_schema_ref with 832 + let response_codec = match valid_response_ref with 750 833 | Some name -> format_jsont_ref ~current_prefix name 751 834 | None -> "Jsont.json" 752 835 in ··· 799 882 (List.map (fun (n, _, d, _) -> format_param_doc n d) op.query_params)) in 800 883 let full_doc = if param_docs = "" then doc 801 884 else if doc = "" then Printf.sprintf "(**\n%s*)\n" param_docs 802 - else String.sub doc 0 (String.length doc - 3) ^ param_docs ^ "*)\n" in 885 + else String.sub doc 0 (String.length doc - 3) ^ "\n" ^ param_docs ^ "*)\n" in 886 + 887 + (* Only use body/response refs if schema actually exists *) 888 + let valid_body_ref = match op.body_schema_ref with 889 + | Some name when !schema_exists_ref name -> Some name 890 + | _ -> None 891 + in 892 + let valid_response_ref = match op.response_schema_ref with 893 + | Some name when !schema_exists_ref name -> Some name 894 + | _ -> None 895 + in 803 896 804 897 let path_args = List.map (fun (n, _, _, _) -> Printf.sprintf "%s:string" n) op.path_params in 805 898 let query_args = List.map (fun (n, _, _, req) -> 806 899 if req then Printf.sprintf "%s:string" n else Printf.sprintf "?%s:string" n 807 900 ) op.query_params in 808 901 let method_supports_body = not (List.mem op.method_ ["DELETE"; "HEAD"; "OPTIONS"]) in 809 - let body_arg = match op.body_schema_ref, method_supports_body with 902 + let body_arg = match valid_body_ref, method_supports_body with 810 903 | Some name, true -> [Printf.sprintf "body:%s" (format_type_ref ~current_prefix name)] 811 904 | _ -> [] 812 905 in 813 - let response_type = match op.response_schema_ref with 906 + let response_type = match valid_response_ref with 814 907 | Some name -> format_type_ref ~current_prefix name 815 908 | None -> "Jsont.json" 816 909 in ··· 822 915 823 916 let gen_submodule_impl ~current_prefix (schema : schema_info) : string = 824 917 let suffix_mod = Name.to_module_name schema.suffix in 825 - let content = if schema.is_enum then gen_enum_impl schema else gen_record_impl ~current_prefix schema in 918 + let content = if schema.is_enum then gen_enum_impl schema 919 + else gen_record_impl ~current_prefix ~current_suffix:suffix_mod schema in 826 920 let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 827 921 Printf.sprintf "module %s = struct\n%s\nend" suffix_mod indented 828 922 829 923 let gen_submodule_intf ~current_prefix (schema : schema_info) : string = 830 924 let suffix_mod = Name.to_module_name schema.suffix in 831 - let content = if schema.is_enum then gen_enum_intf schema else gen_record_intf ~current_prefix schema in 925 + let content = if schema.is_enum then gen_enum_intf schema 926 + else gen_record_intf ~current_prefix ~current_suffix:suffix_mod schema in 832 927 let indented = String.split_on_char '\n' content |> List.map (fun l -> " " ^ l) |> String.concat "\n" in 833 928 Printf.sprintf "module %s : sig\n%s\nend" suffix_mod indented 834 929 ··· 895 990 ) c.schemas 896 991 in 897 992 993 + (* Set known schemas for validation during code generation *) 994 + set_known_schemas schemas; 995 + 898 996 (* Collect operations *) 899 997 let operations = List.concat_map (fun (path, pi) -> 900 998 let ops = [ ··· 968 1066 | Spec.Value s -> Some (analyze_schema name s) 969 1067 ) c.schemas 970 1068 in 1069 + 1070 + (* Set known schemas for validation during code generation *) 1071 + set_known_schemas schemas; 971 1072 972 1073 (* Collect operations *) 973 1074 let operations = List.concat_map (fun (path, pi) ->