diff --git a/.gitignore b/.gitignore index becc6363..474ebdfc 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ node_modules _opam _build _esy +.pi/ diff --git a/AGENTS.md b/AGENTS.md index acd53aa7..4f902173 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -39,10 +39,25 @@ Pipeline: Smithy JSON → parse → typed AST → code generation → OCaml sour dune build # build everything; run after any change to verify it compiles dune fmt # always format after build as build changes source code style ``` - All build artefacts are under `_build/default/`, mirroring the source layout. The generator binary is at `_build/default/bin/AwsGenerator.exe`. +### Dune invocation rules (important) + +- **Always run `dune` with a tool-call timeout** (e.g. 300s for `dune build`, 600s + for `dune runtest`). A dune invocation that loses its tool call can leave a + process holding `_build/.lock`, blocking all later builds. +- **Before invoking `dune`, check for a held lock / runaway process**: + ```sh + pgrep -fa dune | grep -v 'bash -c' # confirm nothing is running + ls _build/.lock 2>/dev/null && echo "lock present" + rm -f _build/.lock # only if no dune is actually running + ``` + `A running dune instance has locked the build directory` means either a + `dune build --watch` is live (check its output, don't kill it) or a stale + lock from an aborted/crashed process — only remove the lock when `pgrep` + confirms no dune is running. + --- ## Test diff --git a/codegen/AwsProtocolQuery.ml b/codegen/AwsProtocolQuery.ml index 9d5526fb..cb732c9c 100644 --- a/codegen/AwsProtocolQuery.ml +++ b/codegen/AwsProtocolQuery.ml @@ -1209,7 +1209,7 @@ module Operations = struct let extract_xml_namespace (service : Shape.serviceShapeDetails) = Option.value ~default:"" (Option.bind service.traits ~f:(fun ts -> - List.find_map ts ~f:(function Trait.ApiXmlNamespaceTrait ns -> Some ns | _ -> None))) + List.find_map ts ~f:(function Trait.ApiXmlNamespaceTrait ns -> Some ns.uri | _ -> None))) let generate ~name ~(service : Shape.serviceShapeDetails) ~operation_shapes ~alias_context ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) diff --git a/codegen/AwsProtocolRestXml.ml b/codegen/AwsProtocolRestXml.ml new file mode 100644 index 00000000..39ca3daa --- /dev/null +++ b/codegen/AwsProtocolRestXml.ml @@ -0,0 +1,1385 @@ +open Base +open Ppx_util +module Ast = Smithy_ast +open Ast +module Longident = Ppx_longident + +module B = Ppxlib.Ast_builder.Make (struct + let loc = Location.none +end) + +let loc = Location.none + +(* ============================================================ *) +(* Shared helpers *) +(* ============================================================ *) + +let xml_name (traits : Trait.t list option) default = + Option.value ~default + (Option.bind traits ~f:(fun ts -> + List.find_map ts ~f:(function Trait.XmlNameTrait n -> Some n | _ -> None))) + +let is_flattened (traits : Trait.t list option) = + match traits with + | None -> false + | Some ts -> List.exists ts ~f:(function Trait.XmlFlattenedTrait -> true | _ -> false) + +let is_attribute (traits : Trait.t list option) = + match traits with + | None -> false + | Some ts -> List.exists ts ~f:(function Trait.XmlAttributeTrait -> true | _ -> false) + +let is_internal (traits : Trait.t list option) = + match traits with + | None -> false + | Some ts -> List.exists ts ~f:(function Trait.InternalTrait -> true | _ -> false) + +let is_idempotency_token (traits : Trait.t list option) = + match traits with + | None -> false + | Some ts -> List.exists ts ~f:(function Trait.IdempotencyTokenTrait -> true | _ -> false) + +let is_required (traits : Trait.t list option) = + match traits with + | None -> false + | Some ts -> List.exists ts ~f:(function Trait.RequiredTrait -> true | _ -> false) + +(* AwsQuery default timestamp format is date-time *) +let resolve_timestamp_format ?(member_traits : Trait.t list option = None) + ?(shape_traits : Trait.t list option = None) () = + let find_fmt traits = + Option.bind traits ~f:(fun ts -> + List.find_map ts ~f:(function Trait.TimestampFormatTrait x -> Some x | _ -> None)) + in + match find_fmt member_traits with + | Some f -> f + | None -> ( + match find_fmt shape_traits with Some f -> f | None -> Trait.TimestampFormatDateTime) + +let unit_expr = B.pexp_construct (lident_noloc "()") None + +(* ============================================================ *) +(* Serialiser *) +(* ============================================================ *) + +module Serialiser = struct + let serialiser_func_str name = (name |> SafeNames.safeFunctionName) ^ "_to_xml" + + (* Generated xml_serializers.ml opens [Smaws_Lib.Xml.Write], so the writer + functions are referenced unqualified. *) + let xml_write_call func args = B.pexp_apply (exp_ident func) args + + (* fun w v -> Write.text w (string_of v) *) + let primitive_field_lambda to_string = + exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + (Nolabel, B.pexp_apply (exp_ident to_string) [ (Nolabel, exp_ident "v") ]); + ])) + + (* For a primitive smithy type, return the XML text writer expression or None *) + let primitive_serialize_helper ?(member_traits : Trait.t list option = None) + ?(shape_traits : Trait.t list option = None) target_name = + match target_name with + | "smithy.api#String" | "smithy.api#Unit" -> + Some (fun w v -> xml_write_call "text" [ (Nolabel, w); (Nolabel, v) ]) + | "smithy.api#Integer" | "smithy.api#Byte" | "smithy.api#Short" -> + Some + (fun w v -> + xml_write_call "text" + [ (Nolabel, w); (Nolabel, B.pexp_apply (exp_ident "string_of_int") [ (Nolabel, v) ]) ]) + | "smithy.api#Long" -> + Some + (fun w v -> + xml_write_call "text" + [ + (Nolabel, w); + ( Nolabel, + qualified_apply + ~names:[ "Smaws_Lib"; "CoreTypes"; "Int64"; "to_string" ] + [ (Nolabel, v) ] ); + ]) + | "smithy.api#Boolean" -> + Some + (fun w v -> + xml_write_call "text" + [ + (Nolabel, w); (Nolabel, B.pexp_apply (exp_ident "string_of_bool") [ (Nolabel, v) ]); + ]) + | "smithy.api#Float" | "smithy.api#Double" -> + Some + (fun w v -> + xml_write_call "text" + [ + (Nolabel, w); + ( Nolabel, + qualified_apply + ~names: + [ "Smaws_Lib"; "Protocols"; "RestXml"; "Serialize"; "float_field_to_string" ] + [ (Nolabel, v) ] ); + ]) + | "smithy.api#Blob" -> + Some + (fun w v -> + xml_write_call "text" + [ + (Nolabel, w); + ( Nolabel, + qualified_apply ~names:[ "Base64"; "encode_exn" ] + [ (Nolabel, B.pexp_apply (exp_ident "Bytes.to_string") [ (Nolabel, v) ]) ] ); + ]) + | "smithy.api#Timestamp" -> + let fmt = resolve_timestamp_format ~member_traits ~shape_traits () in + let helper_name = + match fmt with + | Trait.TimestampFormatDateTime -> "timestamp_iso_to_string" + | Trait.TimestampFormatEpochSeconds -> "timestamp_epoch_to_string" + | Trait.TimestampFormatHttpDate -> "timestamp_httpdate_to_string" + in + let helper_mod = [ "Smaws_Lib"; "Protocols"; "RestXml"; "Serialize" ] in + Some + (fun w v -> + let s = qualified_apply ~names:(helper_mod @ [ helper_name ]) [ (Nolabel, v) ] in + xml_write_call "text" [ (Nolabel, w); (Nolabel, s) ]) + | _ -> None + + (* Generate the function name (as Longident) for a target shape's serializer *) + let func_longident ~namespace_resolver target_name = + let symbol_transformer ~local x = + if local then [ serialiser_func_str x ] else [ "Xml_serializers"; serialiser_func_str x ] + in + Namespace_resolver.Namespace_resolver.resolve_reference ~symbol_transformer namespace_resolver + target_name + |> Longident.unflatten |> Option.value_exn + + (* Generate an element serializer expression: fun w v -> write element with v *) + let item_serializer_expr ~namespace_resolver ?(member_traits = None) ?(shape_traits = None) + target_name = + match primitive_serialize_helper ~member_traits ~shape_traits target_name with + | Some helper -> + (* fun w v -> helper w v *) + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "w")) + (B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "v")) + (helper (exp_ident "w") (exp_ident "v"))) + | None -> + (* Reference to the complex type's _to_xml function *) + B.pexp_ident (Location.mknoloc (func_longident ~namespace_resolver target_name)) + + (* Extract an [@xmlNamespace] (uri, prefix) from a trait list, if present. *) + let xml_namespace_of (traits : Trait.t list option) : (string * string option) option = + Option.bind traits ~f:(fun ts -> + List.find_map ts ~f:(function + | Trait.ApiXmlNamespaceTrait { uri; prefix } -> Some (uri, prefix) + | _ -> None)) + + (* The attribute members of a structure/union shape, in declaration order. *) + let attribute_members (descriptor : Shape.structureShapeDetails) = + List.filter descriptor.members ~f:(fun m -> is_attribute m.traits) + + (* A single attribute's contribution to the runtime [attrs] list: + [(name, value, None)] when the member is required, or + [match v.am with Some s -> [(name, s, None)] | None -> []] when optional. + The attribute name embeds any prefix (e.g. "xsi:someName") via the + member's [@xmlName]. *) + let attribute_contribution (value_expr : Ppxlib.expression) (mem : Shape.member) = + let attr_name = xml_name mem.traits mem.name in + let access = B.pexp_field value_expr (lident_noloc (SafeNames.safeMemberName mem.name)) in + let triple v_expr = + B.pexp_tuple [ const_str attr_name; v_expr; B.pexp_construct (lident_noloc "None") None ] + in + if is_required mem.traits then B.elist [ triple access ] + else + B.pexp_match access + [ + B.case + ~lhs:(B.ppat_construct (lident_noloc "Some") (Some (B.ppat_var (Location.mknoloc "s")))) + ~guard:None + ~rhs:(B.elist [ triple (exp_ident "s") ]); + B.case ~lhs:(B.ppat_construct (lident_noloc "None") None) ~guard:None ~rhs:(B.elist []); + ] + + (* The runtime [attrs] expression for the wrapping element of a + structure/union target: the concatenation of each attribute member's + contribution. [None] when the target has no attributes (so the wrapping + element is emitted with no ~attrs). *) + let attrs_expr_of_target ~shape_resolver value_expr target_name = + match Shape_resolver.find_shape_by_name ~name:target_name shape_resolver with + | Some (Shape.StructureShape s | Shape.UnionShape s) -> + let attrs = attribute_members s in + if List.is_empty attrs then None + else ( + let contribs = List.map attrs ~f:(attribute_contribution value_expr) in + Some (B.pexp_apply (exp_ident "List.concat") [ (Nolabel, B.elist contribs) ])) + | _ -> None + + (* Emit [element w tag ?ns ?attrs body], picking [element_with_ns] when the + namespace carries a prefix. [ns] is (uri, prefix_opt). [attrs_opt] is the + runtime attrs list expression or None. *) + let element_with_namespace ~tag ~ns ~attrs_opt body_expr = + let body_arg : Ppxlib.arg_label * Ppxlib.expression = + (Ppxlib.Nolabel, B.pexp_fun Ppxlib.Nolabel None (B.ppat_var (Location.mknoloc "w")) body_expr) + in + let attrs_args : (Ppxlib.arg_label * Ppxlib.expression) list = + match attrs_opt with Some e -> [ (Ppxlib.Labelled "attrs", e) ] | None -> [] + in + let positional = [ (Ppxlib.Nolabel, exp_ident "w"); (Ppxlib.Nolabel, const_str tag) ] in + match ns with + | None -> B.pexp_apply (exp_ident "element") (positional @ attrs_args @ [ body_arg ]) + | Some (uri, None) -> + let with_ns = positional @ [ (Ppxlib.Labelled "ns", const_str uri) ] in + B.pexp_apply (exp_ident "element") (with_ns @ attrs_args @ [ body_arg ]) + | Some (uri, Some prefix) -> + let with_ns = + [ + (Ppxlib.Nolabel, exp_ident "w"); + (Ppxlib.Nolabel, const_str uri); + (Ppxlib.Nolabel, B.pexp_construct (lident_noloc "Some") (Some (const_str prefix))); + (Ppxlib.Nolabel, const_str tag); + ] + in + B.pexp_apply (exp_ident "element_with_ns") (with_ns @ attrs_args @ [ body_arg ]) + + (* Generate value expression for a member at a given path. + Returns: expr that produces unit (writes to XML writer) *) + let member_value_expr ~namespace_resolver ~shape_resolver ~member_traits ~shape_traits ~tag_name + value_expr target_name = + (* The wrapping element's namespace: the member's own [@xmlNamespace] wins, + otherwise the target shape's [@xmlNamespace] (e.g. a list/map shape's + namespace applied to its wrapping element). *) + let target_ns = + match xml_namespace_of (Some member_traits) with + | Some _ as ns -> ns + | None -> ( + match Shape_resolver.find_shape_by_name ~name:target_name shape_resolver with + | Some shape -> xml_namespace_of (Some (Shape.getShapeTraits shape)) + | None -> None) + in + (* Attribute members on a structure/union target render as attributes on + this wrapping element. *) + let attrs_opt = attrs_expr_of_target ~shape_resolver value_expr target_name in + match + primitive_serialize_helper ~member_traits:(Some member_traits) + ~shape_traits:(Some shape_traits) target_name + with + | Some helper -> + element_with_namespace ~tag:tag_name ~ns:target_ns ~attrs_opt + (helper (exp_ident "w") value_expr) + | None -> ( + let shape = Shape_resolver.find_shape_by_name ~name:target_name shape_resolver in + match shape with + | Some (Shape.ListShape ls) when is_flattened (Some member_traits) -> + (* Flattened list: the member's [] becomes the per-item + element (no container wrapper); items are emitted as repeated + siblings. *) + let elem_f = item_serializer_expr ~namespace_resolver ls.target in + B.pexp_apply (exp_ident "List.iter") + [ + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "item")) + (element_with_namespace ~tag:tag_name ~ns:target_ns ~attrs_opt + (B.pexp_apply elem_f + [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "item") ])) ); + (Nolabel, value_expr); + ] + | Some (Shape.SetShape ss) when is_flattened (Some member_traits) -> + let elem_f = item_serializer_expr ~namespace_resolver ss.target in + B.pexp_apply (exp_ident "List.iter") + [ + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "item")) + (element_with_namespace ~tag:tag_name ~ns:target_ns ~attrs_opt + (B.pexp_apply elem_f + [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "item") ])) ); + (Nolabel, value_expr); + ] + | Some (Shape.MapShape ms) when is_flattened (Some member_traits) -> + (* Flattened map: each entry becomes a repeated [] sibling + containing the key/value child elements. xmlName on key/value is + retained for flattened maps. *) + let key_f = item_serializer_expr ~namespace_resolver ms.mapKey.target in + let val_f = item_serializer_expr ~namespace_resolver ms.mapValue.target in + let key_tag = xml_name ms.mapKey.traits "key" in + let val_tag = xml_name ms.mapValue.traits "value" in + let entry_body = + B.pexp_sequence + (xml_write_call "element" + [ + (Nolabel, exp_ident "w"); + (Nolabel, const_str key_tag); + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "w")) + (B.pexp_apply key_f [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "k") ]) + ); + ]) + (xml_write_call "element" + [ + (Nolabel, exp_ident "w"); + (Nolabel, const_str val_tag); + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "w")) + (B.pexp_apply val_f [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "v") ]) + ); + ]) + in + B.pexp_apply (exp_ident "List.iter") + [ + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_tuple + [ B.ppat_var (Location.mknoloc "k"); B.ppat_var (Location.mknoloc "v") ]) + (element_with_namespace ~tag:tag_name ~ns:target_ns ~attrs_opt entry_body) ); + (Nolabel, value_expr); + ] + | _ -> + (* Normal complex type (structure/union/non-flattened list/map/set): + wrap the target's [_to_xml] (which writes the shape's content with + no outer element of its own) in the member's [] element. *) + element_with_namespace ~tag:tag_name ~ns:target_ns ~attrs_opt + (B.pexp_apply + (B.pexp_ident (Location.mknoloc (func_longident ~namespace_resolver target_name))) + [ (Nolabel, exp_ident "w"); (Nolabel, value_expr) ])) + + (* Generate expression for a structure member. [@xmlAttribute] members are + NOT written as child elements here — they render as attributes on the + wrapping element, which [member_value_expr] collects from the target + shape when a parent serializes this structure as a member. The body-root + case (operations / [@httpPayload]) is handled in Phase 7. *) + let generate_member_expr ~namespace_resolver ~shape_resolver (mem : Shape.member) = + if is_attribute mem.traits then xml_write_call "null" [ (Nolabel, exp_ident "w") ] + else begin + let is_req = is_required mem.traits in + let is_idemp = is_idempotency_token mem.traits in + let xml_key = xml_name mem.traits mem.name in + let field_access = + B.pexp_field (exp_ident "x") (lident_noloc (SafeNames.safeMemberName mem.name)) + in + let member_traits = Option.value ~default:[] mem.traits in + let shape_traits = [] in + if is_req then + member_value_expr ~namespace_resolver ~shape_resolver ~member_traits ~shape_traits + ~tag_name:xml_key field_access mem.target + else begin + let inner_expr v_expr = + member_value_expr ~namespace_resolver ~shape_resolver ~member_traits ~shape_traits + ~tag_name:xml_key v_expr mem.target + in + let none_rhs = + if is_idemp then + inner_expr + (qualified_apply ~names:[ "Smaws_Lib"; "Uuid"; "generate" ] [ (Nolabel, unit_expr) ]) + else xml_write_call "null" [ (Nolabel, exp_ident "w") ] + in + B.pexp_match field_access + [ + B.case ~lhs:(B.ppat_construct (lident_noloc "None") None) ~guard:None ~rhs:none_rhs; + B.case + ~lhs: + (B.ppat_construct (lident_noloc "Some") (Some (B.ppat_var (Location.mknoloc "v")))) + ~guard:None + ~rhs:(inner_expr (exp_ident "v")); + ] + end + end + + let enum_func_body name (s : Shape.enumShapeDetails) = + let match_exp = + B.pexp_match (exp_ident "x") + (s.members + |> List.map ~f:(fun (m : Shape.member) -> + let value = + List.find_map_exn + ~f:(fun (t : Ast.Trait.t) -> match t with EnumValueTrait e -> Some e | _ -> None) + Shape.(m.traits |> Option.value ~default:[]) + in + let constructor_name = SafeNames.safeConstructorName m.name in + B.case + ~lhs:(B.ppat_construct (lident_noloc constructor_name) None) + ~guard:None + ~rhs: + (match value with + | `String sv -> const_str sv + | `Int iv -> B.pexp_apply (exp_ident "string_of_int") [ (Nolabel, exp_int iv) ]))) + in + let type_name = SafeNames.safeTypeName name in + exp_fun_untyped "w" + (B.pexp_fun Nolabel None + (B.ppat_constraint + (B.ppat_var (Location.mknoloc "x")) + (B.ptyp_constr (lident_noloc type_name) [])) + (xml_write_call "text" [ (Nolabel, exp_ident "w"); (Nolabel, match_exp) ])) + + let list_func_body (x : Shape.listShapeDetails) ~namespace_resolver () = + let member_tag = xml_name x.memberTraits "member" in + let elem_f = item_serializer_expr ~namespace_resolver x.target in + exp_fun_untyped "w" + (exp_fun_untyped "xs" + (B.pexp_apply (exp_ident "List.iter") + [ + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "item")) + (xml_write_call "element" + [ + (Nolabel, exp_ident "w"); + (Nolabel, const_str member_tag); + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "w")) + (B.pexp_apply elem_f + [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "item") ]) ); + ]) ); + (Nolabel, exp_ident "xs"); + ])) + + let set_func_body (x : Shape.setShapeDetails) ~namespace_resolver () = + let elem_f = item_serializer_expr ~namespace_resolver x.target in + exp_fun_untyped "w" + (exp_fun_untyped "xs" + (B.pexp_apply (exp_ident "List.iter") + [ + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "item")) + (xml_write_call "element" + [ + (Nolabel, exp_ident "w"); + (Nolabel, const_str "member"); + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "w")) + (B.pexp_apply elem_f + [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "item") ]) ); + ]) ); + (Nolabel, exp_ident "xs"); + ])) + + let map_func_body (x : Shape.mapShapeDetails) ~namespace_resolver () = + let key_tag = xml_name x.mapKey.traits "key" in + let val_tag = xml_name x.mapValue.traits "value" in + let key_f = item_serializer_expr ~namespace_resolver x.mapKey.target in + let val_f = item_serializer_expr ~namespace_resolver x.mapValue.target in + let entry_body = + B.pexp_sequence + (xml_write_call "element" + [ + (Nolabel, exp_ident "w"); + (Nolabel, const_str key_tag); + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "w")) + (B.pexp_apply key_f [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "k") ]) ); + ]) + (xml_write_call "element" + [ + (Nolabel, exp_ident "w"); + (Nolabel, const_str val_tag); + ( Nolabel, + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc "w")) + (B.pexp_apply val_f [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "v") ]) ); + ]) + in + let iter_body = + B.pexp_fun Nolabel None + (B.ppat_tuple [ B.ppat_var (Location.mknoloc "k"); B.ppat_var (Location.mknoloc "v") ]) + (xml_write_call "element" + [ + (Nolabel, exp_ident "w"); + (Nolabel, const_str "entry"); + (Nolabel, B.pexp_fun Nolabel None (B.ppat_var (Location.mknoloc "w")) entry_body); + ]) + in + exp_fun_untyped "w" + (exp_fun_untyped "pairs" + (B.pexp_apply (exp_ident "List.iter") + [ (Nolabel, iter_body); (Nolabel, exp_ident "pairs") ])) + + let structure_func_body name (descriptor : Shape.structureShapeDetails) ~namespace_resolver + ~shape_resolver () = + let type_name = SafeNames.safeTypeName name in + let is_exception_type = Trait.hasTrait descriptor.traits Trait.isErrorTrait in + let effective_type_name = + if is_exception_type then SafeNames.safeTypeName name else type_name + in + let member_exprs = + List.map descriptor.members ~f:(generate_member_expr ~namespace_resolver ~shape_resolver) + in + let body = B.pexp_apply (exp_ident "ignore") [ (Nolabel, B.elist member_exprs) ] in + exp_fun_untyped "w" + (B.pexp_fun Nolabel None + (B.ppat_constraint + (B.ppat_var (Location.mknoloc "x")) + (B.ptyp_constr (lident_noloc effective_type_name) [])) + body) + + let union_func_body name (descriptor : Shape.structureShapeDetails) ~namespace_resolver + ~shape_resolver () = + let type_name = SafeNames.safeTypeName name in + let cases = + descriptor.members + |> List.map ~f:(fun (mem : Shape.member) -> + let constructor = lident_noloc (SafeNames.safeConstructorName mem.name) in + let pattern = B.ppat_construct constructor (Some (B.ppat_var (Location.mknoloc "v"))) in + let xml_key = xml_name mem.traits mem.name in + let member_traits = Option.value ~default:[] mem.traits in + let rhs = + member_value_expr ~namespace_resolver ~shape_resolver ~member_traits ~shape_traits:[] + ~tag_name:xml_key (exp_ident "v") mem.target + in + B.case ~lhs:pattern ~guard:None ~rhs) + in + let match_exp = B.pexp_match (exp_ident "x") cases in + exp_fun_untyped "w" + (B.pexp_fun Nolabel None + (B.ppat_constraint + (B.ppat_var (Location.mknoloc "x")) + (B.ptyp_constr (lident_noloc type_name) [])) + match_exp) + + let generate_func_body (shapeWithTarget : Dependencies.shapeWithTarget) + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) + ~(shape_resolver : Shape_resolver.t) () = + match shapeWithTarget.descriptor with + | StructureShape { members = []; _ } -> + Some + (exp_fun_untyped "w" + (exp_fun_untyped "_x" (xml_write_call "null" [ (Nolabel, exp_ident "w") ]))) + | StructureShape x -> + Some (structure_func_body shapeWithTarget.name x ~namespace_resolver ~shape_resolver ()) + | ListShape x -> Some (list_func_body x ~namespace_resolver ()) + | SetShape x -> Some (set_func_body x ~namespace_resolver ()) + | MapShape x -> Some (map_func_body x ~namespace_resolver ()) + | EnumShape s -> Some (enum_func_body shapeWithTarget.name s) + | UnionShape x -> + Some (union_func_body shapeWithTarget.name x ~namespace_resolver ~shape_resolver ()) + | TimestampShape { traits } -> + let fmt = + resolve_timestamp_format ~shape_traits:(Some (Option.value ~default:[] traits)) () + in + let helper_name = + match fmt with + | Trait.TimestampFormatDateTime -> "timestamp_iso_to_string" + | Trait.TimestampFormatEpochSeconds -> "timestamp_epoch_to_string" + | Trait.TimestampFormatHttpDate -> "timestamp_httpdate_to_string" + in + let helper_mod = [ "Smaws_Lib"; "Protocols"; "RestXml"; "Serialize" ] in + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + ( Nolabel, + qualified_apply ~names:(helper_mod @ [ helper_name ]) + [ (Nolabel, exp_ident "v") ] ); + ]))) + | StringShape { traits } -> + let has_timestamp_fmt = + Option.value ~default:[] traits + |> List.exists ~f:(function Trait.TimestampFormatTrait _ -> true | _ -> false) + in + if has_timestamp_fmt then ( + let fmt = + resolve_timestamp_format ~shape_traits:(Some (Option.value ~default:[] traits)) () + in + let helper_name = + match fmt with + | Trait.TimestampFormatDateTime -> "timestamp_iso_to_string" + | Trait.TimestampFormatEpochSeconds -> "timestamp_epoch_to_string" + | Trait.TimestampFormatHttpDate -> "timestamp_httpdate_to_string" + in + let helper_mod = [ "Smaws_Lib"; "Protocols"; "RestXml"; "Serialize" ] in + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + ( Nolabel, + qualified_apply ~names:(helper_mod @ [ helper_name ]) + [ (Nolabel, exp_ident "v") ] ); + ])))) + else + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "v") ]))) + | IntegerShape _ | ShortShape _ | ByteShape _ -> + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + (Nolabel, B.pexp_apply (exp_ident "string_of_int") [ (Nolabel, exp_ident "v") ]); + ]))) + | LongShape _ -> + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + ( Nolabel, + qualified_apply + ~names:[ "Smaws_Lib"; "CoreTypes"; "Int64"; "to_string" ] + [ (Nolabel, exp_ident "v") ] ); + ]))) + | BooleanShape _ -> + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + ( Nolabel, + B.pexp_apply (exp_ident "string_of_bool") [ (Nolabel, exp_ident "v") ] ); + ]))) + | FloatShape _ | DoubleShape _ -> + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + ( Nolabel, + qualified_apply + ~names: + [ + "Smaws_Lib"; + "Protocols"; + "RestXml"; + "Serialize"; + "float_field_to_string"; + ] + [ (Nolabel, exp_ident "v") ] ); + ]))) + | BlobShape _ -> + Some + (exp_fun_untyped "w" + (exp_fun_untyped "v" + (xml_write_call "text" + [ + (Nolabel, exp_ident "w"); + ( Nolabel, + qualified_apply ~names:[ "Base64"; "encode_exn" ] + [ + ( Nolabel, + B.pexp_apply (exp_ident "Bytes.to_string") [ (Nolabel, exp_ident "v") ] + ); + ] ); + ]))) + | UnitShape -> + Some + (exp_fun_untyped "w" + (exp_fun_untyped "_x" (xml_write_call "null" [ (Nolabel, exp_ident "w") ]))) + | _ -> None + + let generate ~(structure_shapes : Ast.Dependencies.shapeWithTarget list) + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) + ~(shape_resolver : Shape_resolver.t) () = + structure_shapes + |> List.filter_map ~f:(fun (shapeWithTarget : Dependencies.shapeWithTarget) -> + let serialiser_name = serialiser_func_str shapeWithTarget.name in + let func_body = generate_func_body shapeWithTarget ~namespace_resolver ~shape_resolver () in + let shape = + Option.value_map func_body ~default:[] ~f:(fun func_body -> + [ + B.value_binding ~pat:(B.ppat_var (Location.mknoloc serialiser_name)) ~expr:func_body; + ]) + in + let all_shapes = + match shapeWithTarget.recursWith with + | Some recursWith -> + let recurs = + List.filter_map recursWith ~f:(fun (swt : Dependencies.shapeWithTarget) -> + let sname = serialiser_func_str swt.name in + let fb = generate_func_body swt ~namespace_resolver ~shape_resolver () in + Option.map fb ~f:(fun body -> + B.value_binding ~pat:(B.ppat_var (Location.mknoloc sname)) ~expr:body)) + in + shape @ recurs + | None -> shape + in + if List.is_empty all_shapes then None + else + Some + (B.pstr_value + (if + List.length all_shapes > 1 + || shapeWithTarget |> Dependencies.is_recursive_shape_with_target + then Recursive + else Nonrecursive) + all_shapes)) +end + +(* ============================================================ *) +(* Deserialiser *) +(* ============================================================ *) + +module Deserialiser = struct + let deserialiser_func_str name = (name |> SafeNames.safeFunctionName) ^ "_of_xml" + let xml_read_mod = [ "Read" ] + let xml_struct_mod = [ "Structure" ] + let xml_call module_path func args = qualified_apply ~names:(module_path @ [ func ]) args + + let read_element tag = + xml_call xml_read_mod "element" + [ (Nolabel, exp_ident "i"); (Nolabel, const_str tag); (Nolabel, unit_expr) ] + + let read_elements tag = + xml_call xml_read_mod "elements" + [ (Nolabel, exp_ident "i"); (Nolabel, const_str tag); (Nolabel, unit_expr) ] + + let read_sequence tag body = + xml_call xml_read_mod "sequence" + [ + (Nolabel, exp_ident "i"); + (Nolabel, const_str tag); + (Nolabel, exp_fun_ident_any "i" body); + (Nolabel, unit_expr); + ] + + let read_sequences tag body = + xml_call xml_read_mod "sequences" + [ + (Nolabel, exp_ident "i"); + (Nolabel, const_str tag); + (Nolabel, exp_fun_ident_any "i" body); + (Nolabel, unit_expr); + ] + + let skip_element_expr = xml_call xml_read_mod "skip_element" [ (Nolabel, exp_ident "i") ] + + let func_longident ~namespace_resolver target_name = + let symbol_transformer ~local x = + if local then [ deserialiser_func_str x ] + else [ "Xml_deserializers"; deserialiser_func_str x ] + in + Namespace_resolver.Namespace_resolver.resolve_reference ~symbol_transformer namespace_resolver + target_name + |> Longident.unflatten |> Option.value_exn + + let xml_primitive_mod = [ "Primitive" ] + + (* The [Xml.Parse.Primitive._of_string] converter for a smithy primitive + target, or [None] for non-primitives. [String] maps to [Fun.id] (no parse, + no failure); [Timestamp] defaults to the iso (rfc3339) format, matching the + previous [Ptime.of_rfc3339] behaviour for list/map items — member + timestamps take a format-specific path in [member_reader_expr]. *) + let primitive_conv target_name = + match target_name with + | "smithy.api#String" -> Some (exp_ident "Fun.id") + | "smithy.api#Integer" | "smithy.api#Byte" | "smithy.api#Short" -> + Some (qualified_ident ~names:(xml_primitive_mod @ [ "int_of_string" ])) + | "smithy.api#Long" -> Some (qualified_ident ~names:(xml_primitive_mod @ [ "long_of_string" ])) + | "smithy.api#BigInteger" -> + Some (qualified_ident ~names:(xml_primitive_mod @ [ "big_int_of_string" ])) + | "smithy.api#BigDecimal" -> + Some (qualified_ident ~names:(xml_primitive_mod @ [ "big_decimal_of_string" ])) + | "smithy.api#Boolean" -> + Some (qualified_ident ~names:(xml_primitive_mod @ [ "bool_of_string" ])) + | "smithy.api#Float" -> + Some (qualified_ident ~names:(xml_primitive_mod @ [ "float_of_string" ])) + | "smithy.api#Double" -> + Some (qualified_ident ~names:(xml_primitive_mod @ [ "double_of_string" ])) + | "smithy.api#Blob" -> Some (qualified_ident ~names:(xml_primitive_mod @ [ "blob_of_string" ])) + | "smithy.api#Timestamp" -> + Some (qualified_ident ~names:(xml_primitive_mod @ [ "timestamp_iso_of_string" ])) + | _ -> None + + (* Read []'s text and run [conv] on it, decorating a parse failure + with [tag] (see [Xml.Parse.Read.element_value]). *) + let read_element_value tag conv = + xml_call xml_read_mod "element_value" + [ (Nolabel, exp_ident "i"); (Nolabel, const_str tag); (Nolabel, conv); (Nolabel, unit_expr) ] + + (* Read every [] child's text and map [conv] across them, decorating a + parse failure with [tag] (see [Xml.Parse.Read.elements_value]). *) + let read_elements_value tag conv = + xml_call xml_read_mod "elements_value" + [ (Nolabel, exp_ident "i"); (Nolabel, const_str tag); (Nolabel, conv); (Nolabel, unit_expr) ] + + let map_entry_body ~namespace_resolver (ms : Shape.mapShapeDetails) = + let key_tag = xml_name ms.mapKey.traits "key" in + let val_tag = xml_name ms.mapValue.traits "value" in + let key_expr = + match primitive_conv ms.mapKey.target with + | Some conv -> read_element_value key_tag conv + | None -> + let kf = + B.pexp_ident (Location.mknoloc (func_longident ~namespace_resolver ms.mapKey.target)) + in + read_sequence key_tag (B.pexp_apply kf [ (Nolabel, exp_ident "i") ]) + in + let val_expr = + match primitive_conv ms.mapValue.target with + | Some conv -> read_element_value val_tag conv + | None -> + let vf = + B.pexp_ident (Location.mknoloc (func_longident ~namespace_resolver ms.mapValue.target)) + in + read_sequence val_tag (B.pexp_apply vf [ (Nolabel, exp_ident "i") ]) + in + B.pexp_let Nonrecursive + [ B.value_binding ~pat:(B.ppat_var (Location.mknoloc "k")) ~expr:key_expr ] + (B.pexp_let Nonrecursive + [ B.value_binding ~pat:(B.ppat_var (Location.mknoloc "v")) ~expr:val_expr ] + (B.pexp_tuple [ exp_ident "k"; exp_ident "v" ])) + + let list_items_body ~namespace_resolver target item_tag = + match primitive_conv target with + | Some conv -> read_elements_value item_tag conv + | None -> + let item_func = + B.pexp_ident (Location.mknoloc (func_longident ~namespace_resolver target)) + in + read_sequences item_tag (B.pexp_apply item_func [ (Nolabel, exp_ident "i") ]) + + let member_reader_expr ~namespace_resolver ~shape_resolver ~member_traits xml_tag target_name + ref_name = + let assign v_expr = + B.pexp_apply + (B.pexp_ident (Location.mknoloc (Longident.Lident ":="))) + [ + (Nolabel, B.pexp_ident (Location.mknoloc (Longident.Lident ref_name))); + (Nolabel, B.pexp_construct (lident_noloc "Some") (Some v_expr)); + ] + in + match target_name with + | "smithy.api#Timestamp" -> + let fmt = resolve_timestamp_format ~member_traits ~shape_traits:None () in + let helper = + match fmt with + | Trait.TimestampFormatDateTime -> "timestamp_iso_of_string" + | Trait.TimestampFormatEpochSeconds -> "timestamp_epoch_of_string" + | Trait.TimestampFormatHttpDate -> "timestamp_httpdate_of_string" + in + let conv = qualified_ident ~names:(xml_primitive_mod @ [ helper ]) in + assign (read_element_value xml_tag conv) + | _ -> ( + match primitive_conv target_name with + | Some conv -> assign (read_element_value xml_tag conv) + | None -> ( + let shape = Shape_resolver.find_shape_by_name ~name:target_name shape_resolver in + match shape with + | Some (Shape.ListShape ls) when is_flattened member_traits -> + assign (list_items_body ~namespace_resolver ls.target xml_tag) + | Some (Shape.ListShape ls) -> + let member_tag = xml_name ls.memberTraits "member" in + assign + (read_sequence xml_tag (list_items_body ~namespace_resolver ls.target member_tag)) + | Some (Shape.SetShape ss) -> + let set_body = read_elements "member" in + assign (read_sequence xml_tag set_body) + | Some (Shape.MapShape ms) when is_flattened member_traits -> + assign (read_sequences xml_tag (map_entry_body ~namespace_resolver ms)) + | Some (Shape.MapShape ms) -> + assign + (read_sequence xml_tag + (read_sequences "entry" (map_entry_body ~namespace_resolver ms))) + | _ -> + let item_func = + B.pexp_ident (Location.mknoloc (func_longident ~namespace_resolver target_name)) + in + assign (read_sequence xml_tag (B.pexp_apply item_func [ (Nolabel, exp_ident "i") ])) + )) + + let member_ref_name (mem : Shape.member) = "r_" ^ SafeNames.safeMemberName mem.name + + let structure_ref_bindings (members : Shape.member list) = + List.map members ~f:(fun mem -> + B.value_binding + ~pat:(B.ppat_var (Location.mknoloc (member_ref_name mem))) + ~expr: + (B.pexp_apply (exp_ident "ref") + [ (Nolabel, B.pexp_construct (lident_noloc "None") None) ])) + + let structure_scan_cases ~namespace_resolver ~shape_resolver (members : Shape.member list) = + List.map members ~f:(fun (mem : Shape.member) -> + let xml_tag = xml_name mem.traits mem.name in + let reader = + member_reader_expr ~namespace_resolver ~shape_resolver ~member_traits:mem.traits xml_tag + mem.target (member_ref_name mem) + in + B.case ~lhs:(pat_const_str xml_tag) ~guard:None ~rhs:reader) + + let structure_scan_call ~namespace_resolver ~shape_resolver (members : Shape.member list) = + let xml_tags = List.map members ~f:(fun (mem : Shape.member) -> xml_name mem.traits mem.name) in + let cases = structure_scan_cases ~namespace_resolver ~shape_resolver members in + let wildcard_case = B.case ~lhs:B.ppat_any ~guard:None ~rhs:skip_element_expr in + xml_call xml_struct_mod "scanSequence" + [ + (Nolabel, exp_ident "i"); + (Nolabel, B.elist (List.map xml_tags ~f:const_str)); + ( Nolabel, + exp_fun_ident_any "tag" (B.pexp_match (exp_ident "tag") (cases @ [ wildcard_case ])) ); + ] + + let structure_record_fields (members : Shape.member list) = + List.map members ~f:(fun (mem : Shape.member) -> + let is_req = is_required mem.traits in + let field_key = lident_noloc (SafeNames.safeMemberName mem.name) in + let deref = + B.pexp_apply (exp_ident "( ! )") [ (Nolabel, exp_ident (member_ref_name mem)) ] + in + let field_val = + if is_req then + xml_call [] "required" + [ + (Nolabel, const_str (xml_name mem.traits mem.name)); + (Nolabel, deref); + (Nolabel, exp_ident "i"); + ] + else deref + in + (field_key, field_val)) + + let structure_func_body name (descriptor : Shape.structureShapeDetails) ~namespace_resolver + ~shape_resolver () = + let type_name_str = SafeNames.safeTypeName name in + let type_name = B.ptyp_constr (lident_noloc type_name_str) [] in + let members = descriptor.members in + if List.is_empty members then exp_fun_untyped "i" [%expr ((() : unit) : [%t type_name])] + else begin + let ref_bindings = structure_ref_bindings members in + let scan_call = structure_scan_call ~namespace_resolver ~shape_resolver members in + let record_expr = B.pexp_record (structure_record_fields members) None in + let typed_record = B.pexp_constraint record_expr type_name in + let body = + List.fold_right ref_bindings ~init:(B.pexp_sequence scan_call typed_record) + ~f:(fun binding acc -> B.pexp_let Nonrecursive [ binding ] acc) + in + exp_fun_untyped "i" body + end + + let union_func_body name (descriptor : Shape.structureShapeDetails) ~namespace_resolver + ~shape_resolver () = + let type_name_str = SafeNames.safeTypeName name in + let type_name = B.ptyp_constr (lident_noloc type_name_str) [] in + let members = descriptor.members in + let ref_bindings = structure_ref_bindings members in + let scan_call = structure_scan_call ~namespace_resolver ~shape_resolver members in + let select_expr = + List.fold_right members ~init:[%expr failwith "no union member present in xml response"] + ~f:(fun mem acc -> + let constructor = SafeNames.safeConstructorName mem.name in + let deref = + B.pexp_apply (exp_ident "( ! )") [ (Nolabel, exp_ident (member_ref_name mem)) ] + in + B.pexp_match deref + [ + B.case + ~lhs: + (B.ppat_construct (lident_noloc "Some") + (Some (B.ppat_var (Location.mknoloc "v")))) + ~guard:None + ~rhs:(B.pexp_construct (lident_noloc constructor) (Some (exp_ident "v"))); + B.case ~lhs:(B.ppat_construct (lident_noloc "None") None) ~guard:None ~rhs:acc; + ]) + in + let typed_select = B.pexp_constraint select_expr type_name in + let body = + List.fold_right ref_bindings ~init:(B.pexp_sequence scan_call typed_select) + ~f:(fun binding acc -> B.pexp_let Nonrecursive [ binding ] acc) + in + exp_fun_untyped "i" body + + let list_func_body (x : Shape.listShapeDetails) ~namespace_resolver ~shape_resolver () = + let member_tag = xml_name x.memberTraits "member" in + exp_fun_untyped "i" (list_items_body ~namespace_resolver x.target member_tag) + + let set_func_body (x : Shape.setShapeDetails) ~namespace_resolver ~shape_resolver () = + let body = read_elements "member" in + exp_fun_untyped "i" body + + let map_func_body (x : Shape.mapShapeDetails) ~namespace_resolver () = + exp_fun_untyped "i" (read_sequences "entry" (map_entry_body ~namespace_resolver x)) + + let enum_func_body name (s : Shape.enumShapeDetails) ~namespace_resolver () = + let type_name_str = SafeNames.safeTypeName name in + let type_name = B.ptyp_constr (lident_noloc type_name_str) [] in + let cases = + s.members + |> List.map ~f:(fun (m : Shape.member) -> + let value = + List.find_map_exn + ~f:(fun (t : Ast.Trait.t) -> match t with EnumValueTrait e -> Some e | _ -> None) + Shape.(m.traits |> Option.value ~default:[]) + in + let pattern = + match value with + | `String sv -> pat_const_str sv + | `Int iv -> pat_const_str (Int.to_string iv) + in + B.case ~lhs:pattern ~guard:None + ~rhs:(B.pexp_construct (lident_noloc (SafeNames.safeConstructorName m.name)) None)) + in + let failure_case = + B.case ~lhs:B.ppat_any ~guard:None ~rhs:[%expr failwith "unknown enum value"] + in + let match_exp = B.pexp_match (exp_ident "s") (cases @ [ failure_case ]) in + exp_fun_untyped "i" + (B.pexp_let Nonrecursive + [ + B.value_binding + ~pat:(B.ppat_var (Location.mknoloc "s")) + ~expr:(xml_call xml_read_mod "data" [ (Nolabel, exp_ident "i") ]); + ] + (B.pexp_constraint match_exp type_name)) + + let deser_mod = xml_primitive_mod + + let read_data_lambda () = + exp_fun_untyped "i" (xml_call xml_read_mod "data" [ (Nolabel, exp_ident "i") ]) + + let primitive_of_xml_lambda helper = + let s_expr = xml_call xml_read_mod "data" [ (Nolabel, exp_ident "i") ] in + exp_fun_untyped "i" (qualified_apply ~names:(deser_mod @ [ helper ]) [ (Nolabel, s_expr) ]) + + let generate_func_body (shapeWithTarget : Dependencies.shapeWithTarget) + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) + ~(shape_resolver : Shape_resolver.t) () = + match shapeWithTarget.descriptor with + | StructureShape { members = []; _ } -> Some (exp_fun_untyped "i" unit_expr) + | StructureShape x -> + Some (structure_func_body shapeWithTarget.name x ~namespace_resolver ~shape_resolver ()) + | ListShape x -> Some (list_func_body x ~namespace_resolver ~shape_resolver ()) + | SetShape x -> Some (set_func_body x ~namespace_resolver ~shape_resolver ()) + | MapShape x -> Some (map_func_body x ~namespace_resolver ()) + | EnumShape s -> Some (enum_func_body shapeWithTarget.name s ~namespace_resolver ()) + | TimestampShape { traits } -> + let fmt = + resolve_timestamp_format ~shape_traits:(Some (Option.value ~default:[] traits)) () + in + let helper = + match fmt with + | Trait.TimestampFormatDateTime -> "timestamp_iso_of_string" + | Trait.TimestampFormatEpochSeconds -> "timestamp_epoch_of_string" + | Trait.TimestampFormatHttpDate -> "timestamp_httpdate_of_string" + in + let s_expr = xml_call xml_read_mod "data" [ (Nolabel, exp_ident "i") ] in + Some + (exp_fun_untyped "i" + (qualified_apply ~names:(deser_mod @ [ helper ]) [ (Nolabel, s_expr) ])) + | StringShape { traits } -> + let has_timestamp_fmt = + Option.value ~default:[] traits + |> List.exists ~f:(function Trait.TimestampFormatTrait _ -> true | _ -> false) + in + if has_timestamp_fmt then ( + let fmt = + resolve_timestamp_format ~shape_traits:(Some (Option.value ~default:[] traits)) () + in + let helper = + match fmt with + | Trait.TimestampFormatDateTime -> "timestamp_iso_of_string" + | Trait.TimestampFormatEpochSeconds -> "timestamp_epoch_of_string" + | Trait.TimestampFormatHttpDate -> "timestamp_httpdate_of_string" + in + let s_expr = xml_call xml_read_mod "data" [ (Nolabel, exp_ident "i") ] in + Some + (exp_fun_untyped "i" + (qualified_apply ~names:(deser_mod @ [ helper ]) [ (Nolabel, s_expr) ]))) + else Some (read_data_lambda ()) + | LongShape _ -> Some (primitive_of_xml_lambda "long_of_string") + | IntegerShape _ | ShortShape _ | ByteShape _ -> Some (primitive_of_xml_lambda "int_of_string") + | BigIntegerShape _ -> Some (primitive_of_xml_lambda "big_int_of_string") + | BigDecimalShape _ -> Some (primitive_of_xml_lambda "big_decimal_of_string") + | BooleanShape _ -> Some (primitive_of_xml_lambda "bool_of_string") + | FloatShape _ | DoubleShape _ -> Some (primitive_of_xml_lambda "float_of_string") + | BlobShape _ -> Some (primitive_of_xml_lambda "blob_of_string") + | UnitShape -> Some (exp_fun_untyped "i" unit_expr) + | UnionShape x -> + Some (union_func_body shapeWithTarget.name x ~namespace_resolver ~shape_resolver ()) + | _ -> None + + let generate ~(structure_shapes : Ast.Dependencies.shapeWithTarget list) + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) + ~(shape_resolver : Shape_resolver.t) () = + structure_shapes + |> List.filter_map ~f:(fun (shapeWithTarget : Dependencies.shapeWithTarget) -> + let func_name = deserialiser_func_str shapeWithTarget.name in + let func_body = generate_func_body shapeWithTarget ~namespace_resolver ~shape_resolver () in + let shape = + Option.value_map func_body ~default:[] ~f:(fun body -> + [ B.value_binding ~pat:(B.ppat_var (Location.mknoloc func_name)) ~expr:body ]) + in + let all_shapes = + match shapeWithTarget.recursWith with + | Some recursWith -> + let recurs = + List.filter_map recursWith ~f:(fun (swt : Dependencies.shapeWithTarget) -> + let sname = deserialiser_func_str swt.name in + let fb = generate_func_body swt ~namespace_resolver ~shape_resolver () in + Option.map fb ~f:(fun body -> + B.value_binding ~pat:(B.ppat_var (Location.mknoloc sname)) ~expr:body)) + in + shape @ recurs + | None -> shape + in + if List.is_empty all_shapes then None + else + Some + (B.pstr_value + (if + List.length all_shapes > 1 + || shapeWithTarget |> Dependencies.is_recursive_shape_with_target + then Recursive + else Nonrecursive) + all_shapes)) +end + +(* ============================================================ *) +(* Operations *) +(* ============================================================ *) + +module Operations = struct + let restxml_mod = [ "Smaws_Lib"; "Protocols"; "RestXml" ] + + let extract_xml_namespace (service : Shape.serviceShapeDetails) = + Option.value ~default:"" + (Option.bind service.traits ~f:(fun ts -> + List.find_map ts ~f:(function Trait.ApiXmlNamespaceTrait ns -> Some ns.uri | _ -> None))) + + let generate_error_to_string ~(operation_shape : Ast.Shape.operationShapeDetails) + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) () = + let errors = operation_shape.errors |> Option.value ~default:[] in + let handler_body = + let default_handler = qualified_ident ~names:(restxml_mod @ [ "error_to_string" ]) in + match errors with + | [] -> default_handler + | errors -> + let error_cases = + errors + |> List.map ~f:(fun error -> + let name = SafeNames.safeConstructorName error in + B.case + ~lhs:(B.ppat_variant name (Some B.ppat_any)) + ~guard:None ~rhs:(const_str error)) + in + let default_case = + B.case + ~lhs: + (B.ppat_alias + (B.ppat_type (Location.mknoloc (make_lident ~names:(restxml_mod @ [ "error" ])))) + (Location.mknoloc "e")) + ~guard:None + ~rhs:(B.pexp_apply default_handler [ (Nolabel, exp_ident "e") ]) + in + B.pexp_function_cases (error_cases @ [ default_case ]) + in + B.pstr_value Nonrecursive + [ B.value_binding ~pat:(B.ppat_var (Location.mknoloc "error_to_string")) ~expr:handler_body ] + + let generate_error_handler ~(operation_shape : Ast.Shape.operationShapeDetails) + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) + ~(shape_resolver : Shape_resolver.t) () = + let errors = operation_shape.errors |> Option.value ~default:[] in + let default_handler = qualified_ident ~names:(restxml_mod @ [ "Errors"; "default_handler" ]) in + let parse_error_struct = qualified_ident ~names:(restxml_mod @ [ "parse_error_struct" ]) in + let body = + if List.is_empty errors then + [%expr + fun (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ -> + Smaws_Lib.Protocols.RestXml.Errors.default_handler error] + else begin + let cases = + errors + |> List.map ~f:(fun error -> + let wire_code = Util.symbolName error in + let variant = SafeNames.safeConstructorName error in + let deser_func = Deserialiser.func_longident ~namespace_resolver error in + let parse_call = + B.pexp_apply parse_error_struct + [ + (Labelled "body", exp_ident "body"); + (Labelled "structParser", B.pexp_ident (Location.mknoloc deser_func)); + ] + in + let rhs = + B.pexp_match parse_call + [ + B.case + ~lhs: + (B.ppat_construct (lident_noloc "Ok") + (Some (B.ppat_var (Location.mknoloc "s")))) + ~guard:None + ~rhs:(B.pexp_variant variant (Some (exp_ident "s"))); + B.case + ~lhs: + (B.ppat_construct (lident_noloc "Error") + (Some + (B.ppat_construct (lident_noloc "XmlParseError") + (Some (B.ppat_var (Location.mknoloc "msg")))))) + ~guard:None + ~rhs:(B.pexp_variant "XmlParseError" (Some (exp_ident "msg"))); + ] + in + B.case ~lhs:(pat_const_str wire_code) ~guard:None ~rhs) + in + let default_case = + B.case ~lhs:B.ppat_any ~guard:None + ~rhs:(B.pexp_apply default_handler [ (Nolabel, exp_ident "error") ]) + in + let match_body = + B.pexp_match [%expr error.Smaws_Lib.Protocols.RestXml.Error.code] + (cases @ [ default_case ]) + in + [%expr fun (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body -> [%e match_body]] + end + in + B.pstr_value Nonrecursive + [ B.value_binding ~pat:(B.ppat_var (Location.mknoloc "error_deserializer")) ~expr:body ] + + let generate_request_handler ~name ~operation_name + ~(operation_shape : Ast.Shape.operationShapeDetails) ~alias_context ~xml_namespace + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) () = + let shape_name = Util.symbolName operation_name in + let input_serializer = + operation_shape.input + |> Option.value_map ~default:[%expr ()] ~f:(fun input_name -> + if String.equal input_name "smithy.api#Unit" then [%expr ()] + else ( + let sym_transformer ~local x = + if local then [ Serialiser.serialiser_func_str x ] + else [ "Xml_serializers"; Serialiser.serialiser_func_str x ] + in + let func_ident = + Namespace_resolver.Namespace_resolver.resolve_reference + ~symbol_transformer:sym_transformer namespace_resolver input_name + |> Longident.unflatten |> Option.value_exn + in + B.pexp_apply + (B.pexp_ident (Location.mknoloc func_ident)) + [ (Nolabel, exp_ident "w"); (Nolabel, exp_ident "request") ])) + in + let output_deserializer = + operation_shape.output + |> Option.value_map + ~default:(qualified_ident ~names:[ "Xml_deserializers"; "unit_of_xml" ]) + ~f:(fun output_name -> + if String.equal output_name "smithy.api#Unit" then + qualified_ident ~names:[ "Xml_deserializers"; "unit_of_xml" ] + else ( + let sym_transformer ~local x = + if local then [ Deserialiser.deserialiser_func_str x ] + else [ "Xml_deserializers"; Deserialiser.deserialiser_func_str x ] + in + let func_ident = + Namespace_resolver.Namespace_resolver.resolve_reference + ~symbol_transformer:sym_transformer namespace_resolver output_name + |> Longident.unflatten |> Option.value_exn + in + B.pexp_ident (Location.mknoloc func_ident))) + in + let request_func = qualified_ident ~names:(restxml_mod @ [ "request" ]) in + let shape_func_body = + [%expr + let w = Smaws_Lib.Xml.Write.make () in + [%e input_serializer]; + let body_str = Smaws_Lib.Xml.Write.to_string w in + [%e request_func] ~shape_name:[%e const_str shape_name] ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:[%e output_deserializer] ~error_deserializer] + in + let shape_func = + Option.value_map operation_shape.input ~default:shape_func_body ~f:(fun input_name -> + B.pexp_fun Nolabel None + (B.ppat_constraint + (B.ppat_var (Location.mknoloc "request")) + (Types.resolve alias_context ~name:input_name ~namespace_resolver ())) + shape_func_body) + in + [%stri let request = fun context -> [%e shape_func]] + + let generate_operation_module ~name ~operation_name ~operation_shape ~dependencies ~alias_context + ~xml_namespace ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) + ~(shape_resolver : Shape_resolver.t) () = + let module_name = SafeNames.safeConstructorName operation_name in + let error_to_string = generate_error_to_string ~operation_shape ~namespace_resolver () in + let error_handler = + generate_error_handler ~operation_shape ~namespace_resolver ~shape_resolver () + in + let request_handler = + generate_request_handler ~name ~operation_name ~operation_shape ~alias_context ~xml_namespace + ~namespace_resolver () + in + let module_items = [ error_to_string; error_handler; request_handler ] in + let module_expr = B.pmod_structure module_items in + B.pstr_module (B.module_binding ~name:(Location.mknoloc (Some module_name)) ~expr:module_expr) + + let generate ~name ~(service : Shape.serviceShapeDetails) ~operation_shapes ~alias_context + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) + ~(shape_resolver : Shape_resolver.t) () = + let xml_namespace = extract_xml_namespace service in + operation_shapes + |> List.map ~f:(fun (operation_name, operation_shape, dependencies) -> + generate_operation_module ~name ~operation_name ~operation_shape ~dependencies + ~alias_context ~xml_namespace ~namespace_resolver ~shape_resolver ()) + + let generate_operation_module_sig ~name ~operation_name ~operation_shape ~dependencies + ~alias_context ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) () = + let open Ast.Shape in + let module_name = SafeNames.safeConstructorName operation_name in + let input_type = + Option.bind operation_shape.input ~f:(fun input -> + Some (Types.resolve alias_context ~name:input ~namespace_resolver ())) + in + let output_type = + Option.bind operation_shape.output ~f:(fun output -> + Some (Types.resolve alias_context ~name:output ~namespace_resolver ())) + in + let val_request = + let request_type = + match input_type with + | Some input_typ -> + B.ptyp_arrow Nolabel input_typ + (B.ptyp_constr (lident_noloc "result") + [ + (match output_type with + | Some t -> t + | None -> B.ptyp_constr (lident_noloc "unit") []); + B.ptyp_constr (lident_noloc "Smaws_Lib.Protocols.RestXml.error") []; + ]) + | None -> + B.ptyp_constr (lident_noloc "result") + [ + (match output_type with + | Some t -> t + | None -> B.ptyp_constr (lident_noloc "unit") []); + B.ptyp_constr (lident_noloc "Smaws_Lib.Protocols.RestXml.error") []; + ] + in + B.value_description ~name:(Location.mknoloc "request") + ~type_: + (B.ptyp_arrow Nolabel + (B.ptyp_constr (lident_noloc "Smaws_Lib.Context.t") [ B.ptyp_var "_" ]) + request_type) + ~prim:[] + in + let module_sig = + B.psig_module + (B.module_declaration + ~name:(Location.mknoloc (Some module_name)) + ~type_:(B.pmty_signature [ B.psig_value val_request ])) + in + module_sig + + let generate_mli ~name ~(service : Shape.serviceShapeDetails) ~operation_shapes ~alias_context + ~(namespace_resolver : Namespace_resolver.Namespace_resolver.t) () = + operation_shapes + |> List.map ~f:(fun (operation_name, operation_shape, dependencies) -> + generate_operation_module_sig ~name ~operation_name ~operation_shape ~dependencies + ~alias_context ~namespace_resolver ()) +end diff --git a/codegen/Modules.ml b/codegen/Modules.ml index 0862334c..e1b5366e 100644 --- a/codegen/Modules.ml +++ b/codegen/Modules.ml @@ -6,6 +6,10 @@ let auth = sdkLib ^ ".Auth" let protocols = sdkLib ^ ".Protocols" let protocolAwsQuery = protocols ^ ".AwsQuery" let protocolAwsJson = protocols ^ ".AwsJson" +let protocolRestXml = protocols ^ ".RestXml" let json = sdkLib ^ ".Json" let jsonSerializeHelpers = json ^ ".SerializeHelpers" let jsonDeserializeHelpers = json ^ ".DeserializeHelpers" +let xml = sdkLib ^ ".Xml" +let xmlWrite = xml ^ ".Write" +let xmlParse = xml ^ ".Parse" diff --git a/codegen/Ppx_util.ml b/codegen/Ppx_util.ml index 328195e1..ac602df6 100644 --- a/codegen/Ppx_util.ml +++ b/codegen/Ppx_util.ml @@ -46,5 +46,18 @@ let exp_fun_with_return_type return_type arg_name arg_type exp = let exp_fun_untyped arg_name exp = B.pexp_fun Nolabel None (B.ppat_var (Location.mknoloc arg_name)) exp +(** [fun arg _ -> exp]: a two-parameter lambda whose second parameter is ignored. Used by XML + [Read.sequence]/[Read.sequences] callbacks. *) +let exp_fun_ident_any arg_name exp = + B.pexp_fun Nolabel None + (B.ppat_var (Location.mknoloc arg_name)) + (B.pexp_fun Nolabel None B.ppat_any exp) + +(** A fully-qualified identifier expression, e.g. [Smaws_Lib.Xml.Write.text]. *) +let qualified_ident ~names = B.pexp_ident (Location.mknoloc (make_lident ~names)) + +(** Application of a fully-qualified identifier to [args]. *) +let qualified_apply ~names args = B.pexp_apply (qualified_ident ~names) args + let const_str s = B.pexp_constant (Pconst_string (s, loc, None)) let pat_const_str s = B.ppat_constant (Pconst_string (s, loc, None)) diff --git a/codegen/Service_metadata.ml b/codegen/Service_metadata.ml index 60a9c98b..1d3a7000 100644 --- a/codegen/Service_metadata.ml +++ b/codegen/Service_metadata.ml @@ -18,7 +18,7 @@ let stri_service_metadata (service : Ast.Shape.serviceShapeDetails) = List.find_map traits ~f:(function | Ast.Trait.AwsProtocolAwsJson1_0Trait -> Some [%expr Smaws_Lib.Service.AwsJson_1_0] | Ast.Trait.AwsProtocolAwsJson1_1Trait -> Some [%expr Smaws_Lib.Service.AwsJson_1_1] - | Ast.Trait.AwsProtocolRestXmlTrait -> Some [%expr Smaws_Lib.Service.RestXml] + | Ast.Trait.AwsProtocolRestXmlTrait _ -> Some [%expr Smaws_Lib.Service.RestXml] | Ast.Trait.AwsProtocolEc2QueryTrait -> Some [%expr Smaws_Lib.Service.Ec2Query] | Ast.Trait.AwsProtocolRestJson1Trait -> Some [%expr Smaws_Lib.Service.RestJson] | Ast.Trait.AwsProtocolAwsQueryTrait -> Some [%expr Smaws_Lib.Service.AwsQuery] diff --git a/codegen/Types.ml b/codegen/Types.ml index dcd5235e..03d0d210 100644 --- a/codegen/Types.ml +++ b/codegen/Types.ml @@ -166,7 +166,7 @@ let make_complex_type_declaration ctx ~name ~(descriptor : Ast.Shape.shapeDescri match descriptor with | StructureShape { members = []; _ } -> manifest_type ~name ~manifest:[%type: unit] ~is_exception_type - | StructureShape { members; traits } -> + | StructureShape { members; traits; _ } -> let structure_members = members |> List.map ~f:(fun ({ name; target; traits } : member) -> @@ -202,7 +202,7 @@ let make_complex_type_declaration ctx ~name ~(descriptor : Ast.Shape.shapeDescri let doc_string = Docs.convert_docs traits in type_declaration ~name ~is_exception_type ~kind:Ptype_abstract ~manifest:(Some list_type) ~doc_string () - | UnionShape { traits; members } -> + | UnionShape { traits; members; _ } -> let union_members = members |> List.map ~f:(fun ({ name; target; traits } : member) -> diff --git a/model_tests/gen.ml b/model_tests/gen.ml index c7e7ab1e..6575d6dd 100644 --- a/model_tests/gen.ml +++ b/model_tests/gen.ml @@ -19,6 +19,7 @@ let main () = [ ("aws.protocoltests.shared", "Shared"); ("aws.protocoltests.restxml.xmlns", "Restxml_xmlns"); + ("aws.protocoltests.restxml", "Restxml"); ("aws.protocoltests.restjson.nested", "Restjson_nested"); ("aws.protocoltests.restjson.validation", "Restjson_validation"); ("aws.protocoltests.restjson", "Restjson"); @@ -44,6 +45,8 @@ let main () = let _ = Sdkgen.write_serialisers ~output_dir model in let _ = Sdkgen.write_query_serialisers ~output_dir model in let _ = Sdkgen.write_query_deserialisers ~output_dir model in + let _ = Sdkgen.write_xml_serialisers ~output_dir model in + let _ = Sdkgen.write_xml_deserialisers ~output_dir model in let _ = Sdkgen.write_deserialisers ~output_dir model in let _ = Sdkgen.write_builders ~output_dir model in let _ = Sdkgen.write_module ~filename:module_dir_name ~output_dir model in diff --git a/model_tests/protocols/restxml/builders.ml b/model_tests/protocols/restxml/builders.ml new file mode 100644 index 00000000..1a69fbc4 --- /dev/null +++ b/model_tests/protocols/restxml/builders.ml @@ -0,0 +1,922 @@ +open Types + +let make_xml_nested_union_struct + ?double_value:(double_value_ : Smaws_Lib.Smithy_api.Types.double option) + ?float_value:(float_value_ : Smaws_Lib.Smithy_api.Types.float_ option) + ?long_value:(long_value_ : Smaws_Lib.Smithy_api.Types.long option) + ?integer_value:(integer_value_ : Smaws_Lib.Smithy_api.Types.integer option) + ?short_value:(short_value_ : Smaws_Lib.Smithy_api.Types.short option) + ?byte_value:(byte_value_ : Smaws_Lib.Smithy_api.Types.byte option) + ?boolean_value:(boolean_value_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?string_value:(string_value_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ + double_value = double_value_; + float_value = float_value_; + long_value = long_value_; + integer_value = integer_value_; + short_value = short_value_; + byte_value = byte_value_; + boolean_value = boolean_value_; + string_value = string_value_; + } + : xml_nested_union_struct) + +let make_xml_unions_response ?union_value:(union_value_ : xml_union_shape option) () = + ({ union_value = union_value_ } : xml_unions_response) + +let make_xml_unions_request ?union_value:(union_value_ : xml_union_shape option) () = + ({ union_value = union_value_ } : xml_unions_request) + +let make_xml_timestamps_response + ?http_date_on_target:(http_date_on_target_ : Shared.Types.http_date option) + ?http_date:(http_date_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?epoch_seconds_on_target:(epoch_seconds_on_target_ : Shared.Types.epoch_seconds option) + ?epoch_seconds:(epoch_seconds_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?date_time_on_target:(date_time_on_target_ : Shared.Types.date_time option) + ?date_time:(date_time_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?normal:(normal_ : Smaws_Lib.Smithy_api.Types.timestamp option) () = + ({ + http_date_on_target = http_date_on_target_; + http_date = http_date_; + epoch_seconds_on_target = epoch_seconds_on_target_; + epoch_seconds = epoch_seconds_; + date_time_on_target = date_time_on_target_; + date_time = date_time_; + normal = normal_; + } + : xml_timestamps_response) + +let make_xml_timestamps_request + ?http_date_on_target:(http_date_on_target_ : Shared.Types.http_date option) + ?http_date:(http_date_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?epoch_seconds_on_target:(epoch_seconds_on_target_ : Shared.Types.epoch_seconds option) + ?epoch_seconds:(epoch_seconds_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?date_time_on_target:(date_time_on_target_ : Shared.Types.date_time option) + ?date_time:(date_time_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?normal:(normal_ : Smaws_Lib.Smithy_api.Types.timestamp option) () = + ({ + http_date_on_target = http_date_on_target_; + http_date = http_date_; + epoch_seconds_on_target = epoch_seconds_on_target_; + epoch_seconds = epoch_seconds_; + date_time_on_target = date_time_on_target_; + date_time = date_time_; + normal = normal_; + } + : xml_timestamps_request) + +let make_xml_timestamps_input_output + ?http_date_on_target:(http_date_on_target_ : Shared.Types.http_date option) + ?http_date:(http_date_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?epoch_seconds_on_target:(epoch_seconds_on_target_ : Shared.Types.epoch_seconds option) + ?epoch_seconds:(epoch_seconds_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?date_time_on_target:(date_time_on_target_ : Shared.Types.date_time option) + ?date_time:(date_time_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?normal:(normal_ : Smaws_Lib.Smithy_api.Types.timestamp option) () = + ({ + http_date_on_target = http_date_on_target_; + http_date = http_date_; + epoch_seconds_on_target = epoch_seconds_on_target_; + epoch_seconds = epoch_seconds_; + date_time_on_target = date_time_on_target_; + date_time = date_time_; + normal = normal_; + } + : xml_timestamps_input_output) + +let make_xml_namespace_nested ?values:(values_ : xml_namespaced_list option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ values = values_; foo = foo_ } : xml_namespace_nested) + +let make_xml_namespaces_response ?nested:(nested_ : xml_namespace_nested option) () = + ({ nested = nested_ } : xml_namespaces_response) + +let make_xml_namespaces_request ?nested:(nested_ : xml_namespace_nested option) () = + ({ nested = nested_ } : xml_namespaces_request) + +let make_xml_namespaces_input_output ?nested:(nested_ : xml_namespace_nested option) () = + ({ nested = nested_ } : xml_namespaces_input_output) + +let make_xml_maps_xml_name_response ?my_map:(my_map_ : xml_maps_xml_name_input_output_map option) () + = + ({ my_map = my_map_ } : xml_maps_xml_name_response) + +let make_xml_maps_xml_name_request ?my_map:(my_map_ : xml_maps_xml_name_input_output_map option) () + = + ({ my_map = my_map_ } : xml_maps_xml_name_request) + +let make_xml_maps_response ?my_map:(my_map_ : xml_maps_input_output_map option) () = + ({ my_map = my_map_ } : xml_maps_response) + +let make_xml_maps_request ?my_map:(my_map_ : xml_maps_input_output_map option) () = + ({ my_map = my_map_ } : xml_maps_request) + +let make_xml_map_with_xml_namespace_response + ?my_map:(my_map_ : xml_map_with_xml_namespace_input_output_map option) () = + ({ my_map = my_map_ } : xml_map_with_xml_namespace_response) + +let make_xml_map_with_xml_namespace_request + ?my_map:(my_map_ : xml_map_with_xml_namespace_input_output_map option) () = + ({ my_map = my_map_ } : xml_map_with_xml_namespace_request) + +let make_xml_map_with_xml_namespace_input_output + ?my_map:(my_map_ : xml_map_with_xml_namespace_input_output_map option) () = + ({ my_map = my_map_ } : xml_map_with_xml_namespace_input_output) + +let make_structure_list_member ?b:(b_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?a:(a_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ b = b_; a = a_ } : structure_list_member) + +let make_xml_lists_response + ?flattened_structure_list:(flattened_structure_list_ : structure_list option) + ?structure_list:(structure_list_ : structure_list option) + ?flattened_list_with_namespace:(flattened_list_with_namespace_ : list_with_namespace option) + ?flattened_list_with_member_namespace: + (flattened_list_with_member_namespace_ : list_with_member_namespace option) + ?flattened_list2:(flattened_list2_ : renamed_list_members option) + ?flattened_list:(flattened_list_ : renamed_list_members option) + ?renamed_list_members:(renamed_list_members_ : renamed_list_members option) + ?nested_string_list:(nested_string_list_ : Shared.Types.nested_string_list option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?enum_list:(enum_list_ : Shared.Types.foo_enum_list option) + ?timestamp_list:(timestamp_list_ : Shared.Types.timestamp_list option) + ?boolean_list:(boolean_list_ : Shared.Types.boolean_list option) + ?integer_list:(integer_list_ : Shared.Types.integer_list option) + ?string_set:(string_set_ : Shared.Types.string_set option) + ?string_list:(string_list_ : Shared.Types.string_list option) () = + ({ + flattened_structure_list = flattened_structure_list_; + structure_list = structure_list_; + flattened_list_with_namespace = flattened_list_with_namespace_; + flattened_list_with_member_namespace = flattened_list_with_member_namespace_; + flattened_list2 = flattened_list2_; + flattened_list = flattened_list_; + renamed_list_members = renamed_list_members_; + nested_string_list = nested_string_list_; + int_enum_list = int_enum_list_; + enum_list = enum_list_; + timestamp_list = timestamp_list_; + boolean_list = boolean_list_; + integer_list = integer_list_; + string_set = string_set_; + string_list = string_list_; + } + : xml_lists_response) + +let make_xml_lists_request + ?flattened_structure_list:(flattened_structure_list_ : structure_list option) + ?structure_list:(structure_list_ : structure_list option) + ?flattened_list_with_namespace:(flattened_list_with_namespace_ : list_with_namespace option) + ?flattened_list_with_member_namespace: + (flattened_list_with_member_namespace_ : list_with_member_namespace option) + ?flattened_list2:(flattened_list2_ : renamed_list_members option) + ?flattened_list:(flattened_list_ : renamed_list_members option) + ?renamed_list_members:(renamed_list_members_ : renamed_list_members option) + ?nested_string_list:(nested_string_list_ : Shared.Types.nested_string_list option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?enum_list:(enum_list_ : Shared.Types.foo_enum_list option) + ?timestamp_list:(timestamp_list_ : Shared.Types.timestamp_list option) + ?boolean_list:(boolean_list_ : Shared.Types.boolean_list option) + ?integer_list:(integer_list_ : Shared.Types.integer_list option) + ?string_set:(string_set_ : Shared.Types.string_set option) + ?string_list:(string_list_ : Shared.Types.string_list option) () = + ({ + flattened_structure_list = flattened_structure_list_; + structure_list = structure_list_; + flattened_list_with_namespace = flattened_list_with_namespace_; + flattened_list_with_member_namespace = flattened_list_with_member_namespace_; + flattened_list2 = flattened_list2_; + flattened_list = flattened_list_; + renamed_list_members = renamed_list_members_; + nested_string_list = nested_string_list_; + int_enum_list = int_enum_list_; + enum_list = enum_list_; + timestamp_list = timestamp_list_; + boolean_list = boolean_list_; + integer_list = integer_list_; + string_set = string_set_; + string_list = string_list_; + } + : xml_lists_request) + +let make_xml_lists_input_output + ?flattened_structure_list:(flattened_structure_list_ : structure_list option) + ?structure_list:(structure_list_ : structure_list option) + ?flattened_list_with_namespace:(flattened_list_with_namespace_ : list_with_namespace option) + ?flattened_list_with_member_namespace: + (flattened_list_with_member_namespace_ : list_with_member_namespace option) + ?flattened_list2:(flattened_list2_ : renamed_list_members option) + ?flattened_list:(flattened_list_ : renamed_list_members option) + ?renamed_list_members:(renamed_list_members_ : renamed_list_members option) + ?nested_string_list:(nested_string_list_ : Shared.Types.nested_string_list option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?enum_list:(enum_list_ : Shared.Types.foo_enum_list option) + ?timestamp_list:(timestamp_list_ : Shared.Types.timestamp_list option) + ?boolean_list:(boolean_list_ : Shared.Types.boolean_list option) + ?integer_list:(integer_list_ : Shared.Types.integer_list option) + ?string_set:(string_set_ : Shared.Types.string_set option) + ?string_list:(string_list_ : Shared.Types.string_list option) () = + ({ + flattened_structure_list = flattened_structure_list_; + structure_list = structure_list_; + flattened_list_with_namespace = flattened_list_with_namespace_; + flattened_list_with_member_namespace = flattened_list_with_member_namespace_; + flattened_list2 = flattened_list2_; + flattened_list = flattened_list_; + renamed_list_members = renamed_list_members_; + nested_string_list = nested_string_list_; + int_enum_list = int_enum_list_; + enum_list = enum_list_; + timestamp_list = timestamp_list_; + boolean_list = boolean_list_; + integer_list = integer_list_; + string_set = string_set_; + string_list = string_list_; + } + : xml_lists_input_output) + +let make_xml_int_enums_response ?int_enum_map:(int_enum_map_ : Shared.Types.integer_enum_map option) + ?int_enum_set:(int_enum_set_ : Shared.Types.integer_enum_set option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?int_enum3:(int_enum3_ : Shared.Types.integer_enum option) + ?int_enum2:(int_enum2_ : Shared.Types.integer_enum option) + ?int_enum1:(int_enum1_ : Shared.Types.integer_enum option) () = + ({ + int_enum_map = int_enum_map_; + int_enum_set = int_enum_set_; + int_enum_list = int_enum_list_; + int_enum3 = int_enum3_; + int_enum2 = int_enum2_; + int_enum1 = int_enum1_; + } + : xml_int_enums_response) + +let make_xml_int_enums_request ?int_enum_map:(int_enum_map_ : Shared.Types.integer_enum_map option) + ?int_enum_set:(int_enum_set_ : Shared.Types.integer_enum_set option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?int_enum3:(int_enum3_ : Shared.Types.integer_enum option) + ?int_enum2:(int_enum2_ : Shared.Types.integer_enum option) + ?int_enum1:(int_enum1_ : Shared.Types.integer_enum option) () = + ({ + int_enum_map = int_enum_map_; + int_enum_set = int_enum_set_; + int_enum_list = int_enum_list_; + int_enum3 = int_enum3_; + int_enum2 = int_enum2_; + int_enum1 = int_enum1_; + } + : xml_int_enums_request) + +let make_xml_int_enums_input_output + ?int_enum_map:(int_enum_map_ : Shared.Types.integer_enum_map option) + ?int_enum_set:(int_enum_set_ : Shared.Types.integer_enum_set option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?int_enum3:(int_enum3_ : Shared.Types.integer_enum option) + ?int_enum2:(int_enum2_ : Shared.Types.integer_enum option) + ?int_enum1:(int_enum1_ : Shared.Types.integer_enum option) () = + ({ + int_enum_map = int_enum_map_; + int_enum_set = int_enum_set_; + int_enum_list = int_enum_list_; + int_enum3 = int_enum3_; + int_enum2 = int_enum2_; + int_enum1 = int_enum1_; + } + : xml_int_enums_input_output) + +let make_xml_enums_response ?foo_enum_map:(foo_enum_map_ : Shared.Types.foo_enum_map option) + ?foo_enum_set:(foo_enum_set_ : Shared.Types.foo_enum_set option) + ?foo_enum_list:(foo_enum_list_ : Shared.Types.foo_enum_list option) + ?foo_enum3:(foo_enum3_ : Shared.Types.foo_enum option) + ?foo_enum2:(foo_enum2_ : Shared.Types.foo_enum option) + ?foo_enum1:(foo_enum1_ : Shared.Types.foo_enum option) () = + ({ + foo_enum_map = foo_enum_map_; + foo_enum_set = foo_enum_set_; + foo_enum_list = foo_enum_list_; + foo_enum3 = foo_enum3_; + foo_enum2 = foo_enum2_; + foo_enum1 = foo_enum1_; + } + : xml_enums_response) + +let make_xml_enums_request ?foo_enum_map:(foo_enum_map_ : Shared.Types.foo_enum_map option) + ?foo_enum_set:(foo_enum_set_ : Shared.Types.foo_enum_set option) + ?foo_enum_list:(foo_enum_list_ : Shared.Types.foo_enum_list option) + ?foo_enum3:(foo_enum3_ : Shared.Types.foo_enum option) + ?foo_enum2:(foo_enum2_ : Shared.Types.foo_enum option) + ?foo_enum1:(foo_enum1_ : Shared.Types.foo_enum option) () = + ({ + foo_enum_map = foo_enum_map_; + foo_enum_set = foo_enum_set_; + foo_enum_list = foo_enum_list_; + foo_enum3 = foo_enum3_; + foo_enum2 = foo_enum2_; + foo_enum1 = foo_enum1_; + } + : xml_enums_request) + +let make_xml_enums_input_output ?foo_enum_map:(foo_enum_map_ : Shared.Types.foo_enum_map option) + ?foo_enum_set:(foo_enum_set_ : Shared.Types.foo_enum_set option) + ?foo_enum_list:(foo_enum_list_ : Shared.Types.foo_enum_list option) + ?foo_enum3:(foo_enum3_ : Shared.Types.foo_enum option) + ?foo_enum2:(foo_enum2_ : Shared.Types.foo_enum option) + ?foo_enum1:(foo_enum1_ : Shared.Types.foo_enum option) () = + ({ + foo_enum_map = foo_enum_map_; + foo_enum_set = foo_enum_set_; + foo_enum_list = foo_enum_list_; + foo_enum3 = foo_enum3_; + foo_enum2 = foo_enum2_; + foo_enum1 = foo_enum1_; + } + : xml_enums_input_output) + +let make_xml_empty_strings_response + ?empty_string:(empty_string_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ empty_string = empty_string_ } : xml_empty_strings_response) + +let make_xml_empty_strings_request + ?empty_string:(empty_string_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ empty_string = empty_string_ } : xml_empty_strings_request) + +let make_xml_empty_maps_response ?my_map:(my_map_ : xml_maps_input_output_map option) () = + ({ my_map = my_map_ } : xml_empty_maps_response) + +let make_xml_empty_maps_request ?my_map:(my_map_ : xml_maps_input_output_map option) () = + ({ my_map = my_map_ } : xml_empty_maps_request) + +let make_xml_empty_lists_response + ?flattened_structure_list:(flattened_structure_list_ : structure_list option) + ?structure_list:(structure_list_ : structure_list option) + ?flattened_list_with_namespace:(flattened_list_with_namespace_ : list_with_namespace option) + ?flattened_list_with_member_namespace: + (flattened_list_with_member_namespace_ : list_with_member_namespace option) + ?flattened_list2:(flattened_list2_ : renamed_list_members option) + ?flattened_list:(flattened_list_ : renamed_list_members option) + ?renamed_list_members:(renamed_list_members_ : renamed_list_members option) + ?nested_string_list:(nested_string_list_ : Shared.Types.nested_string_list option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?enum_list:(enum_list_ : Shared.Types.foo_enum_list option) + ?timestamp_list:(timestamp_list_ : Shared.Types.timestamp_list option) + ?boolean_list:(boolean_list_ : Shared.Types.boolean_list option) + ?integer_list:(integer_list_ : Shared.Types.integer_list option) + ?string_set:(string_set_ : Shared.Types.string_set option) + ?string_list:(string_list_ : Shared.Types.string_list option) () = + ({ + flattened_structure_list = flattened_structure_list_; + structure_list = structure_list_; + flattened_list_with_namespace = flattened_list_with_namespace_; + flattened_list_with_member_namespace = flattened_list_with_member_namespace_; + flattened_list2 = flattened_list2_; + flattened_list = flattened_list_; + renamed_list_members = renamed_list_members_; + nested_string_list = nested_string_list_; + int_enum_list = int_enum_list_; + enum_list = enum_list_; + timestamp_list = timestamp_list_; + boolean_list = boolean_list_; + integer_list = integer_list_; + string_set = string_set_; + string_list = string_list_; + } + : xml_empty_lists_response) + +let make_xml_empty_lists_request + ?flattened_structure_list:(flattened_structure_list_ : structure_list option) + ?structure_list:(structure_list_ : structure_list option) + ?flattened_list_with_namespace:(flattened_list_with_namespace_ : list_with_namespace option) + ?flattened_list_with_member_namespace: + (flattened_list_with_member_namespace_ : list_with_member_namespace option) + ?flattened_list2:(flattened_list2_ : renamed_list_members option) + ?flattened_list:(flattened_list_ : renamed_list_members option) + ?renamed_list_members:(renamed_list_members_ : renamed_list_members option) + ?nested_string_list:(nested_string_list_ : Shared.Types.nested_string_list option) + ?int_enum_list:(int_enum_list_ : Shared.Types.integer_enum_list option) + ?enum_list:(enum_list_ : Shared.Types.foo_enum_list option) + ?timestamp_list:(timestamp_list_ : Shared.Types.timestamp_list option) + ?boolean_list:(boolean_list_ : Shared.Types.boolean_list option) + ?integer_list:(integer_list_ : Shared.Types.integer_list option) + ?string_set:(string_set_ : Shared.Types.string_set option) + ?string_list:(string_list_ : Shared.Types.string_list option) () = + ({ + flattened_structure_list = flattened_structure_list_; + structure_list = structure_list_; + flattened_list_with_namespace = flattened_list_with_namespace_; + flattened_list_with_member_namespace = flattened_list_with_member_namespace_; + flattened_list2 = flattened_list2_; + flattened_list = flattened_list_; + renamed_list_members = renamed_list_members_; + nested_string_list = nested_string_list_; + int_enum_list = int_enum_list_; + enum_list = enum_list_; + timestamp_list = timestamp_list_; + boolean_list = boolean_list_; + integer_list = integer_list_; + string_set = string_set_; + string_list = string_list_; + } + : xml_empty_lists_request) + +let make_xml_empty_blobs_response ?data:(data_ : Smaws_Lib.Smithy_api.Types.blob option) () = + ({ data = data_ } : xml_empty_blobs_response) + +let make_xml_empty_blobs_request ?data:(data_ : Smaws_Lib.Smithy_api.Types.blob option) () = + ({ data = data_ } : xml_empty_blobs_request) + +let make_xml_blobs_response ?data:(data_ : Smaws_Lib.Smithy_api.Types.blob option) () = + ({ data = data_ } : xml_blobs_response) + +let make_xml_blobs_request ?data:(data_ : Smaws_Lib.Smithy_api.Types.blob option) () = + ({ data = data_ } : xml_blobs_request) + +let make_xml_attributes_response ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ attr = attr_; foo = foo_ } : xml_attributes_response) + +let make_xml_attributes_request ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ attr = attr_; foo = foo_ } : xml_attributes_request) + +let make_xml_attributes_payload_response ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ attr = attr_; foo = foo_ } : xml_attributes_payload_response) + +let make_xml_attributes_payload_request ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ attr = attr_; foo = foo_ } : xml_attributes_payload_request) + +let make_xml_attributes_on_payload_response + ?payload:(payload_ : xml_attributes_payload_response option) () = + ({ payload = payload_ } : xml_attributes_on_payload_response) + +let make_xml_attributes_on_payload_request + ?payload:(payload_ : xml_attributes_payload_request option) () = + ({ payload = payload_ } : xml_attributes_on_payload_request) + +let make_xml_attributes_middle_member_input_output + ?baz:(baz_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ baz = baz_; attr = attr_; foo = foo_ } : xml_attributes_middle_member_input_output) + +let make_xml_attributes_input_output ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ attr = attr_; foo = foo_ } : xml_attributes_input_output) + +let make_xml_attributes_in_middle_payload_response + ?baz:(baz_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ baz = baz_; attr = attr_; foo = foo_ } : xml_attributes_in_middle_payload_response) + +let make_xml_attributes_in_middle_response + ?payload:(payload_ : xml_attributes_in_middle_payload_response option) () = + ({ payload = payload_ } : xml_attributes_in_middle_response) + +let make_xml_attributes_in_middle_payload_request + ?baz:(baz_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?attr:(attr_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ baz = baz_; attr = attr_; foo = foo_ } : xml_attributes_in_middle_payload_request) + +let make_xml_attributes_in_middle_request + ?payload:(payload_ : xml_attributes_in_middle_payload_request option) () = + ({ payload = payload_ } : xml_attributes_in_middle_request) + +let make_timestamp_format_headers_i_o + ?target_date_time:(target_date_time_ : Shared.Types.date_time option) + ?target_http_date:(target_http_date_ : Shared.Types.http_date option) + ?target_epoch_seconds:(target_epoch_seconds_ : Shared.Types.epoch_seconds option) + ?default_format:(default_format_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?member_date_time:(member_date_time_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?member_http_date:(member_http_date_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?member_epoch_seconds:(member_epoch_seconds_ : Smaws_Lib.Smithy_api.Types.timestamp option) () = + ({ + target_date_time = target_date_time_; + target_http_date = target_http_date_; + target_epoch_seconds = target_epoch_seconds_; + default_format = default_format_; + member_date_time = member_date_time_; + member_http_date = member_http_date_; + member_epoch_seconds = member_epoch_seconds_; + } + : timestamp_format_headers_i_o) + +let make_string_payload_input ?payload:(payload_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ payload = payload_ } : string_payload_input) + +let make_simple_scalar_properties_response + ?double_value:(double_value_ : Smaws_Lib.Smithy_api.Types.double option) + ?float_value:(float_value_ : Smaws_Lib.Smithy_api.Types.float_ option) + ?long_value:(long_value_ : Smaws_Lib.Smithy_api.Types.long option) + ?integer_value:(integer_value_ : Smaws_Lib.Smithy_api.Types.integer option) + ?short_value:(short_value_ : Smaws_Lib.Smithy_api.Types.short option) + ?byte_value:(byte_value_ : Smaws_Lib.Smithy_api.Types.byte option) + ?false_boolean_value:(false_boolean_value_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?true_boolean_value:(true_boolean_value_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?string_value:(string_value_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ + double_value = double_value_; + float_value = float_value_; + long_value = long_value_; + integer_value = integer_value_; + short_value = short_value_; + byte_value = byte_value_; + false_boolean_value = false_boolean_value_; + true_boolean_value = true_boolean_value_; + string_value = string_value_; + foo = foo_; + } + : simple_scalar_properties_response) + +let make_simple_scalar_properties_request + ?double_value:(double_value_ : Smaws_Lib.Smithy_api.Types.double option) + ?float_value:(float_value_ : Smaws_Lib.Smithy_api.Types.float_ option) + ?long_value:(long_value_ : Smaws_Lib.Smithy_api.Types.long option) + ?integer_value:(integer_value_ : Smaws_Lib.Smithy_api.Types.integer option) + ?short_value:(short_value_ : Smaws_Lib.Smithy_api.Types.short option) + ?byte_value:(byte_value_ : Smaws_Lib.Smithy_api.Types.byte option) + ?false_boolean_value:(false_boolean_value_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?true_boolean_value:(true_boolean_value_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?string_value:(string_value_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ + double_value = double_value_; + float_value = float_value_; + long_value = long_value_; + integer_value = integer_value_; + short_value = short_value_; + byte_value = byte_value_; + false_boolean_value = false_boolean_value_; + true_boolean_value = true_boolean_value_; + string_value = string_value_; + foo = foo_; + } + : simple_scalar_properties_request) + +let make_simple_scalar_properties_input_output + ?double_value:(double_value_ : Smaws_Lib.Smithy_api.Types.double option) + ?float_value:(float_value_ : Smaws_Lib.Smithy_api.Types.float_ option) + ?long_value:(long_value_ : Smaws_Lib.Smithy_api.Types.long option) + ?integer_value:(integer_value_ : Smaws_Lib.Smithy_api.Types.integer option) + ?short_value:(short_value_ : Smaws_Lib.Smithy_api.Types.short option) + ?byte_value:(byte_value_ : Smaws_Lib.Smithy_api.Types.byte option) + ?false_boolean_value:(false_boolean_value_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?true_boolean_value:(true_boolean_value_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?string_value:(string_value_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ + double_value = double_value_; + float_value = float_value_; + long_value = long_value_; + integer_value = integer_value_; + short_value = short_value_; + byte_value = byte_value_; + false_boolean_value = false_boolean_value_; + true_boolean_value = true_boolean_value_; + string_value = string_value_; + foo = foo_; + } + : simple_scalar_properties_input_output) + +let make_recursive_shapes_input_output_nested1 + ?nested:(nested_ : recursive_shapes_input_output_nested2 option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ nested = nested_; foo = foo_ } : recursive_shapes_input_output_nested1) + +let make_recursive_shapes_input_output_nested2 + ?recursive_member:(recursive_member_ : recursive_shapes_input_output_nested1 option) + ?bar:(bar_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ recursive_member = recursive_member_; bar = bar_ } : recursive_shapes_input_output_nested2) + +let make_recursive_shapes_response ?nested:(nested_ : recursive_shapes_input_output_nested1 option) + () = + ({ nested = nested_ } : recursive_shapes_response) + +let make_recursive_shapes_request ?nested:(nested_ : recursive_shapes_input_output_nested1 option) + () = + ({ nested = nested_ } : recursive_shapes_request) + +let make_query_precedence_input ?baz:(baz_ : Shared.Types.string_map option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ baz = baz_; foo = foo_ } : query_precedence_input) + +let make_query_params_as_string_list_map_input ?foo:(foo_ : Shared.Types.string_list_map option) + ?qux:(qux_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ foo = foo_; qux = qux_ } : query_params_as_string_list_map_input) + +let make_query_idempotency_token_auto_fill_input + ?token:(token_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ token = token_ } : query_idempotency_token_auto_fill_input) + +let make_put_with_content_encoding_input ?data:(data_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?encoding:(encoding_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ data = data_; encoding = encoding_ } : put_with_content_encoding_input) + +let make_omits_null_serializes_empty_string_input + ?empty_string:(empty_string_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?null_value:(null_value_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ empty_string = empty_string_; null_value = null_value_ } + : omits_null_serializes_empty_string_input) + +let make_null_and_empty_headers_i_o ?c:(c_ : Shared.Types.string_list option) + ?b:(b_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?a:(a_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ c = c_; b = b_; a = a_ } : null_and_empty_headers_i_o) + +let make_no_input_and_output_output () = (() : unit) + +let make_nested_xml_map_with_xml_name_response + ?nested_xml_map_with_xml_name_map: + (nested_xml_map_with_xml_name_map_ : nested_xml_map_with_xml_name_map option) () = + ({ nested_xml_map_with_xml_name_map = nested_xml_map_with_xml_name_map_ } + : nested_xml_map_with_xml_name_response) + +let make_nested_xml_map_with_xml_name_request + ?nested_xml_map_with_xml_name_map: + (nested_xml_map_with_xml_name_map_ : nested_xml_map_with_xml_name_map option) () = + ({ nested_xml_map_with_xml_name_map = nested_xml_map_with_xml_name_map_ } + : nested_xml_map_with_xml_name_request) + +let make_nested_xml_maps_response ?flat_nested_map:(flat_nested_map_ : nested_map option) + ?nested_map:(nested_map_ : nested_map option) () = + ({ flat_nested_map = flat_nested_map_; nested_map = nested_map_ } : nested_xml_maps_response) + +let make_nested_xml_maps_request ?flat_nested_map:(flat_nested_map_ : nested_map option) + ?nested_map:(nested_map_ : nested_map option) () = + ({ flat_nested_map = flat_nested_map_; nested_map = nested_map_ } : nested_xml_maps_request) + +let make_input_and_output_with_headers_i_o + ?header_enum_list:(header_enum_list_ : Shared.Types.foo_enum_list option) + ?header_enum:(header_enum_ : Shared.Types.foo_enum option) + ?header_timestamp_list:(header_timestamp_list_ : Shared.Types.timestamp_list option) + ?header_boolean_list:(header_boolean_list_ : Shared.Types.boolean_list option) + ?header_integer_list:(header_integer_list_ : Shared.Types.integer_list option) + ?header_string_set:(header_string_set_ : Shared.Types.string_set option) + ?header_string_list:(header_string_list_ : Shared.Types.string_list option) + ?header_false_bool:(header_false_bool_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?header_true_bool:(header_true_bool_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?header_double:(header_double_ : Smaws_Lib.Smithy_api.Types.double option) + ?header_float:(header_float_ : Smaws_Lib.Smithy_api.Types.float_ option) + ?header_long:(header_long_ : Smaws_Lib.Smithy_api.Types.long option) + ?header_integer:(header_integer_ : Smaws_Lib.Smithy_api.Types.integer option) + ?header_short:(header_short_ : Smaws_Lib.Smithy_api.Types.short option) + ?header_byte:(header_byte_ : Smaws_Lib.Smithy_api.Types.byte option) + ?header_string:(header_string_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ + header_enum_list = header_enum_list_; + header_enum = header_enum_; + header_timestamp_list = header_timestamp_list_; + header_boolean_list = header_boolean_list_; + header_integer_list = header_integer_list_; + header_string_set = header_string_set_; + header_string_list = header_string_list_; + header_false_bool = header_false_bool_; + header_true_bool = header_true_bool_; + header_double = header_double_; + header_float = header_float_; + header_long = header_long_; + header_integer = header_integer_; + header_short = header_short_; + header_byte = header_byte_; + header_string = header_string_; + } + : input_and_output_with_headers_i_o) + +let make_ignore_query_params_in_response_output + ?baz:(baz_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ baz = baz_ } : ignore_query_params_in_response_output) + +let make_http_response_code_output ?status:(status_ : Smaws_Lib.Smithy_api.Types.integer option) () + = + ({ status = status_ } : http_response_code_output) + +let make_http_request_with_labels_and_timestamp_format_input + ~target_date_time:(target_date_time_ : Shared.Types.date_time) + ~target_http_date:(target_http_date_ : Shared.Types.http_date) + ~target_epoch_seconds:(target_epoch_seconds_ : Shared.Types.epoch_seconds) + ~default_format:(default_format_ : Smaws_Lib.Smithy_api.Types.timestamp) + ~member_date_time:(member_date_time_ : Smaws_Lib.Smithy_api.Types.timestamp) + ~member_http_date:(member_http_date_ : Smaws_Lib.Smithy_api.Types.timestamp) + ~member_epoch_seconds:(member_epoch_seconds_ : Smaws_Lib.Smithy_api.Types.timestamp) () = + ({ + target_date_time = target_date_time_; + target_http_date = target_http_date_; + target_epoch_seconds = target_epoch_seconds_; + default_format = default_format_; + member_date_time = member_date_time_; + member_http_date = member_http_date_; + member_epoch_seconds = member_epoch_seconds_; + } + : http_request_with_labels_and_timestamp_format_input) + +let make_http_request_with_labels_input + ~timestamp:(timestamp_ : Smaws_Lib.Smithy_api.Types.timestamp) + ~boolean_:(boolean__ : Smaws_Lib.Smithy_api.Types.boolean_) + ~double:(double_ : Smaws_Lib.Smithy_api.Types.double) + ~float_:(float__ : Smaws_Lib.Smithy_api.Types.float_) + ~long:(long_ : Smaws_Lib.Smithy_api.Types.long) + ~integer:(integer_ : Smaws_Lib.Smithy_api.Types.integer) + ~short:(short_ : Smaws_Lib.Smithy_api.Types.short) + ~string_:(string__ : Smaws_Lib.Smithy_api.Types.string_) () = + ({ + timestamp = timestamp_; + boolean_ = boolean__; + double = double_; + float_ = float__; + long = long_; + integer = integer_; + short = short_; + string_ = string__; + } + : http_request_with_labels_input) + +let make_http_request_with_greedy_label_in_path_input + ~baz:(baz_ : Smaws_Lib.Smithy_api.Types.string_) + ~foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_) () = + ({ baz = baz_; foo = foo_ } : http_request_with_greedy_label_in_path_input) + +let make_http_request_with_float_labels_input ~double:(double_ : Smaws_Lib.Smithy_api.Types.double) + ~float_:(float__ : Smaws_Lib.Smithy_api.Types.float_) () = + ({ double = double_; float_ = float__ } : http_request_with_float_labels_input) + +let make_http_prefix_headers_input_output ?foo_map:(foo_map_ : foo_prefix_headers option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ foo_map = foo_map_; foo = foo_ } : http_prefix_headers_input_output) + +let make_payload_with_xml_namespace_and_prefix + ?name:(name_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ name = name_ } : payload_with_xml_namespace_and_prefix) + +let make_http_payload_with_xml_namespace_and_prefix_input_output + ?nested:(nested_ : payload_with_xml_namespace_and_prefix option) () = + ({ nested = nested_ } : http_payload_with_xml_namespace_and_prefix_input_output) + +let make_payload_with_xml_namespace ?name:(name_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ name = name_ } : payload_with_xml_namespace) + +let make_http_payload_with_xml_namespace_input_output + ?nested:(nested_ : payload_with_xml_namespace option) () = + ({ nested = nested_ } : http_payload_with_xml_namespace_input_output) + +let make_payload_with_xml_name ?name:(name_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ name = name_ } : payload_with_xml_name) + +let make_http_payload_with_xml_name_input_output ?nested:(nested_ : payload_with_xml_name option) () + = + ({ nested = nested_ } : http_payload_with_xml_name_input_output) + +let make_http_payload_with_union_input_output ?nested:(nested_ : union_payload option) () = + ({ nested = nested_ } : http_payload_with_union_input_output) + +let make_nested_payload ?name:(name_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?greeting:(greeting_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ name = name_; greeting = greeting_ } : nested_payload) + +let make_http_payload_with_structure_input_output ?nested:(nested_ : nested_payload option) () = + ({ nested = nested_ } : http_payload_with_structure_input_output) + +let make_http_payload_with_member_xml_name_input_output + ?nested:(nested_ : payload_with_xml_name option) () = + ({ nested = nested_ } : http_payload_with_member_xml_name_input_output) + +let make_http_payload_traits_with_media_type_input_output + ?blob:(blob_ : Shared.Types.text_plain_blob option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ blob = blob_; foo = foo_ } : http_payload_traits_with_media_type_input_output) + +let make_http_payload_traits_input_output ?blob:(blob_ : Smaws_Lib.Smithy_api.Types.blob option) + ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ blob = blob_; foo = foo_ } : http_payload_traits_input_output) + +let make_enum_payload_input ?payload:(payload_ : string_enum option) () = + ({ payload = payload_ } : enum_payload_input) + +let make_http_empty_prefix_headers_output + ?specific_header:(specific_header_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?prefix_headers:(prefix_headers_ : Shared.Types.string_map option) () = + ({ specific_header = specific_header_; prefix_headers = prefix_headers_ } + : http_empty_prefix_headers_output) + +let make_http_empty_prefix_headers_input + ?specific_header:(specific_header_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?prefix_headers:(prefix_headers_ : Shared.Types.string_map option) () = + ({ specific_header = specific_header_; prefix_headers = prefix_headers_ } + : http_empty_prefix_headers_input) + +let make_complex_nested_error_data ?foo:(foo_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ foo = foo_ } : complex_nested_error_data) + +let make_greeting_with_errors_output + ?greeting:(greeting_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ greeting = greeting_ } : greeting_with_errors_output) + +let make_fractional_seconds_output ?datetime:(datetime_ : Shared.Types.date_time option) () = + ({ datetime = datetime_ } : fractional_seconds_output) + +let make_flattened_xml_map_with_xml_namespace_output + ?my_map:(my_map_ : flattened_xml_map_with_xml_namespace_output_map option) () = + ({ my_map = my_map_ } : flattened_xml_map_with_xml_namespace_output) + +let make_flattened_xml_map_with_xml_name_response + ?my_map:(my_map_ : flattened_xml_map_with_xml_name_input_output_map option) () = + ({ my_map = my_map_ } : flattened_xml_map_with_xml_name_response) + +let make_flattened_xml_map_with_xml_name_request + ?my_map:(my_map_ : flattened_xml_map_with_xml_name_input_output_map option) () = + ({ my_map = my_map_ } : flattened_xml_map_with_xml_name_request) + +let make_flattened_xml_map_response ?my_map:(my_map_ : Shared.Types.foo_enum_map option) () = + ({ my_map = my_map_ } : flattened_xml_map_response) + +let make_flattened_xml_map_request ?my_map:(my_map_ : Shared.Types.foo_enum_map option) () = + ({ my_map = my_map_ } : flattened_xml_map_request) + +let make_endpoint_with_host_label_operation_request + ~label:(label_ : Smaws_Lib.Smithy_api.Types.string_) () = + ({ label = label_ } : endpoint_with_host_label_operation_request) + +let make_host_label_header_input ~account_id:(account_id_ : Smaws_Lib.Smithy_api.Types.string_) () = + ({ account_id = account_id_ } : host_label_header_input) + +let make_empty_input_and_empty_output_output () = (() : unit) +let make_empty_input_and_empty_output_input () = (() : unit) + +let make_datetime_offsets_output ?datetime:(datetime_ : Shared.Types.date_time option) () = + ({ datetime = datetime_ } : datetime_offsets_output) + +let make_content_type_parameters_output () = (() : unit) + +let make_content_type_parameters_input ?value:(value_ : Smaws_Lib.Smithy_api.Types.integer option) + () = + ({ value = value_ } : content_type_parameters_input) + +let make_constant_query_string_input ~hello:(hello_ : Smaws_Lib.Smithy_api.Types.string_) () = + ({ hello = hello_ } : constant_query_string_input) + +let make_constant_and_variable_query_string_input + ?maybe_set:(maybe_set_ : Smaws_Lib.Smithy_api.Types.string_ option) + ?baz:(baz_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ maybe_set = maybe_set_; baz = baz_ } : constant_and_variable_query_string_input) + +let make_body_with_xml_name_input_output ?nested:(nested_ : payload_with_xml_name option) () = + ({ nested = nested_ } : body_with_xml_name_input_output) + +let make_all_query_string_types_input + ?query_params_map_of_strings:(query_params_map_of_strings_ : Shared.Types.string_map option) + ?query_integer_enum_list:(query_integer_enum_list_ : Shared.Types.integer_enum_list option) + ?query_integer_enum:(query_integer_enum_ : Shared.Types.integer_enum option) + ?query_enum_list:(query_enum_list_ : Shared.Types.foo_enum_list option) + ?query_enum:(query_enum_ : Shared.Types.foo_enum option) + ?query_timestamp_list:(query_timestamp_list_ : Shared.Types.timestamp_list option) + ?query_timestamp:(query_timestamp_ : Smaws_Lib.Smithy_api.Types.timestamp option) + ?query_boolean_list:(query_boolean_list_ : Shared.Types.boolean_list option) + ?query_boolean:(query_boolean_ : Smaws_Lib.Smithy_api.Types.boolean_ option) + ?query_double_list:(query_double_list_ : Shared.Types.double_list option) + ?query_double:(query_double_ : Smaws_Lib.Smithy_api.Types.double option) + ?query_float:(query_float_ : Smaws_Lib.Smithy_api.Types.float_ option) + ?query_long:(query_long_ : Smaws_Lib.Smithy_api.Types.long option) + ?query_integer_set:(query_integer_set_ : Shared.Types.integer_set option) + ?query_integer_list:(query_integer_list_ : Shared.Types.integer_list option) + ?query_integer:(query_integer_ : Smaws_Lib.Smithy_api.Types.integer option) + ?query_short:(query_short_ : Smaws_Lib.Smithy_api.Types.short option) + ?query_byte:(query_byte_ : Smaws_Lib.Smithy_api.Types.byte option) + ?query_string_set:(query_string_set_ : Shared.Types.string_set option) + ?query_string_list:(query_string_list_ : Shared.Types.string_list option) + ?query_string:(query_string_ : Smaws_Lib.Smithy_api.Types.string_ option) () = + ({ + query_params_map_of_strings = query_params_map_of_strings_; + query_integer_enum_list = query_integer_enum_list_; + query_integer_enum = query_integer_enum_; + query_enum_list = query_enum_list_; + query_enum = query_enum_; + query_timestamp_list = query_timestamp_list_; + query_timestamp = query_timestamp_; + query_boolean_list = query_boolean_list_; + query_boolean = query_boolean_; + query_double_list = query_double_list_; + query_double = query_double_; + query_float = query_float_; + query_long = query_long_; + query_integer_set = query_integer_set_; + query_integer_list = query_integer_list_; + query_integer = query_integer_; + query_short = query_short_; + query_byte = query_byte_; + query_string_set = query_string_set_; + query_string_list = query_string_list_; + query_string = query_string_; + } + : all_query_string_types_input) + +let make_nested_xml_maps_input_output ?flat_nested_map:(flat_nested_map_ : nested_map option) + ?nested_map:(nested_map_ : nested_map option) () = + ({ flat_nested_map = flat_nested_map_; nested_map = nested_map_ } : nested_xml_maps_input_output) + +let make_nested_xml_map_with_xml_name_input_output + ?nested_xml_map_with_xml_name_map: + (nested_xml_map_with_xml_name_map_ : nested_xml_map_with_xml_name_map option) () = + ({ nested_xml_map_with_xml_name_map = nested_xml_map_with_xml_name_map_ } + : nested_xml_map_with_xml_name_input_output) diff --git a/model_tests/protocols/restxml/builders.mli b/model_tests/protocols/restxml/builders.mli new file mode 100644 index 00000000..894156be --- /dev/null +++ b/model_tests/protocols/restxml/builders.mli @@ -0,0 +1,672 @@ +open Types + +val make_xml_nested_union_struct : + ?double_value:Smaws_Lib.Smithy_api.Types.double -> + ?float_value:Smaws_Lib.Smithy_api.Types.float_ -> + ?long_value:Smaws_Lib.Smithy_api.Types.long -> + ?integer_value:Smaws_Lib.Smithy_api.Types.integer -> + ?short_value:Smaws_Lib.Smithy_api.Types.short -> + ?byte_value:Smaws_Lib.Smithy_api.Types.byte -> + ?boolean_value:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?string_value:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_nested_union_struct + +val make_xml_unions_response : ?union_value:xml_union_shape -> unit -> xml_unions_response +val make_xml_unions_request : ?union_value:xml_union_shape -> unit -> xml_unions_request + +val make_xml_timestamps_response : + ?http_date_on_target:Shared.Types.http_date -> + ?http_date:Smaws_Lib.Smithy_api.Types.timestamp -> + ?epoch_seconds_on_target:Shared.Types.epoch_seconds -> + ?epoch_seconds:Smaws_Lib.Smithy_api.Types.timestamp -> + ?date_time_on_target:Shared.Types.date_time -> + ?date_time:Smaws_Lib.Smithy_api.Types.timestamp -> + ?normal:Smaws_Lib.Smithy_api.Types.timestamp -> + unit -> + xml_timestamps_response + +val make_xml_timestamps_request : + ?http_date_on_target:Shared.Types.http_date -> + ?http_date:Smaws_Lib.Smithy_api.Types.timestamp -> + ?epoch_seconds_on_target:Shared.Types.epoch_seconds -> + ?epoch_seconds:Smaws_Lib.Smithy_api.Types.timestamp -> + ?date_time_on_target:Shared.Types.date_time -> + ?date_time:Smaws_Lib.Smithy_api.Types.timestamp -> + ?normal:Smaws_Lib.Smithy_api.Types.timestamp -> + unit -> + xml_timestamps_request + +val make_xml_timestamps_input_output : + ?http_date_on_target:Shared.Types.http_date -> + ?http_date:Smaws_Lib.Smithy_api.Types.timestamp -> + ?epoch_seconds_on_target:Shared.Types.epoch_seconds -> + ?epoch_seconds:Smaws_Lib.Smithy_api.Types.timestamp -> + ?date_time_on_target:Shared.Types.date_time -> + ?date_time:Smaws_Lib.Smithy_api.Types.timestamp -> + ?normal:Smaws_Lib.Smithy_api.Types.timestamp -> + unit -> + xml_timestamps_input_output + +val make_xml_namespace_nested : + ?values:xml_namespaced_list -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_namespace_nested + +val make_xml_namespaces_response : ?nested:xml_namespace_nested -> unit -> xml_namespaces_response +val make_xml_namespaces_request : ?nested:xml_namespace_nested -> unit -> xml_namespaces_request + +val make_xml_namespaces_input_output : + ?nested:xml_namespace_nested -> unit -> xml_namespaces_input_output + +val make_xml_maps_xml_name_response : + ?my_map:xml_maps_xml_name_input_output_map -> unit -> xml_maps_xml_name_response + +val make_xml_maps_xml_name_request : + ?my_map:xml_maps_xml_name_input_output_map -> unit -> xml_maps_xml_name_request + +val make_xml_maps_response : ?my_map:xml_maps_input_output_map -> unit -> xml_maps_response +val make_xml_maps_request : ?my_map:xml_maps_input_output_map -> unit -> xml_maps_request + +val make_xml_map_with_xml_namespace_response : + ?my_map:xml_map_with_xml_namespace_input_output_map -> unit -> xml_map_with_xml_namespace_response + +val make_xml_map_with_xml_namespace_request : + ?my_map:xml_map_with_xml_namespace_input_output_map -> unit -> xml_map_with_xml_namespace_request + +val make_xml_map_with_xml_namespace_input_output : + ?my_map:xml_map_with_xml_namespace_input_output_map -> + unit -> + xml_map_with_xml_namespace_input_output + +val make_structure_list_member : + ?b:Smaws_Lib.Smithy_api.Types.string_ -> + ?a:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + structure_list_member + +val make_xml_lists_response : + ?flattened_structure_list:structure_list -> + ?structure_list:structure_list -> + ?flattened_list_with_namespace:list_with_namespace -> + ?flattened_list_with_member_namespace:list_with_member_namespace -> + ?flattened_list2:renamed_list_members -> + ?flattened_list:renamed_list_members -> + ?renamed_list_members:renamed_list_members -> + ?nested_string_list:Shared.Types.nested_string_list -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?enum_list:Shared.Types.foo_enum_list -> + ?timestamp_list:Shared.Types.timestamp_list -> + ?boolean_list:Shared.Types.boolean_list -> + ?integer_list:Shared.Types.integer_list -> + ?string_set:Shared.Types.string_set -> + ?string_list:Shared.Types.string_list -> + unit -> + xml_lists_response + +val make_xml_lists_request : + ?flattened_structure_list:structure_list -> + ?structure_list:structure_list -> + ?flattened_list_with_namespace:list_with_namespace -> + ?flattened_list_with_member_namespace:list_with_member_namespace -> + ?flattened_list2:renamed_list_members -> + ?flattened_list:renamed_list_members -> + ?renamed_list_members:renamed_list_members -> + ?nested_string_list:Shared.Types.nested_string_list -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?enum_list:Shared.Types.foo_enum_list -> + ?timestamp_list:Shared.Types.timestamp_list -> + ?boolean_list:Shared.Types.boolean_list -> + ?integer_list:Shared.Types.integer_list -> + ?string_set:Shared.Types.string_set -> + ?string_list:Shared.Types.string_list -> + unit -> + xml_lists_request + +val make_xml_lists_input_output : + ?flattened_structure_list:structure_list -> + ?structure_list:structure_list -> + ?flattened_list_with_namespace:list_with_namespace -> + ?flattened_list_with_member_namespace:list_with_member_namespace -> + ?flattened_list2:renamed_list_members -> + ?flattened_list:renamed_list_members -> + ?renamed_list_members:renamed_list_members -> + ?nested_string_list:Shared.Types.nested_string_list -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?enum_list:Shared.Types.foo_enum_list -> + ?timestamp_list:Shared.Types.timestamp_list -> + ?boolean_list:Shared.Types.boolean_list -> + ?integer_list:Shared.Types.integer_list -> + ?string_set:Shared.Types.string_set -> + ?string_list:Shared.Types.string_list -> + unit -> + xml_lists_input_output + +val make_xml_int_enums_response : + ?int_enum_map:Shared.Types.integer_enum_map -> + ?int_enum_set:Shared.Types.integer_enum_set -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?int_enum3:Shared.Types.integer_enum -> + ?int_enum2:Shared.Types.integer_enum -> + ?int_enum1:Shared.Types.integer_enum -> + unit -> + xml_int_enums_response + +val make_xml_int_enums_request : + ?int_enum_map:Shared.Types.integer_enum_map -> + ?int_enum_set:Shared.Types.integer_enum_set -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?int_enum3:Shared.Types.integer_enum -> + ?int_enum2:Shared.Types.integer_enum -> + ?int_enum1:Shared.Types.integer_enum -> + unit -> + xml_int_enums_request + +val make_xml_int_enums_input_output : + ?int_enum_map:Shared.Types.integer_enum_map -> + ?int_enum_set:Shared.Types.integer_enum_set -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?int_enum3:Shared.Types.integer_enum -> + ?int_enum2:Shared.Types.integer_enum -> + ?int_enum1:Shared.Types.integer_enum -> + unit -> + xml_int_enums_input_output + +val make_xml_enums_response : + ?foo_enum_map:Shared.Types.foo_enum_map -> + ?foo_enum_set:Shared.Types.foo_enum_set -> + ?foo_enum_list:Shared.Types.foo_enum_list -> + ?foo_enum3:Shared.Types.foo_enum -> + ?foo_enum2:Shared.Types.foo_enum -> + ?foo_enum1:Shared.Types.foo_enum -> + unit -> + xml_enums_response + +val make_xml_enums_request : + ?foo_enum_map:Shared.Types.foo_enum_map -> + ?foo_enum_set:Shared.Types.foo_enum_set -> + ?foo_enum_list:Shared.Types.foo_enum_list -> + ?foo_enum3:Shared.Types.foo_enum -> + ?foo_enum2:Shared.Types.foo_enum -> + ?foo_enum1:Shared.Types.foo_enum -> + unit -> + xml_enums_request + +val make_xml_enums_input_output : + ?foo_enum_map:Shared.Types.foo_enum_map -> + ?foo_enum_set:Shared.Types.foo_enum_set -> + ?foo_enum_list:Shared.Types.foo_enum_list -> + ?foo_enum3:Shared.Types.foo_enum -> + ?foo_enum2:Shared.Types.foo_enum -> + ?foo_enum1:Shared.Types.foo_enum -> + unit -> + xml_enums_input_output + +val make_xml_empty_strings_response : + ?empty_string:Smaws_Lib.Smithy_api.Types.string_ -> unit -> xml_empty_strings_response + +val make_xml_empty_strings_request : + ?empty_string:Smaws_Lib.Smithy_api.Types.string_ -> unit -> xml_empty_strings_request + +val make_xml_empty_maps_response : + ?my_map:xml_maps_input_output_map -> unit -> xml_empty_maps_response + +val make_xml_empty_maps_request : + ?my_map:xml_maps_input_output_map -> unit -> xml_empty_maps_request + +val make_xml_empty_lists_response : + ?flattened_structure_list:structure_list -> + ?structure_list:structure_list -> + ?flattened_list_with_namespace:list_with_namespace -> + ?flattened_list_with_member_namespace:list_with_member_namespace -> + ?flattened_list2:renamed_list_members -> + ?flattened_list:renamed_list_members -> + ?renamed_list_members:renamed_list_members -> + ?nested_string_list:Shared.Types.nested_string_list -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?enum_list:Shared.Types.foo_enum_list -> + ?timestamp_list:Shared.Types.timestamp_list -> + ?boolean_list:Shared.Types.boolean_list -> + ?integer_list:Shared.Types.integer_list -> + ?string_set:Shared.Types.string_set -> + ?string_list:Shared.Types.string_list -> + unit -> + xml_empty_lists_response + +val make_xml_empty_lists_request : + ?flattened_structure_list:structure_list -> + ?structure_list:structure_list -> + ?flattened_list_with_namespace:list_with_namespace -> + ?flattened_list_with_member_namespace:list_with_member_namespace -> + ?flattened_list2:renamed_list_members -> + ?flattened_list:renamed_list_members -> + ?renamed_list_members:renamed_list_members -> + ?nested_string_list:Shared.Types.nested_string_list -> + ?int_enum_list:Shared.Types.integer_enum_list -> + ?enum_list:Shared.Types.foo_enum_list -> + ?timestamp_list:Shared.Types.timestamp_list -> + ?boolean_list:Shared.Types.boolean_list -> + ?integer_list:Shared.Types.integer_list -> + ?string_set:Shared.Types.string_set -> + ?string_list:Shared.Types.string_list -> + unit -> + xml_empty_lists_request + +val make_xml_empty_blobs_response : + ?data:Smaws_Lib.Smithy_api.Types.blob -> unit -> xml_empty_blobs_response + +val make_xml_empty_blobs_request : + ?data:Smaws_Lib.Smithy_api.Types.blob -> unit -> xml_empty_blobs_request + +val make_xml_blobs_response : ?data:Smaws_Lib.Smithy_api.Types.blob -> unit -> xml_blobs_response +val make_xml_blobs_request : ?data:Smaws_Lib.Smithy_api.Types.blob -> unit -> xml_blobs_request + +val make_xml_attributes_response : + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_response + +val make_xml_attributes_request : + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_request + +val make_xml_attributes_payload_response : + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_payload_response + +val make_xml_attributes_payload_request : + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_payload_request + +val make_xml_attributes_on_payload_response : + ?payload:xml_attributes_payload_response -> unit -> xml_attributes_on_payload_response + +val make_xml_attributes_on_payload_request : + ?payload:xml_attributes_payload_request -> unit -> xml_attributes_on_payload_request + +val make_xml_attributes_middle_member_input_output : + ?baz:Smaws_Lib.Smithy_api.Types.string_ -> + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_middle_member_input_output + +val make_xml_attributes_input_output : + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_input_output + +val make_xml_attributes_in_middle_payload_response : + ?baz:Smaws_Lib.Smithy_api.Types.string_ -> + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_in_middle_payload_response + +val make_xml_attributes_in_middle_response : + ?payload:xml_attributes_in_middle_payload_response -> unit -> xml_attributes_in_middle_response + +val make_xml_attributes_in_middle_payload_request : + ?baz:Smaws_Lib.Smithy_api.Types.string_ -> + ?attr:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + xml_attributes_in_middle_payload_request + +val make_xml_attributes_in_middle_request : + ?payload:xml_attributes_in_middle_payload_request -> unit -> xml_attributes_in_middle_request + +val make_timestamp_format_headers_i_o : + ?target_date_time:Shared.Types.date_time -> + ?target_http_date:Shared.Types.http_date -> + ?target_epoch_seconds:Shared.Types.epoch_seconds -> + ?default_format:Smaws_Lib.Smithy_api.Types.timestamp -> + ?member_date_time:Smaws_Lib.Smithy_api.Types.timestamp -> + ?member_http_date:Smaws_Lib.Smithy_api.Types.timestamp -> + ?member_epoch_seconds:Smaws_Lib.Smithy_api.Types.timestamp -> + unit -> + timestamp_format_headers_i_o + +val make_string_payload_input : + ?payload:Smaws_Lib.Smithy_api.Types.string_ -> unit -> string_payload_input + +val make_simple_scalar_properties_response : + ?double_value:Smaws_Lib.Smithy_api.Types.double -> + ?float_value:Smaws_Lib.Smithy_api.Types.float_ -> + ?long_value:Smaws_Lib.Smithy_api.Types.long -> + ?integer_value:Smaws_Lib.Smithy_api.Types.integer -> + ?short_value:Smaws_Lib.Smithy_api.Types.short -> + ?byte_value:Smaws_Lib.Smithy_api.Types.byte -> + ?false_boolean_value:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?true_boolean_value:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?string_value:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + simple_scalar_properties_response + +val make_simple_scalar_properties_request : + ?double_value:Smaws_Lib.Smithy_api.Types.double -> + ?float_value:Smaws_Lib.Smithy_api.Types.float_ -> + ?long_value:Smaws_Lib.Smithy_api.Types.long -> + ?integer_value:Smaws_Lib.Smithy_api.Types.integer -> + ?short_value:Smaws_Lib.Smithy_api.Types.short -> + ?byte_value:Smaws_Lib.Smithy_api.Types.byte -> + ?false_boolean_value:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?true_boolean_value:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?string_value:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + simple_scalar_properties_request + +val make_simple_scalar_properties_input_output : + ?double_value:Smaws_Lib.Smithy_api.Types.double -> + ?float_value:Smaws_Lib.Smithy_api.Types.float_ -> + ?long_value:Smaws_Lib.Smithy_api.Types.long -> + ?integer_value:Smaws_Lib.Smithy_api.Types.integer -> + ?short_value:Smaws_Lib.Smithy_api.Types.short -> + ?byte_value:Smaws_Lib.Smithy_api.Types.byte -> + ?false_boolean_value:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?true_boolean_value:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?string_value:Smaws_Lib.Smithy_api.Types.string_ -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + simple_scalar_properties_input_output + +val make_recursive_shapes_input_output_nested1 : + ?nested:recursive_shapes_input_output_nested2 -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + recursive_shapes_input_output_nested1 + +val make_recursive_shapes_input_output_nested2 : + ?recursive_member:recursive_shapes_input_output_nested1 -> + ?bar:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + recursive_shapes_input_output_nested2 + +val make_recursive_shapes_response : + ?nested:recursive_shapes_input_output_nested1 -> unit -> recursive_shapes_response + +val make_recursive_shapes_request : + ?nested:recursive_shapes_input_output_nested1 -> unit -> recursive_shapes_request + +val make_query_precedence_input : + ?baz:Shared.Types.string_map -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + query_precedence_input + +val make_query_params_as_string_list_map_input : + ?foo:Shared.Types.string_list_map -> + ?qux:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + query_params_as_string_list_map_input + +val make_query_idempotency_token_auto_fill_input : + ?token:Smaws_Lib.Smithy_api.Types.string_ -> unit -> query_idempotency_token_auto_fill_input + +val make_put_with_content_encoding_input : + ?data:Smaws_Lib.Smithy_api.Types.string_ -> + ?encoding:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + put_with_content_encoding_input + +val make_omits_null_serializes_empty_string_input : + ?empty_string:Smaws_Lib.Smithy_api.Types.string_ -> + ?null_value:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + omits_null_serializes_empty_string_input + +val make_null_and_empty_headers_i_o : + ?c:Shared.Types.string_list -> + ?b:Smaws_Lib.Smithy_api.Types.string_ -> + ?a:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + null_and_empty_headers_i_o + +val make_no_input_and_output_output : unit -> unit + +val make_nested_xml_map_with_xml_name_response : + ?nested_xml_map_with_xml_name_map:nested_xml_map_with_xml_name_map -> + unit -> + nested_xml_map_with_xml_name_response + +val make_nested_xml_map_with_xml_name_request : + ?nested_xml_map_with_xml_name_map:nested_xml_map_with_xml_name_map -> + unit -> + nested_xml_map_with_xml_name_request + +val make_nested_xml_maps_response : + ?flat_nested_map:nested_map -> ?nested_map:nested_map -> unit -> nested_xml_maps_response + +val make_nested_xml_maps_request : + ?flat_nested_map:nested_map -> ?nested_map:nested_map -> unit -> nested_xml_maps_request + +val make_input_and_output_with_headers_i_o : + ?header_enum_list:Shared.Types.foo_enum_list -> + ?header_enum:Shared.Types.foo_enum -> + ?header_timestamp_list:Shared.Types.timestamp_list -> + ?header_boolean_list:Shared.Types.boolean_list -> + ?header_integer_list:Shared.Types.integer_list -> + ?header_string_set:Shared.Types.string_set -> + ?header_string_list:Shared.Types.string_list -> + ?header_false_bool:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?header_true_bool:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?header_double:Smaws_Lib.Smithy_api.Types.double -> + ?header_float:Smaws_Lib.Smithy_api.Types.float_ -> + ?header_long:Smaws_Lib.Smithy_api.Types.long -> + ?header_integer:Smaws_Lib.Smithy_api.Types.integer -> + ?header_short:Smaws_Lib.Smithy_api.Types.short -> + ?header_byte:Smaws_Lib.Smithy_api.Types.byte -> + ?header_string:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + input_and_output_with_headers_i_o + +val make_ignore_query_params_in_response_output : + ?baz:Smaws_Lib.Smithy_api.Types.string_ -> unit -> ignore_query_params_in_response_output + +val make_http_response_code_output : + ?status:Smaws_Lib.Smithy_api.Types.integer -> unit -> http_response_code_output + +val make_http_request_with_labels_and_timestamp_format_input : + target_date_time:Shared.Types.date_time -> + target_http_date:Shared.Types.http_date -> + target_epoch_seconds:Shared.Types.epoch_seconds -> + default_format:Smaws_Lib.Smithy_api.Types.timestamp -> + member_date_time:Smaws_Lib.Smithy_api.Types.timestamp -> + member_http_date:Smaws_Lib.Smithy_api.Types.timestamp -> + member_epoch_seconds:Smaws_Lib.Smithy_api.Types.timestamp -> + unit -> + http_request_with_labels_and_timestamp_format_input + +val make_http_request_with_labels_input : + timestamp:Smaws_Lib.Smithy_api.Types.timestamp -> + boolean_:Smaws_Lib.Smithy_api.Types.boolean_ -> + double:Smaws_Lib.Smithy_api.Types.double -> + float_:Smaws_Lib.Smithy_api.Types.float_ -> + long:Smaws_Lib.Smithy_api.Types.long -> + integer:Smaws_Lib.Smithy_api.Types.integer -> + short:Smaws_Lib.Smithy_api.Types.short -> + string_:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + http_request_with_labels_input + +val make_http_request_with_greedy_label_in_path_input : + baz:Smaws_Lib.Smithy_api.Types.string_ -> + foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + http_request_with_greedy_label_in_path_input + +val make_http_request_with_float_labels_input : + double:Smaws_Lib.Smithy_api.Types.double -> + float_:Smaws_Lib.Smithy_api.Types.float_ -> + unit -> + http_request_with_float_labels_input + +val make_http_prefix_headers_input_output : + ?foo_map:foo_prefix_headers -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + http_prefix_headers_input_output + +val make_payload_with_xml_namespace_and_prefix : + ?name:Smaws_Lib.Smithy_api.Types.string_ -> unit -> payload_with_xml_namespace_and_prefix + +val make_http_payload_with_xml_namespace_and_prefix_input_output : + ?nested:payload_with_xml_namespace_and_prefix -> + unit -> + http_payload_with_xml_namespace_and_prefix_input_output + +val make_payload_with_xml_namespace : + ?name:Smaws_Lib.Smithy_api.Types.string_ -> unit -> payload_with_xml_namespace + +val make_http_payload_with_xml_namespace_input_output : + ?nested:payload_with_xml_namespace -> unit -> http_payload_with_xml_namespace_input_output + +val make_payload_with_xml_name : + ?name:Smaws_Lib.Smithy_api.Types.string_ -> unit -> payload_with_xml_name + +val make_http_payload_with_xml_name_input_output : + ?nested:payload_with_xml_name -> unit -> http_payload_with_xml_name_input_output + +val make_http_payload_with_union_input_output : + ?nested:union_payload -> unit -> http_payload_with_union_input_output + +val make_nested_payload : + ?name:Smaws_Lib.Smithy_api.Types.string_ -> + ?greeting:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + nested_payload + +val make_http_payload_with_structure_input_output : + ?nested:nested_payload -> unit -> http_payload_with_structure_input_output + +val make_http_payload_with_member_xml_name_input_output : + ?nested:payload_with_xml_name -> unit -> http_payload_with_member_xml_name_input_output + +val make_http_payload_traits_with_media_type_input_output : + ?blob:Shared.Types.text_plain_blob -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + http_payload_traits_with_media_type_input_output + +val make_http_payload_traits_input_output : + ?blob:Smaws_Lib.Smithy_api.Types.blob -> + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + http_payload_traits_input_output + +val make_enum_payload_input : ?payload:string_enum -> unit -> enum_payload_input + +val make_http_empty_prefix_headers_output : + ?specific_header:Smaws_Lib.Smithy_api.Types.string_ -> + ?prefix_headers:Shared.Types.string_map -> + unit -> + http_empty_prefix_headers_output + +val make_http_empty_prefix_headers_input : + ?specific_header:Smaws_Lib.Smithy_api.Types.string_ -> + ?prefix_headers:Shared.Types.string_map -> + unit -> + http_empty_prefix_headers_input + +val make_complex_nested_error_data : + ?foo:Smaws_Lib.Smithy_api.Types.string_ -> unit -> complex_nested_error_data + +val make_greeting_with_errors_output : + ?greeting:Smaws_Lib.Smithy_api.Types.string_ -> unit -> greeting_with_errors_output + +val make_fractional_seconds_output : + ?datetime:Shared.Types.date_time -> unit -> fractional_seconds_output + +val make_flattened_xml_map_with_xml_namespace_output : + ?my_map:flattened_xml_map_with_xml_namespace_output_map -> + unit -> + flattened_xml_map_with_xml_namespace_output + +val make_flattened_xml_map_with_xml_name_response : + ?my_map:flattened_xml_map_with_xml_name_input_output_map -> + unit -> + flattened_xml_map_with_xml_name_response + +val make_flattened_xml_map_with_xml_name_request : + ?my_map:flattened_xml_map_with_xml_name_input_output_map -> + unit -> + flattened_xml_map_with_xml_name_request + +val make_flattened_xml_map_response : + ?my_map:Shared.Types.foo_enum_map -> unit -> flattened_xml_map_response + +val make_flattened_xml_map_request : + ?my_map:Shared.Types.foo_enum_map -> unit -> flattened_xml_map_request + +val make_endpoint_with_host_label_operation_request : + label:Smaws_Lib.Smithy_api.Types.string_ -> unit -> endpoint_with_host_label_operation_request + +val make_host_label_header_input : + account_id:Smaws_Lib.Smithy_api.Types.string_ -> unit -> host_label_header_input + +val make_empty_input_and_empty_output_output : unit -> unit +val make_empty_input_and_empty_output_input : unit -> unit + +val make_datetime_offsets_output : + ?datetime:Shared.Types.date_time -> unit -> datetime_offsets_output + +val make_content_type_parameters_output : unit -> unit + +val make_content_type_parameters_input : + ?value:Smaws_Lib.Smithy_api.Types.integer -> unit -> content_type_parameters_input + +val make_constant_query_string_input : + hello:Smaws_Lib.Smithy_api.Types.string_ -> unit -> constant_query_string_input + +val make_constant_and_variable_query_string_input : + ?maybe_set:Smaws_Lib.Smithy_api.Types.string_ -> + ?baz:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + constant_and_variable_query_string_input + +val make_body_with_xml_name_input_output : + ?nested:payload_with_xml_name -> unit -> body_with_xml_name_input_output + +val make_all_query_string_types_input : + ?query_params_map_of_strings:Shared.Types.string_map -> + ?query_integer_enum_list:Shared.Types.integer_enum_list -> + ?query_integer_enum:Shared.Types.integer_enum -> + ?query_enum_list:Shared.Types.foo_enum_list -> + ?query_enum:Shared.Types.foo_enum -> + ?query_timestamp_list:Shared.Types.timestamp_list -> + ?query_timestamp:Smaws_Lib.Smithy_api.Types.timestamp -> + ?query_boolean_list:Shared.Types.boolean_list -> + ?query_boolean:Smaws_Lib.Smithy_api.Types.boolean_ -> + ?query_double_list:Shared.Types.double_list -> + ?query_double:Smaws_Lib.Smithy_api.Types.double -> + ?query_float:Smaws_Lib.Smithy_api.Types.float_ -> + ?query_long:Smaws_Lib.Smithy_api.Types.long -> + ?query_integer_set:Shared.Types.integer_set -> + ?query_integer_list:Shared.Types.integer_list -> + ?query_integer:Smaws_Lib.Smithy_api.Types.integer -> + ?query_short:Smaws_Lib.Smithy_api.Types.short -> + ?query_byte:Smaws_Lib.Smithy_api.Types.byte -> + ?query_string_set:Shared.Types.string_set -> + ?query_string_list:Shared.Types.string_list -> + ?query_string:Smaws_Lib.Smithy_api.Types.string_ -> + unit -> + all_query_string_types_input + +val make_nested_xml_maps_input_output : + ?flat_nested_map:nested_map -> ?nested_map:nested_map -> unit -> nested_xml_maps_input_output + +val make_nested_xml_map_with_xml_name_input_output : + ?nested_xml_map_with_xml_name_map:nested_xml_map_with_xml_name_map -> + unit -> + nested_xml_map_with_xml_name_input_output diff --git a/model_tests/protocols/restxml/dune b/model_tests/protocols/restxml/dune new file mode 100644 index 00000000..b23370f2 --- /dev/null +++ b/model_tests/protocols/restxml/dune @@ -0,0 +1,57 @@ +(rule + (mode promote) + (targets + builders.ml + builders.mli + restxml.ml + xml_deserializers.ml + xml_serializers.ml + operations.ml + protocol_tests.ml + service.ml + service_metadata.ml + service_metadata.mli + types.ml + types.mli) + (deps + (:gen ../../gen.exe) + (:input ../../../smithy-aws-protocol-tests_model.json) + (:ocf %{bin:ocamlformat})) + (action + (progn + (run %{gen} %{input} . aws.protocoltests.restxml) + (run + %{ocf} + -i + builders.ml + builders.mli + restxml.ml + xml_deserializers.ml + xml_serializers.ml + operations.ml + protocol_tests.ml + service.ml + service_metadata.ml + service_metadata.mli + types.ml + types.mli)))) + +(library + (name restxml) + (modules + builders + restxml + operations + service + service_metadata + types + xml_deserializers + xml_serializers) + (preprocess + (pps ppx_deriving.show ppx_deriving.eq)) + (libraries Smaws_Lib shared)) + +(test + (name protocol_tests) + (modules protocol_tests) + (libraries Smaws_Lib Smaws_Test_Support_Lib alcotest restxml eio_main)) diff --git a/model_tests/protocols/restxml/operations.ml b/model_tests/protocols/restxml/operations.ml new file mode 100644 index 00000000..2fbd17aa --- /dev/null +++ b/model_tests/protocols/restxml/operations.ml @@ -0,0 +1,1180 @@ +open Types +open Service_metadata +open Xml_deserializers +open Xml_serializers +open Smaws_Lib.Xml.Parse + +module AllQueryStringTypes = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : all_query_string_types_input) = + let w = Smaws_Lib.Xml.Write.make () in + all_query_string_types_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"AllQueryStringTypes" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module BodyWithXmlName = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : body_with_xml_name_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + body_with_xml_name_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"BodyWithXmlName" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:body_with_xml_name_input_output_of_xml ~error_deserializer +end + +module ConstantAndVariableQueryString = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : constant_and_variable_query_string_input) = + let w = Smaws_Lib.Xml.Write.make () in + constant_and_variable_query_string_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"ConstantAndVariableQueryString" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module ConstantQueryString = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : constant_query_string_input) = + let w = Smaws_Lib.Xml.Write.make () in + constant_query_string_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"ConstantQueryString" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module ContentTypeParameters = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : content_type_parameters_input) = + let w = Smaws_Lib.Xml.Write.make () in + content_type_parameters_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"ContentTypeParameters" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:content_type_parameters_output_of_xml ~error_deserializer +end + +module DatetimeOffsets = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"DatetimeOffsets" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:datetime_offsets_output_of_xml ~error_deserializer +end + +module EmptyInputAndEmptyOutput = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : empty_input_and_empty_output_input) = + let w = Smaws_Lib.Xml.Write.make () in + empty_input_and_empty_output_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"EmptyInputAndEmptyOutput" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:empty_input_and_empty_output_output_of_xml ~error_deserializer +end + +module EndpointOperation = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"EndpointOperation" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module EndpointWithHostLabelHeaderOperation = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : host_label_header_input) = + let w = Smaws_Lib.Xml.Write.make () in + host_label_header_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"EndpointWithHostLabelHeaderOperation" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module EndpointWithHostLabelOperation = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : endpoint_with_host_label_operation_request) = + let w = Smaws_Lib.Xml.Write.make () in + endpoint_with_host_label_operation_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"EndpointWithHostLabelOperation" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module FlattenedXmlMap = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : flattened_xml_map_request) = + let w = Smaws_Lib.Xml.Write.make () in + flattened_xml_map_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"FlattenedXmlMap" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:flattened_xml_map_response_of_xml ~error_deserializer +end + +module FlattenedXmlMapWithXmlName = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : flattened_xml_map_with_xml_name_request) = + let w = Smaws_Lib.Xml.Write.make () in + flattened_xml_map_with_xml_name_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"FlattenedXmlMapWithXmlName" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:flattened_xml_map_with_xml_name_response_of_xml ~error_deserializer +end + +module FlattenedXmlMapWithXmlNamespace = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"FlattenedXmlMapWithXmlNamespace" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:flattened_xml_map_with_xml_namespace_output_of_xml ~error_deserializer +end + +module FractionalSeconds = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"FractionalSeconds" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:fractional_seconds_output_of_xml ~error_deserializer +end + +module GreetingWithErrors = struct + let error_to_string = function + | `ComplexError _ -> "aws.protocoltests.restxml#ComplexError" + | `InvalidGreeting _ -> "aws.protocoltests.restxml#InvalidGreeting" + | #Smaws_Lib.Protocols.RestXml.error as e -> Smaws_Lib.Protocols.RestXml.error_to_string e + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body = + match error.Smaws_Lib.Protocols.RestXml.Error.code with + | "ComplexError" -> ( + match + Smaws_Lib.Protocols.RestXml.parse_error_struct ~body ~structParser:complex_error_of_xml + with + | Ok s -> `ComplexError s + | Error (XmlParseError msg) -> `XmlParseError msg) + | "InvalidGreeting" -> ( + match + Smaws_Lib.Protocols.RestXml.parse_error_struct ~body ~structParser:invalid_greeting_of_xml + with + | Ok s -> `InvalidGreeting s + | Error (XmlParseError msg) -> `XmlParseError msg) + | _ -> Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"GreetingWithErrors" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:greeting_with_errors_output_of_xml ~error_deserializer +end + +module HttpEmptyPrefixHeaders = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_empty_prefix_headers_input) = + let w = Smaws_Lib.Xml.Write.make () in + http_empty_prefix_headers_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpEmptyPrefixHeaders" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_empty_prefix_headers_output_of_xml ~error_deserializer +end + +module HttpEnumPayload = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : enum_payload_input) = + let w = Smaws_Lib.Xml.Write.make () in + enum_payload_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpEnumPayload" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:enum_payload_input_of_xml ~error_deserializer +end + +module HttpPayloadTraits = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_traits_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_traits_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadTraits" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_traits_input_output_of_xml ~error_deserializer +end + +module HttpPayloadTraitsWithMediaType = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_traits_with_media_type_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_traits_with_media_type_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadTraitsWithMediaType" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_traits_with_media_type_input_output_of_xml + ~error_deserializer +end + +module HttpPayloadWithMemberXmlName = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_with_member_xml_name_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_with_member_xml_name_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadWithMemberXmlName" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_with_member_xml_name_input_output_of_xml ~error_deserializer +end + +module HttpPayloadWithStructure = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_with_structure_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_with_structure_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadWithStructure" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_with_structure_input_output_of_xml ~error_deserializer +end + +module HttpPayloadWithUnion = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_with_union_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_with_union_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadWithUnion" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_with_union_input_output_of_xml ~error_deserializer +end + +module HttpPayloadWithXmlName = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_with_xml_name_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_with_xml_name_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadWithXmlName" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_with_xml_name_input_output_of_xml ~error_deserializer +end + +module HttpPayloadWithXmlNamespace = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_with_xml_namespace_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_with_xml_namespace_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadWithXmlNamespace" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_with_xml_namespace_input_output_of_xml ~error_deserializer +end + +module HttpPayloadWithXmlNamespaceAndPrefix = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_payload_with_xml_namespace_and_prefix_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_payload_with_xml_namespace_and_prefix_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPayloadWithXmlNamespaceAndPrefix" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_payload_with_xml_namespace_and_prefix_input_output_of_xml + ~error_deserializer +end + +module HttpPrefixHeaders = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_prefix_headers_input_output) = + let w = Smaws_Lib.Xml.Write.make () in + http_prefix_headers_input_output_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpPrefixHeaders" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_prefix_headers_input_output_of_xml ~error_deserializer +end + +module HttpRequestWithFloatLabels = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_request_with_float_labels_input) = + let w = Smaws_Lib.Xml.Write.make () in + http_request_with_float_labels_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpRequestWithFloatLabels" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module HttpRequestWithGreedyLabelInPath = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_request_with_greedy_label_in_path_input) = + let w = Smaws_Lib.Xml.Write.make () in + http_request_with_greedy_label_in_path_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpRequestWithGreedyLabelInPath" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module HttpRequestWithLabels = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_request_with_labels_input) = + let w = Smaws_Lib.Xml.Write.make () in + http_request_with_labels_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpRequestWithLabels" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module HttpRequestWithLabelsAndTimestampFormat = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : http_request_with_labels_and_timestamp_format_input) = + let w = Smaws_Lib.Xml.Write.make () in + http_request_with_labels_and_timestamp_format_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpRequestWithLabelsAndTimestampFormat" + ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module HttpResponseCode = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpResponseCode" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:http_response_code_output_of_xml ~error_deserializer +end + +module HttpStringPayload = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : string_payload_input) = + let w = Smaws_Lib.Xml.Write.make () in + string_payload_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"HttpStringPayload" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:string_payload_input_of_xml ~error_deserializer +end + +module IgnoreQueryParamsInResponse = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"IgnoreQueryParamsInResponse" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:ignore_query_params_in_response_output_of_xml ~error_deserializer +end + +module InputAndOutputWithHeaders = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : input_and_output_with_headers_i_o) = + let w = Smaws_Lib.Xml.Write.make () in + input_and_output_with_headers_i_o_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"InputAndOutputWithHeaders" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:input_and_output_with_headers_i_o_of_xml ~error_deserializer +end + +module NestedXmlMaps = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : nested_xml_maps_request) = + let w = Smaws_Lib.Xml.Write.make () in + nested_xml_maps_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"NestedXmlMaps" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:nested_xml_maps_response_of_xml ~error_deserializer +end + +module NestedXmlMapWithXmlName = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : nested_xml_map_with_xml_name_request) = + let w = Smaws_Lib.Xml.Write.make () in + nested_xml_map_with_xml_name_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"NestedXmlMapWithXmlName" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:nested_xml_map_with_xml_name_response_of_xml ~error_deserializer +end + +module NoInputAndNoOutput = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"NoInputAndNoOutput" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module NoInputAndOutput = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : Smaws_Lib.Smithy_api.Types.unit_) = + let w = Smaws_Lib.Xml.Write.make () in + (); + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"NoInputAndOutput" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:no_input_and_output_output_of_xml ~error_deserializer +end + +module NullAndEmptyHeadersClient = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : null_and_empty_headers_i_o) = + let w = Smaws_Lib.Xml.Write.make () in + null_and_empty_headers_i_o_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"NullAndEmptyHeadersClient" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:null_and_empty_headers_i_o_of_xml ~error_deserializer +end + +module NullAndEmptyHeadersServer = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : null_and_empty_headers_i_o) = + let w = Smaws_Lib.Xml.Write.make () in + null_and_empty_headers_i_o_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"NullAndEmptyHeadersServer" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:null_and_empty_headers_i_o_of_xml ~error_deserializer +end + +module OmitsNullSerializesEmptyString = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : omits_null_serializes_empty_string_input) = + let w = Smaws_Lib.Xml.Write.make () in + omits_null_serializes_empty_string_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"OmitsNullSerializesEmptyString" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module PutWithContentEncoding = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : put_with_content_encoding_input) = + let w = Smaws_Lib.Xml.Write.make () in + put_with_content_encoding_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"PutWithContentEncoding" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module QueryIdempotencyTokenAutoFill = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : query_idempotency_token_auto_fill_input) = + let w = Smaws_Lib.Xml.Write.make () in + query_idempotency_token_auto_fill_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"QueryIdempotencyTokenAutoFill" ~service + ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module QueryParamsAsStringListMap = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : query_params_as_string_list_map_input) = + let w = Smaws_Lib.Xml.Write.make () in + query_params_as_string_list_map_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"QueryParamsAsStringListMap" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module QueryPrecedence = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : query_precedence_input) = + let w = Smaws_Lib.Xml.Write.make () in + query_precedence_input_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"QueryPrecedence" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:Xml_deserializers.unit_of_xml ~error_deserializer +end + +module RecursiveShapes = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : recursive_shapes_request) = + let w = Smaws_Lib.Xml.Write.make () in + recursive_shapes_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"RecursiveShapes" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:recursive_shapes_response_of_xml ~error_deserializer +end + +module SimpleScalarProperties = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : simple_scalar_properties_request) = + let w = Smaws_Lib.Xml.Write.make () in + simple_scalar_properties_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"SimpleScalarProperties" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:simple_scalar_properties_response_of_xml ~error_deserializer +end + +module TimestampFormatHeaders = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : timestamp_format_headers_i_o) = + let w = Smaws_Lib.Xml.Write.make () in + timestamp_format_headers_i_o_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"TimestampFormatHeaders" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:timestamp_format_headers_i_o_of_xml ~error_deserializer +end + +module XmlAttributes = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_attributes_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_attributes_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlAttributes" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_attributes_response_of_xml ~error_deserializer +end + +module XmlAttributesInMiddle = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_attributes_in_middle_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_attributes_in_middle_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlAttributesInMiddle" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_attributes_in_middle_response_of_xml ~error_deserializer +end + +module XmlAttributesOnPayload = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_attributes_on_payload_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_attributes_on_payload_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlAttributesOnPayload" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_attributes_on_payload_response_of_xml ~error_deserializer +end + +module XmlBlobs = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_blobs_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_blobs_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlBlobs" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_blobs_response_of_xml ~error_deserializer +end + +module XmlEmptyBlobs = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_empty_blobs_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_empty_blobs_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlEmptyBlobs" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_empty_blobs_response_of_xml ~error_deserializer +end + +module XmlEmptyLists = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_empty_lists_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_empty_lists_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlEmptyLists" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_empty_lists_response_of_xml ~error_deserializer +end + +module XmlEmptyMaps = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_empty_maps_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_empty_maps_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlEmptyMaps" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_empty_maps_response_of_xml ~error_deserializer +end + +module XmlEmptyStrings = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_empty_strings_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_empty_strings_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlEmptyStrings" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_empty_strings_response_of_xml ~error_deserializer +end + +module XmlEnums = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_enums_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_enums_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlEnums" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_enums_response_of_xml ~error_deserializer +end + +module XmlIntEnums = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_int_enums_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_int_enums_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlIntEnums" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_int_enums_response_of_xml ~error_deserializer +end + +module XmlLists = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_lists_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_lists_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlLists" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_lists_response_of_xml ~error_deserializer +end + +module XmlMapWithXmlNamespace = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_map_with_xml_namespace_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_map_with_xml_namespace_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlMapWithXmlNamespace" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_map_with_xml_namespace_response_of_xml ~error_deserializer +end + +module XmlMaps = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_maps_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_maps_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlMaps" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_maps_response_of_xml ~error_deserializer +end + +module XmlMapsXmlName = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_maps_xml_name_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_maps_xml_name_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlMapsXmlName" ~service ~context + ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_maps_xml_name_response_of_xml ~error_deserializer +end + +module XmlNamespaces = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_namespaces_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_namespaces_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlNamespaces" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_namespaces_response_of_xml ~error_deserializer +end + +module XmlTimestamps = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_timestamps_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_timestamps_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlTimestamps" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_timestamps_response_of_xml ~error_deserializer +end + +module XmlUnions = struct + let error_to_string = Smaws_Lib.Protocols.RestXml.error_to_string + + let error_deserializer (error : Smaws_Lib.Protocols.RestXml.Error.t) ~body:_ = + Smaws_Lib.Protocols.RestXml.Errors.default_handler error + + let request context (request : xml_unions_request) = + let w = Smaws_Lib.Xml.Write.make () in + xml_unions_request_to_xml w request; + let body_str = Smaws_Lib.Xml.Write.to_string w in + Smaws_Lib.Protocols.RestXml.request ~shape_name:"XmlUnions" ~service ~context ~method_:`POST + ~uri:(Smaws_Lib.Service.makeUri ~config:(Smaws_Lib.Context.config context) ~service) + ~query:[] ~headers:[] + ~body:(Some ("application/xml", body_str)) + ~output_deserializer:xml_unions_response_of_xml ~error_deserializer +end diff --git a/model_tests/protocols/restxml/protocol_tests.ml b/model_tests/protocols/restxml/protocol_tests.ml new file mode 100644 index 00000000..983e8eb6 --- /dev/null +++ b/model_tests/protocols/restxml/protocol_tests.ml @@ -0,0 +1,9088 @@ +open Alcotest +open Smaws_Test_Support_Lib +open Restxml + +let all_query_string_types () = + Eio.Switch.run ~name:"AllQueryStringTypes" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.all_query_string_types_input = + { + query_params_map_of_strings = None; + query_integer_enum_list = Some [ A; B ]; + query_integer_enum = Some A; + query_enum_list = Some [ FOO; BAZ; BAR ]; + query_enum = Some FOO; + query_timestamp_list = + Some + [ + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1.); + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 2.); + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 3.); + ]; + query_timestamp = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1.)); + query_boolean_list = Some [ true; false; true ]; + query_boolean = Some true; + query_double_list = Some [ 1.1; 2.1; 3.1 ]; + query_double = Some 1.1; + query_float = Some 1.1; + query_long = Some (Smaws_Lib.CoreTypes.Int64.of_int 4); + query_integer_set = Some [ 1; 2; 3 ]; + query_integer_list = Some [ 1; 2; 3 ]; + query_integer = Some 3; + query_short = Some 2; + query_byte = Some 1; + query_string_set = Some [ "a"; "b"; "c" ]; + query_string_list = Some [ "a"; "b"; "c" ]; + query_string = Some "Hello there"; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = AllQueryStringTypes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/AllQueryStringTypesInput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (AllQueryStringTypes.error_to_string error) + +let rest_xml_query_string_map () = + Eio.Switch.run ~name:"RestXmlQueryStringMap" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.all_query_string_types_input = + { + query_params_map_of_strings = + Some [ ("QueryParamsStringKeyA", "Foo"); ("QueryParamsStringKeyB", "Bar") ]; + query_integer_enum_list = None; + query_integer_enum = None; + query_enum_list = None; + query_enum = None; + query_timestamp_list = None; + query_timestamp = None; + query_boolean_list = None; + query_boolean = None; + query_double_list = None; + query_double = None; + query_float = None; + query_long = None; + query_integer_set = None; + query_integer_list = None; + query_integer = None; + query_short = None; + query_byte = None; + query_string_set = None; + query_string_list = None; + query_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = AllQueryStringTypes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/AllQueryStringTypesInput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (AllQueryStringTypes.error_to_string error) + +let rest_xml_query_string_escaping () = + Eio.Switch.run ~name:"RestXmlQueryStringEscaping" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.all_query_string_types_input = + { + query_params_map_of_strings = None; + query_integer_enum_list = None; + query_integer_enum = None; + query_enum_list = None; + query_enum = None; + query_timestamp_list = None; + query_timestamp = None; + query_boolean_list = None; + query_boolean = None; + query_double_list = None; + query_double = None; + query_float = None; + query_long = None; + query_integer_set = None; + query_integer_list = None; + query_integer = None; + query_short = None; + query_byte = None; + query_string_set = None; + query_string_list = None; + query_string = Some " %:/?#[]@!$&'()*+,;=\240\159\152\185"; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = AllQueryStringTypes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/AllQueryStringTypesInput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (AllQueryStringTypes.error_to_string error) + +let rest_xml_supports_na_n_float_query_values () = + Eio.Switch.run ~name:"RestXmlSupportsNaNFloatQueryValues" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.all_query_string_types_input = + { + query_params_map_of_strings = None; + query_integer_enum_list = None; + query_integer_enum = None; + query_enum_list = None; + query_enum = None; + query_timestamp_list = None; + query_timestamp = None; + query_boolean_list = None; + query_boolean = None; + query_double_list = None; + query_double = Some Float.nan; + query_float = Some Float.nan; + query_long = None; + query_integer_set = None; + query_integer_list = None; + query_integer = None; + query_short = None; + query_byte = None; + query_string_set = None; + query_string_list = None; + query_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = AllQueryStringTypes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/AllQueryStringTypesInput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (AllQueryStringTypes.error_to_string error) + +let rest_xml_supports_infinity_float_query_values () = + Eio.Switch.run ~name:"RestXmlSupportsInfinityFloatQueryValues" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.all_query_string_types_input = + { + query_params_map_of_strings = None; + query_integer_enum_list = None; + query_integer_enum = None; + query_enum_list = None; + query_enum = None; + query_timestamp_list = None; + query_timestamp = None; + query_boolean_list = None; + query_boolean = None; + query_double_list = None; + query_double = Some Float.infinity; + query_float = Some Float.infinity; + query_long = None; + query_integer_set = None; + query_integer_list = None; + query_integer = None; + query_short = None; + query_byte = None; + query_string_set = None; + query_string_list = None; + query_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = AllQueryStringTypes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/AllQueryStringTypesInput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (AllQueryStringTypes.error_to_string error) + +let rest_xml_supports_negative_infinity_float_query_values () = + Eio.Switch.run ~name:"RestXmlSupportsNegativeInfinityFloatQueryValues" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.all_query_string_types_input = + { + query_params_map_of_strings = None; + query_integer_enum_list = None; + query_integer_enum = None; + query_enum_list = None; + query_enum = None; + query_timestamp_list = None; + query_timestamp = None; + query_boolean_list = None; + query_boolean = None; + query_double_list = None; + query_double = Some Float.neg_infinity; + query_float = Some Float.neg_infinity; + query_long = None; + query_integer_set = None; + query_integer_list = None; + query_integer = None; + query_short = None; + query_byte = None; + query_string_set = None; + query_string_list = None; + query_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = AllQueryStringTypes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/AllQueryStringTypesInput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (AllQueryStringTypes.error_to_string error) + +let rest_xml_zero_and_false_query_values () = + Eio.Switch.run ~name:"RestXmlZeroAndFalseQueryValues" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.all_query_string_types_input = + { + query_params_map_of_strings = None; + query_integer_enum_list = None; + query_integer_enum = None; + query_enum_list = None; + query_enum = None; + query_timestamp_list = None; + query_timestamp = None; + query_boolean_list = None; + query_boolean = Some false; + query_double_list = None; + query_double = None; + query_float = None; + query_long = None; + query_integer_set = None; + query_integer_list = None; + query_integer = Some 0; + query_short = None; + query_byte = None; + query_string_set = None; + query_string_list = None; + query_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = AllQueryStringTypes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/AllQueryStringTypesInput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (AllQueryStringTypes.error_to_string error) + +let all_query_string_types_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#AllQueryStringTypes", + [ + ("AllQueryStringTypes", `Quick, all_query_string_types); + ("RestXmlQueryStringMap", `Quick, rest_xml_query_string_map); + ("RestXmlQueryStringEscaping", `Quick, rest_xml_query_string_escaping); + ("RestXmlSupportsNaNFloatQueryValues", `Quick, rest_xml_supports_na_n_float_query_values); + ( "RestXmlSupportsInfinityFloatQueryValues", + `Quick, + rest_xml_supports_infinity_float_query_values ); + ( "RestXmlSupportsNegativeInfinityFloatQueryValues", + `Quick, + rest_xml_supports_negative_infinity_float_query_values ); + ("RestXmlZeroAndFalseQueryValues", `Quick, rest_xml_zero_and_false_query_values); + ] ) + +let body_with_xml_name () = + Eio.Switch.run ~name:"BodyWithXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.body_with_xml_name_input_output = { nested = Some { name = Some "Phreddy" } } in + Mock.mock_response ?body:(Some "Phreddy") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = BodyWithXmlName.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "Phreddy")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/BodyWithXmlName") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (BodyWithXmlName.error_to_string error) + +let body_with_xml_name () = + Eio.Switch.run ~name:"BodyWithXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "Phreddy") ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = BodyWithXmlName.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some { name = Some "Phreddy" } } : Types.body_with_xml_name_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_body_with_xml_name_input_output + Types.equal_body_with_xml_name_input_output) + "expected output" expected result + | Error error -> failwith (BodyWithXmlName.error_to_string error) + +let body_with_xml_name_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#BodyWithXmlName", + [ + ("BodyWithXmlName", `Quick, body_with_xml_name); + ("BodyWithXmlName", `Quick, body_with_xml_name); + ] ) + +let constant_and_variable_query_string_missing_one_value () = + Eio.Switch.run ~name:"ConstantAndVariableQueryStringMissingOneValue" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.constant_and_variable_query_string_input = + { maybe_set = None; baz = Some "bam" } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = ConstantAndVariableQueryString.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/ConstantAndVariableQueryString") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (ConstantAndVariableQueryString.error_to_string error) + +let constant_and_variable_query_string_all_values () = + Eio.Switch.run ~name:"ConstantAndVariableQueryStringAllValues" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.constant_and_variable_query_string_input = + { maybe_set = Some "yes"; baz = Some "bam" } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = ConstantAndVariableQueryString.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/ConstantAndVariableQueryString") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (ConstantAndVariableQueryString.error_to_string error) + +let constant_and_variable_query_string_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#ConstantAndVariableQueryString", + [ + ( "ConstantAndVariableQueryStringMissingOneValue", + `Quick, + constant_and_variable_query_string_missing_one_value ); + ( "ConstantAndVariableQueryStringAllValues", + `Quick, + constant_and_variable_query_string_all_values ); + ] ) + +let constant_query_string () = + Eio.Switch.run ~name:"ConstantQueryString" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.constant_query_string_input = { hello = "hi" } in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = ConstantQueryString.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/ConstantQueryString/hi") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (ConstantQueryString.error_to_string error) + +let constant_query_string_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#ConstantQueryString", + [ ("ConstantQueryString", `Quick, constant_query_string) ] ) + +let content_type_parameters_test_suite : unit Alcotest.test = + ("aws.protocoltests.restxml#ContentTypeParameters", []) + +let rest_xml_date_time_with_negative_offset () = + Eio.Switch.run ~name:"RestXmlDateTimeWithNegativeOffset" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2019-12-16T22:48:18-01:00\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = DatetimeOffsets.request ctx () in + match response with + | Ok result -> + let expected = + ({ datetime = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)) } + : Types.datetime_offsets_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_datetime_offsets_output + Types.equal_datetime_offsets_output) + "expected output" expected result + | Error error -> failwith (DatetimeOffsets.error_to_string error) + +let rest_xml_date_time_with_positive_offset () = + Eio.Switch.run ~name:"RestXmlDateTimeWithPositiveOffset" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2019-12-17T00:48:18+01:00\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = DatetimeOffsets.request ctx () in + match response with + | Ok result -> + let expected = + ({ datetime = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)) } + : Types.datetime_offsets_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_datetime_offsets_output + Types.equal_datetime_offsets_output) + "expected output" expected result + | Error error -> failwith (DatetimeOffsets.error_to_string error) + +let datetime_offsets_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#DatetimeOffsets", + [ + ("RestXmlDateTimeWithNegativeOffset", `Quick, rest_xml_date_time_with_negative_offset); + ("RestXmlDateTimeWithPositiveOffset", `Quick, rest_xml_date_time_with_positive_offset); + ] ) + +let empty_input_and_empty_output () = + Eio.Switch.run ~name:"EmptyInputAndEmptyOutput" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.empty_input_and_empty_output_input = () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = EmptyInputAndEmptyOutput.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/EmptyInputAndEmptyOutput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (EmptyInputAndEmptyOutput.error_to_string error) + +let empty_input_and_empty_output () = + Eio.Switch.run ~name:"EmptyInputAndEmptyOutput" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[] (); + let response = EmptyInputAndEmptyOutput.request ctx () in + match response with + | Ok result -> + let expected = (() : Types.empty_input_and_empty_output_output) in + check + (Alcotest_http.testable_nan_aware Types.pp_empty_input_and_empty_output_output + Types.equal_empty_input_and_empty_output_output) + "expected output" expected result + | Error error -> failwith (EmptyInputAndEmptyOutput.error_to_string error) + +let empty_input_and_empty_output_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#EmptyInputAndEmptyOutput", + [ + ("EmptyInputAndEmptyOutput", `Quick, empty_input_and_empty_output); + ("EmptyInputAndEmptyOutput", `Quick, empty_input_and_empty_output); + ] ) + +let rest_xml_endpoint_trait () = + Eio.Switch.run ~name:"RestXmlEndpointTrait" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = + { + Config.dummy with + endpoint = Some { uri = Some ("//example.com" |> Uri.of_string); headers = None }; + } + in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Smaws_Lib.Smithy_api.Types.unit_ = () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = EndpointOperation.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/EndpointOperation") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (EndpointOperation.error_to_string error) + +let endpoint_operation_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#EndpointOperation", + [ ("RestXmlEndpointTrait", `Quick, rest_xml_endpoint_trait) ] ) + +let rest_xml_endpoint_trait_with_host_label_and_http_binding () = + Eio.Switch.run ~name:"RestXmlEndpointTraitWithHostLabelAndHttpBinding" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = + { + Config.dummy with + endpoint = Some { uri = Some ("//example.com" |> Uri.of_string); headers = None }; + } + in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.host_label_header_input = { account_id = "bar" } in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = EndpointWithHostLabelHeaderOperation.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/EndpointWithHostLabelHeaderOperation") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Amz-Account-Id", "bar") ] + request.headers + in + () + | Error error -> failwith (EndpointWithHostLabelHeaderOperation.error_to_string error) + +let endpoint_with_host_label_header_operation_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#EndpointWithHostLabelHeaderOperation", + [ + ( "RestXmlEndpointTraitWithHostLabelAndHttpBinding", + `Quick, + rest_xml_endpoint_trait_with_host_label_and_http_binding ); + ] ) + +let rest_xml_endpoint_trait_with_host_label () = + Eio.Switch.run ~name:"RestXmlEndpointTraitWithHostLabel" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = + { + Config.dummy with + endpoint = Some { uri = Some ("//example.com" |> Uri.of_string); headers = None }; + } + in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.endpoint_with_host_label_operation_request = { label = "bar" } in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = EndpointWithHostLabelOperation.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/EndpointWithHostLabelOperation") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (EndpointWithHostLabelOperation.error_to_string error) + +let endpoint_with_host_label_operation_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#EndpointWithHostLabelOperation", + [ ("RestXmlEndpointTraitWithHostLabel", `Quick, rest_xml_endpoint_trait_with_host_label) ] ) + +let flattened_xml_map () = + Eio.Switch.run ~name:"FlattenedXmlMap" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.flattened_xml_map_request = { my_map = Some [ ("foo", FOO); ("baz", BAZ) ] } in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ foo\n\ + \ Foo\n\ + \ \n\ + \ \n\ + \ baz\n\ + \ Baz\n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = FlattenedXmlMap.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ foo\n\ + \ Foo\n\ + \ \n\ + \ \n\ + \ baz\n\ + \ Baz\n\ + \ \n\ + ")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/FlattenedXmlMap") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (FlattenedXmlMap.error_to_string error) + +let flattened_xml_map () = + Eio.Switch.run ~name:"FlattenedXmlMap" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ foo\n\ + \ Foo\n\ + \ \n\ + \ \n\ + \ baz\n\ + \ Baz\n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = FlattenedXmlMap.request ctx { my_map = None } in + match response with + | Ok result -> + let expected = + ({ my_map = Some [ ("foo", FOO); ("baz", BAZ) ] } : Types.flattened_xml_map_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_flattened_xml_map_response + Types.equal_flattened_xml_map_response) + "expected output" expected result + | Error error -> failwith (FlattenedXmlMap.error_to_string error) + +let flattened_xml_map_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#FlattenedXmlMap", + [ + ("FlattenedXmlMap", `Quick, flattened_xml_map); ("FlattenedXmlMap", `Quick, flattened_xml_map); + ] ) + +let flattened_xml_map_with_xml_name () = + Eio.Switch.run ~name:"FlattenedXmlMapWithXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.flattened_xml_map_with_xml_name_request = + { my_map = Some [ ("a", "A"); ("b", "B") ] } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ a\n\ + \ A\n\ + \ \n\ + \ \n\ + \ b\n\ + \ B\n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = FlattenedXmlMapWithXmlName.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ a\n\ + \ A\n\ + \ \n\ + \ \n\ + \ b\n\ + \ B\n\ + \ \n\ + ")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/FlattenedXmlMapWithXmlName") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (FlattenedXmlMapWithXmlName.error_to_string error) + +let flattened_xml_map_with_xml_name () = + Eio.Switch.run ~name:"FlattenedXmlMapWithXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ a\n\ + \ A\n\ + \ \n\ + \ \n\ + \ b\n\ + \ B\n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = FlattenedXmlMapWithXmlName.request ctx { my_map = None } in + match response with + | Ok result -> + let expected = + ({ my_map = Some [ ("a", "A"); ("b", "B") ] } + : Types.flattened_xml_map_with_xml_name_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_flattened_xml_map_with_xml_name_response + Types.equal_flattened_xml_map_with_xml_name_response) + "expected output" expected result + | Error error -> failwith (FlattenedXmlMapWithXmlName.error_to_string error) + +let flattened_xml_map_with_xml_name_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#FlattenedXmlMapWithXmlName", + [ + ("FlattenedXmlMapWithXmlName", `Quick, flattened_xml_map_with_xml_name); + ("FlattenedXmlMapWithXmlName", `Quick, flattened_xml_map_with_xml_name); + ] ) + +let rest_xml_flattened_xml_map_with_xml_namespace () = + Eio.Switch.run ~name:"RestXmlFlattenedXmlMapWithXmlNamespace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ a\n\ + \ A\n\ + \ \n\ + \ \n\ + \ b\n\ + \ B\n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = FlattenedXmlMapWithXmlNamespace.request ctx () in + match response with + | Ok result -> + let expected = + ({ my_map = Some [ ("a", "A"); ("b", "B") ] } + : Types.flattened_xml_map_with_xml_namespace_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_flattened_xml_map_with_xml_namespace_output + Types.equal_flattened_xml_map_with_xml_namespace_output) + "expected output" expected result + | Error error -> failwith (FlattenedXmlMapWithXmlNamespace.error_to_string error) + +let flattened_xml_map_with_xml_namespace_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#FlattenedXmlMapWithXmlNamespace", + [ + ( "RestXmlFlattenedXmlMapWithXmlNamespace", + `Quick, + rest_xml_flattened_xml_map_with_xml_namespace ); + ] ) + +let rest_xml_date_time_with_fractional_seconds () = + Eio.Switch.run ~name:"RestXmlDateTimeWithFractionalSeconds" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2000-01-02T20:34:56.123Z\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = FractionalSeconds.request ctx () in + match response with + | Ok result -> + let expected = + ({ + datetime = + Some + (Smaws_Lib.CoreTypes.Timestamp.truncate ~frac_s:6 + (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 946845296.123))); + } + : Types.fractional_seconds_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_fractional_seconds_output + Types.equal_fractional_seconds_output) + "expected output" expected result + | Error error -> failwith (FractionalSeconds.error_to_string error) + +let fractional_seconds_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#FractionalSeconds", + [ ("RestXmlDateTimeWithFractionalSeconds", `Quick, rest_xml_date_time_with_fractional_seconds) ] + ) + +let greeting_with_errors () = + Eio.Switch.run ~name:"GreetingWithErrors" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[ ("X-Greeting", "Hello") ] (); + let response = GreetingWithErrors.request ctx () in + match response with + | Ok result -> + let expected = ({ greeting = Some "Hello" } : Types.greeting_with_errors_output) in + check + (Alcotest_http.testable_nan_aware Types.pp_greeting_with_errors_output + Types.equal_greeting_with_errors_output) + "expected output" expected result + | Error error -> failwith (GreetingWithErrors.error_to_string error) + +let complex_error () = + Eio.Switch.run ~name:"ComplexError" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ Sender\n\ + \ ComplexError\n\ + \ Hi\n\ + \ Top level\n\ + \ \n\ + \ bar\n\ + \ \n\ + \ \n\ + \ foo-id\n\ + \n") + ~status:403 + ~headers:[ ("X-Header", "Header"); ("Content-Type", "application/xml") ] + (); + let response = GreetingWithErrors.request ctx () in + match response with + | Error (`ComplexError e) -> + let expected = + ({ + nested = Some { foo = Some "bar" }; + top_level = Some "Top level"; + header = Some "Header"; + } + : Types.complex_error) + in + check + (Alcotest_http.testable_nan_aware Types.pp_complex_error Types.equal_complex_error) + "expected error" expected e + | Error other -> failwith (GreetingWithErrors.error_to_string other) + | Ok _ -> failwith "expected an error response, got Ok" + +let invalid_greeting_error () = + Eio.Switch.run ~name:"InvalidGreetingError" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ Sender\n\ + \ InvalidGreeting\n\ + \ Hi\n\ + \ setting\n\ + \ \n\ + \ foo-id\n\ + \n") + ~status:400 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = GreetingWithErrors.request ctx () in + match response with + | Error (`InvalidGreeting e) -> + let expected = ({ message = Some "Hi" } : Types.invalid_greeting) in + check + (Alcotest_http.testable_nan_aware Types.pp_invalid_greeting Types.equal_invalid_greeting) + "expected error" expected e + | Error other -> failwith (GreetingWithErrors.error_to_string other) + | Ok _ -> failwith "expected an error response, got Ok" + +let greeting_with_errors_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#GreetingWithErrors", + [ + ("GreetingWithErrors", `Quick, greeting_with_errors); + ("ComplexError", `Quick, complex_error); + ("InvalidGreetingError", `Quick, invalid_greeting_error); + ] ) + +let http_empty_prefix_headers_request_client () = + Eio.Switch.run ~name:"HttpEmptyPrefixHeadersRequestClient" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_empty_prefix_headers_input = + { + specific_header = Some "There"; + prefix_headers = Some [ ("x-foo", "Foo"); ("hello", "Hello") ]; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpEmptyPrefixHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpEmptyPrefixHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("hello", "There"); ("x-foo", "Foo") ] + request.headers + in + () + | Error error -> failwith (HttpEmptyPrefixHeaders.error_to_string error) + +let http_empty_prefix_headers_response_server () = + Eio.Switch.run ~name:"HttpEmptyPrefixHeadersResponseServer" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:None ~status:200 ~headers:[ ("hello", "There"); ("x-foo", "Foo") ] (); + let response = + HttpEmptyPrefixHeaders.request ctx { specific_header = None; prefix_headers = None } + in + match response with + | Ok result -> + let expected = + ({ + specific_header = Some "There"; + prefix_headers = Some [ ("x-foo", "Foo"); ("hello", "Hello") ]; + } + : Types.http_empty_prefix_headers_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_empty_prefix_headers_output + Types.equal_http_empty_prefix_headers_output) + "expected output" expected result + | Error error -> failwith (HttpEmptyPrefixHeaders.error_to_string error) + +let http_empty_prefix_headers_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpEmptyPrefixHeaders", + [ + ("HttpEmptyPrefixHeadersRequestClient", `Quick, http_empty_prefix_headers_request_client); + ("HttpEmptyPrefixHeadersResponseServer", `Quick, http_empty_prefix_headers_response_server); + ] ) + +let rest_xml_enum_payload_request () = + Eio.Switch.run ~name:"RestXmlEnumPayloadRequest" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.enum_payload_input = { payload = Some V } in + Mock.mock_response ?body:(Some "enumvalue") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpEnumPayload.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "enumvalue")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/EnumPayload") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "text/plain") ] + request.headers + in + () + | Error error -> failwith (HttpEnumPayload.error_to_string error) + +let rest_xml_enum_payload_response () = + Eio.Switch.run ~name:"RestXmlEnumPayloadResponse" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "enumvalue") ~status:200 + ~headers:[ ("Content-Type", "text/plain") ] + (); + let response = HttpEnumPayload.request ctx { payload = None } in + match response with + | Ok result -> + let expected = ({ payload = Some V } : Types.enum_payload_input) in + check + (Alcotest_http.testable_nan_aware Types.pp_enum_payload_input Types.equal_enum_payload_input) + "expected output" expected result + | Error error -> failwith (HttpEnumPayload.error_to_string error) + +let http_enum_payload_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpEnumPayload", + [ + ("RestXmlEnumPayloadRequest", `Quick, rest_xml_enum_payload_request); + ("RestXmlEnumPayloadResponse", `Quick, rest_xml_enum_payload_response); + ] ) + +let http_payload_traits_with_blob () = + Eio.Switch.run ~name:"HttpPayloadTraitsWithBlob" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_traits_input_output = + { blob = Some (Smaws_Lib.CoreTypes.Blob.of_string "blobby blob blob"); foo = Some "Foo" } + in + Mock.mock_response ?body:(Some "blobby blob blob") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadTraits.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "blobby blob blob")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadTraits") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Foo", "Foo") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadTraits.error_to_string error) + +let http_payload_traits_with_no_blob_body () = + Eio.Switch.run ~name:"HttpPayloadTraitsWithNoBlobBody" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_traits_input_output = { blob = None; foo = Some "Foo" } in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadTraits.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadTraits") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Foo", "Foo") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadTraits.error_to_string error) + +let http_payload_traits_with_blob () = + Eio.Switch.run ~name:"HttpPayloadTraitsWithBlob" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "blobby blob blob") ~status:200 ~headers:[ ("X-Foo", "Foo") ] (); + let response = HttpPayloadTraits.request ctx { blob = None; foo = None } in + match response with + | Ok result -> + let expected = + ({ blob = Some (Smaws_Lib.CoreTypes.Blob.of_string "blobby blob blob"); foo = Some "Foo" } + : Types.http_payload_traits_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_traits_input_output + Types.equal_http_payload_traits_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadTraits.error_to_string error) + +let http_payload_traits_with_no_blob_body () = + Eio.Switch.run ~name:"HttpPayloadTraitsWithNoBlobBody" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[ ("X-Foo", "Foo") ] (); + let response = HttpPayloadTraits.request ctx { blob = None; foo = None } in + match response with + | Ok result -> + let expected = ({ blob = None; foo = Some "Foo" } : Types.http_payload_traits_input_output) in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_traits_input_output + Types.equal_http_payload_traits_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadTraits.error_to_string error) + +let http_payload_traits_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadTraits", + [ + ("HttpPayloadTraitsWithBlob", `Quick, http_payload_traits_with_blob); + ("HttpPayloadTraitsWithNoBlobBody", `Quick, http_payload_traits_with_no_blob_body); + ("HttpPayloadTraitsWithBlob", `Quick, http_payload_traits_with_blob); + ("HttpPayloadTraitsWithNoBlobBody", `Quick, http_payload_traits_with_no_blob_body); + ] ) + +let http_payload_traits_with_media_type_with_blob () = + Eio.Switch.run ~name:"HttpPayloadTraitsWithMediaTypeWithBlob" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_traits_with_media_type_input_output = + { blob = Some (Smaws_Lib.CoreTypes.Blob.of_string "blobby blob blob"); foo = Some "Foo" } + in + Mock.mock_response ?body:(Some "blobby blob blob") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadTraitsWithMediaType.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "blobby blob blob")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadTraitsWithMediaType") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "text/plain"); ("X-Foo", "Foo") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadTraitsWithMediaType.error_to_string error) + +let http_payload_traits_with_media_type_with_blob () = + Eio.Switch.run ~name:"HttpPayloadTraitsWithMediaTypeWithBlob" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "blobby blob blob") ~status:200 + ~headers:[ ("Content-Type", "text/plain"); ("X-Foo", "Foo") ] + (); + let response = HttpPayloadTraitsWithMediaType.request ctx { blob = None; foo = None } in + match response with + | Ok result -> + let expected = + ({ blob = Some (Smaws_Lib.CoreTypes.Blob.of_string "blobby blob blob"); foo = Some "Foo" } + : Types.http_payload_traits_with_media_type_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_traits_with_media_type_input_output + Types.equal_http_payload_traits_with_media_type_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadTraitsWithMediaType.error_to_string error) + +let http_payload_traits_with_media_type_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadTraitsWithMediaType", + [ + ( "HttpPayloadTraitsWithMediaTypeWithBlob", + `Quick, + http_payload_traits_with_media_type_with_blob ); + ( "HttpPayloadTraitsWithMediaTypeWithBlob", + `Quick, + http_payload_traits_with_media_type_with_blob ); + ] ) + +let http_payload_with_member_xml_name () = + Eio.Switch.run ~name:"HttpPayloadWithMemberXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_with_member_xml_name_input_output = + { nested = Some { name = Some "Phreddy" } } + in + Mock.mock_response ?body:(Some "Phreddy") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadWithMemberXmlName.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "Phreddy")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadWithMemberXmlName") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadWithMemberXmlName.error_to_string error) + +let http_payload_with_member_xml_name () = + Eio.Switch.run ~name:"HttpPayloadWithMemberXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "Phreddy") ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = HttpPayloadWithMemberXmlName.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some { name = Some "Phreddy" } } + : Types.http_payload_with_member_xml_name_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_with_member_xml_name_input_output + Types.equal_http_payload_with_member_xml_name_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadWithMemberXmlName.error_to_string error) + +let http_payload_with_member_xml_name_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadWithMemberXmlName", + [ + ("HttpPayloadWithMemberXmlName", `Quick, http_payload_with_member_xml_name); + ("HttpPayloadWithMemberXmlName", `Quick, http_payload_with_member_xml_name); + ] ) + +let http_payload_with_structure () = + Eio.Switch.run ~name:"HttpPayloadWithStructure" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_with_structure_input_output = + { nested = Some { name = Some "Phreddy"; greeting = Some "hello" } } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ hello\n\ + \ Phreddy\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadWithStructure.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ hello\n\ + \ Phreddy\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadWithStructure") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadWithStructure.error_to_string error) + +let http_payload_with_structure () = + Eio.Switch.run ~name:"HttpPayloadWithStructure" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ hello\n\ + \ Phreddy\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = HttpPayloadWithStructure.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some { name = Some "Phreddy"; greeting = Some "hello" } } + : Types.http_payload_with_structure_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_with_structure_input_output + Types.equal_http_payload_with_structure_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadWithStructure.error_to_string error) + +let http_payload_with_structure_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadWithStructure", + [ + ("HttpPayloadWithStructure", `Quick, http_payload_with_structure); + ("HttpPayloadWithStructure", `Quick, http_payload_with_structure); + ] ) + +let rest_xml_http_payload_with_union () = + Eio.Switch.run ~name:"RestXmlHttpPayloadWithUnion" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_with_union_input_output = { nested = Some (Greeting "hello") } in + Mock.mock_response ?body:(Some "\n hello\n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadWithUnion.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n hello\n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadWithUnion") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadWithUnion.error_to_string error) + +let rest_xml_http_payload_with_unset_union () = + Eio.Switch.run ~name:"RestXmlHttpPayloadWithUnsetUnion" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_with_union_input_output = { nested = None } in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadWithUnion.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadWithUnion") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpPayloadWithUnion.error_to_string error) + +let rest_xml_http_payload_with_union () = + Eio.Switch.run ~name:"RestXmlHttpPayloadWithUnion" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "\n hello\n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = HttpPayloadWithUnion.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some (Greeting "hello") } : Types.http_payload_with_union_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_with_union_input_output + Types.equal_http_payload_with_union_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadWithUnion.error_to_string error) + +let rest_xml_http_payload_with_unset_union () = + Eio.Switch.run ~name:"RestXmlHttpPayloadWithUnsetUnion" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[ ("Content-Length", "0") ] (); + let response = HttpPayloadWithUnion.request ctx { nested = None } in + match response with + | Ok result -> + let expected = ({ nested = None } : Types.http_payload_with_union_input_output) in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_with_union_input_output + Types.equal_http_payload_with_union_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadWithUnion.error_to_string error) + +let http_payload_with_union_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadWithUnion", + [ + ("RestXmlHttpPayloadWithUnion", `Quick, rest_xml_http_payload_with_union); + ("RestXmlHttpPayloadWithUnsetUnion", `Quick, rest_xml_http_payload_with_unset_union); + ("RestXmlHttpPayloadWithUnion", `Quick, rest_xml_http_payload_with_union); + ("RestXmlHttpPayloadWithUnsetUnion", `Quick, rest_xml_http_payload_with_unset_union); + ] ) + +let http_payload_with_xml_name () = + Eio.Switch.run ~name:"HttpPayloadWithXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_with_xml_name_input_output = + { nested = Some { name = Some "Phreddy" } } + in + Mock.mock_response ?body:(Some "Phreddy") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadWithXmlName.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "Phreddy")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadWithXmlName") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadWithXmlName.error_to_string error) + +let http_payload_with_xml_name () = + Eio.Switch.run ~name:"HttpPayloadWithXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "Phreddy") ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = HttpPayloadWithXmlName.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some { name = Some "Phreddy" } } + : Types.http_payload_with_xml_name_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_with_xml_name_input_output + Types.equal_http_payload_with_xml_name_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadWithXmlName.error_to_string error) + +let http_payload_with_xml_name_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadWithXmlName", + [ + ("HttpPayloadWithXmlName", `Quick, http_payload_with_xml_name); + ("HttpPayloadWithXmlName", `Quick, http_payload_with_xml_name); + ] ) + +let http_payload_with_xml_namespace () = + Eio.Switch.run ~name:"HttpPayloadWithXmlNamespace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_with_xml_namespace_input_output = + { nested = Some { name = Some "Phreddy" } } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ Phreddy\n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadWithXmlNamespace.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ Phreddy\n\ + ")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadWithXmlNamespace") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadWithXmlNamespace.error_to_string error) + +let http_payload_with_xml_namespace () = + Eio.Switch.run ~name:"HttpPayloadWithXmlNamespace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ Phreddy\n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = HttpPayloadWithXmlNamespace.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some { name = Some "Phreddy" } } + : Types.http_payload_with_xml_namespace_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_payload_with_xml_namespace_input_output + Types.equal_http_payload_with_xml_namespace_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadWithXmlNamespace.error_to_string error) + +let http_payload_with_xml_namespace_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadWithXmlNamespace", + [ + ("HttpPayloadWithXmlNamespace", `Quick, http_payload_with_xml_namespace); + ("HttpPayloadWithXmlNamespace", `Quick, http_payload_with_xml_namespace); + ] ) + +let http_payload_with_xml_namespace_and_prefix () = + Eio.Switch.run ~name:"HttpPayloadWithXmlNamespaceAndPrefix" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_payload_with_xml_namespace_and_prefix_input_output = + { nested = Some { name = Some "Phreddy" } } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ Phreddy\n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPayloadWithXmlNamespaceAndPrefix.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ Phreddy\n\ + ")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPayloadWithXmlNamespaceAndPrefix") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (HttpPayloadWithXmlNamespaceAndPrefix.error_to_string error) + +let http_payload_with_xml_namespace_and_prefix () = + Eio.Switch.run ~name:"HttpPayloadWithXmlNamespaceAndPrefix" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ Phreddy\n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = HttpPayloadWithXmlNamespaceAndPrefix.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some { name = Some "Phreddy" } } + : Types.http_payload_with_xml_namespace_and_prefix_input_output) + in + check + (Alcotest_http.testable_nan_aware + Types.pp_http_payload_with_xml_namespace_and_prefix_input_output + Types.equal_http_payload_with_xml_namespace_and_prefix_input_output) + "expected output" expected result + | Error error -> failwith (HttpPayloadWithXmlNamespaceAndPrefix.error_to_string error) + +let http_payload_with_xml_namespace_and_prefix_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPayloadWithXmlNamespaceAndPrefix", + [ + ("HttpPayloadWithXmlNamespaceAndPrefix", `Quick, http_payload_with_xml_namespace_and_prefix); + ("HttpPayloadWithXmlNamespaceAndPrefix", `Quick, http_payload_with_xml_namespace_and_prefix); + ] ) + +let http_prefix_headers_are_present () = + Eio.Switch.run ~name:"HttpPrefixHeadersArePresent" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_prefix_headers_input_output = + { foo_map = Some [ ("abc", "Abc value"); ("def", "Def value") ]; foo = Some "Foo" } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPrefixHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPrefixHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("x-foo-def", "Def value"); ("x-foo-abc", "Abc value"); ("x-foo", "Foo") ] + request.headers + in + () + | Error error -> failwith (HttpPrefixHeaders.error_to_string error) + +let http_prefix_headers_are_not_present () = + Eio.Switch.run ~name:"HttpPrefixHeadersAreNotPresent" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_prefix_headers_input_output = { foo_map = Some []; foo = Some "Foo" } in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPrefixHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPrefixHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("x-foo", "Foo") ] + request.headers + in + () + | Error error -> failwith (HttpPrefixHeaders.error_to_string error) + +let http_prefix_empty_headers () = + Eio.Switch.run ~name:"HttpPrefixEmptyHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_prefix_headers_input_output = + { foo_map = Some [ ("abc", "") ]; foo = None } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpPrefixHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpPrefixHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("x-foo-abc", "") ] + request.headers + in + () + | Error error -> failwith (HttpPrefixHeaders.error_to_string error) + +let http_prefix_headers_are_present () = + Eio.Switch.run ~name:"HttpPrefixHeadersArePresent" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("x-foo-def", "Def value"); ("x-foo-abc", "Abc value"); ("x-foo", "Foo") ] + (); + let response = HttpPrefixHeaders.request ctx { foo_map = None; foo = None } in + match response with + | Ok result -> + let expected = + ({ foo_map = Some [ ("abc", "Abc value"); ("def", "Def value") ]; foo = Some "Foo" } + : Types.http_prefix_headers_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_prefix_headers_input_output + Types.equal_http_prefix_headers_input_output) + "expected output" expected result + | Error error -> failwith (HttpPrefixHeaders.error_to_string error) + +let http_prefix_headers_are_not_present () = + Eio.Switch.run ~name:"HttpPrefixHeadersAreNotPresent" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[ ("x-foo", "Foo") ] (); + let response = HttpPrefixHeaders.request ctx { foo_map = None; foo = None } in + match response with + | Ok result -> + let expected = + ({ foo_map = Some []; foo = Some "Foo" } : Types.http_prefix_headers_input_output) + in + check + (Alcotest_http.testable_nan_aware Types.pp_http_prefix_headers_input_output + Types.equal_http_prefix_headers_input_output) + "expected output" expected result + | Error error -> failwith (HttpPrefixHeaders.error_to_string error) + +let http_prefix_headers_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpPrefixHeaders", + [ + ("HttpPrefixHeadersArePresent", `Quick, http_prefix_headers_are_present); + ("HttpPrefixHeadersAreNotPresent", `Quick, http_prefix_headers_are_not_present); + ("HttpPrefixEmptyHeaders", `Quick, http_prefix_empty_headers); + ("HttpPrefixHeadersArePresent", `Quick, http_prefix_headers_are_present); + ("HttpPrefixHeadersAreNotPresent", `Quick, http_prefix_headers_are_not_present); + ] ) + +let rest_xml_supports_na_n_float_labels () = + Eio.Switch.run ~name:"RestXmlSupportsNaNFloatLabels" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_request_with_float_labels_input = + { double = Float.nan; float_ = Float.nan } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpRequestWithFloatLabels.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/FloatHttpLabels/NaN/NaN") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpRequestWithFloatLabels.error_to_string error) + +let rest_xml_supports_infinity_float_labels () = + Eio.Switch.run ~name:"RestXmlSupportsInfinityFloatLabels" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_request_with_float_labels_input = + { double = Float.infinity; float_ = Float.infinity } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpRequestWithFloatLabels.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/FloatHttpLabels/Infinity/Infinity") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpRequestWithFloatLabels.error_to_string error) + +let rest_xml_supports_negative_infinity_float_labels () = + Eio.Switch.run ~name:"RestXmlSupportsNegativeInfinityFloatLabels" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_request_with_float_labels_input = + { double = Float.neg_infinity; float_ = Float.neg_infinity } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpRequestWithFloatLabels.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/FloatHttpLabels/-Infinity/-Infinity") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpRequestWithFloatLabels.error_to_string error) + +let http_request_with_float_labels_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpRequestWithFloatLabels", + [ + ("RestXmlSupportsNaNFloatLabels", `Quick, rest_xml_supports_na_n_float_labels); + ("RestXmlSupportsInfinityFloatLabels", `Quick, rest_xml_supports_infinity_float_labels); + ( "RestXmlSupportsNegativeInfinityFloatLabels", + `Quick, + rest_xml_supports_negative_infinity_float_labels ); + ] ) + +let http_request_with_greedy_label_in_path () = + Eio.Switch.run ~name:"HttpRequestWithGreedyLabelInPath" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_request_with_greedy_label_in_path_input = + { baz = "there/guy"; foo = "hello" } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpRequestWithGreedyLabelInPath.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpRequestWithGreedyLabelInPath/foo/hello/baz/there/guy") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpRequestWithGreedyLabelInPath.error_to_string error) + +let http_request_with_greedy_label_in_path_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpRequestWithGreedyLabelInPath", + [ ("HttpRequestWithGreedyLabelInPath", `Quick, http_request_with_greedy_label_in_path) ] ) + +let input_with_headers_and_all_params () = + Eio.Switch.run ~name:"InputWithHeadersAndAllParams" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_request_with_labels_input = + { + timestamp = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + boolean_ = true; + double = 5.1; + float_ = 4.1; + long = Smaws_Lib.CoreTypes.Int64.of_int 3; + integer = 2; + short = 1; + string_ = "string"; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpRequestWithLabels.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/HttpRequestWithLabels/string/1/2/3/4.1/5.1/true/2019-12-16T23%3A48%3A18Z") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpRequestWithLabels.error_to_string error) + +let http_request_label_escaping () = + Eio.Switch.run ~name:"HttpRequestLabelEscaping" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_request_with_labels_input = + { + timestamp = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + boolean_ = true; + double = 5.1; + float_ = 4.1; + long = Smaws_Lib.CoreTypes.Int64.of_int 3; + integer = 2; + short = 1; + string_ = " %:/?#[]@!$&'()*+,;=\240\159\152\185"; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpRequestWithLabels.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string + "/HttpRequestWithLabels/%20%25%3A%2F%3F%23%5B%5D%40%21%24%26%27%28%29%2A%2B%2C%3B%3D%F0%9F%98%B9/1/2/3/4.1/5.1/true/2019-12-16T23%3A48%3A18Z") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpRequestWithLabels.error_to_string error) + +let http_request_with_labels_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpRequestWithLabels", + [ + ("InputWithHeadersAndAllParams", `Quick, input_with_headers_and_all_params); + ("HttpRequestLabelEscaping", `Quick, http_request_label_escaping); + ] ) + +let http_request_with_labels_and_timestamp_format () = + Eio.Switch.run ~name:"HttpRequestWithLabelsAndTimestampFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.http_request_with_labels_and_timestamp_format_input = + { + target_date_time = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + target_http_date = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + target_epoch_seconds = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + default_format = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + member_date_time = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + member_http_date = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + member_epoch_seconds = Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpRequestWithLabelsAndTimestampFormat.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string + "/HttpRequestWithLabelsAndTimestampFormat/1576540098/Mon%2C%2016%20Dec%202019%2023%3A48%3A18%20GMT/2019-12-16T23%3A48%3A18Z/2019-12-16T23%3A48%3A18Z/1576540098/Mon%2C%2016%20Dec%202019%2023%3A48%3A18%20GMT/2019-12-16T23%3A48%3A18Z") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (HttpRequestWithLabelsAndTimestampFormat.error_to_string error) + +let http_request_with_labels_and_timestamp_format_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpRequestWithLabelsAndTimestampFormat", + [ + ( "HttpRequestWithLabelsAndTimestampFormat", + `Quick, + http_request_with_labels_and_timestamp_format ); + ] ) + +let rest_xml_http_response_code () = + Eio.Switch.run ~name:"RestXmlHttpResponseCode" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:201 ~headers:[ ("Content-Type", "application/xml") ] (); + let response = HttpResponseCode.request ctx () in + match response with + | Ok result -> + let expected = ({ status = Some 201 } : Types.http_response_code_output) in + check + (Alcotest_http.testable_nan_aware Types.pp_http_response_code_output + Types.equal_http_response_code_output) + "expected output" expected result + | Error error -> failwith (HttpResponseCode.error_to_string error) + +let http_response_code_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpResponseCode", + [ ("RestXmlHttpResponseCode", `Quick, rest_xml_http_response_code) ] ) + +let rest_xml_string_payload_request () = + Eio.Switch.run ~name:"RestXmlStringPayloadRequest" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.string_payload_input = { payload = Some "rawstring" } in + Mock.mock_response ?body:(Some "rawstring") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = HttpStringPayload.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "rawstring")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/StringPayload") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "text/plain") ] + request.headers + in + () + | Error error -> failwith (HttpStringPayload.error_to_string error) + +let rest_xml_string_payload_response () = + Eio.Switch.run ~name:"RestXmlStringPayloadResponse" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "rawstring") ~status:200 + ~headers:[ ("Content-Type", "text/plain") ] + (); + let response = HttpStringPayload.request ctx { payload = None } in + match response with + | Ok result -> + let expected = ({ payload = Some "rawstring" } : Types.string_payload_input) in + check + (Alcotest_http.testable_nan_aware Types.pp_string_payload_input + Types.equal_string_payload_input) + "expected output" expected result + | Error error -> failwith (HttpStringPayload.error_to_string error) + +let http_string_payload_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#HttpStringPayload", + [ + ("RestXmlStringPayloadRequest", `Quick, rest_xml_string_payload_request); + ("RestXmlStringPayloadResponse", `Quick, rest_xml_string_payload_response); + ] ) + +let ignore_query_params_in_response () = + Eio.Switch.run ~name:"IgnoreQueryParamsInResponse" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some "bam") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = IgnoreQueryParamsInResponse.request ctx () in + match response with + | Ok result -> + let expected = ({ baz = Some "bam" } : Types.ignore_query_params_in_response_output) in + check + (Alcotest_http.testable_nan_aware Types.pp_ignore_query_params_in_response_output + Types.equal_ignore_query_params_in_response_output) + "expected output" expected result + | Error error -> failwith (IgnoreQueryParamsInResponse.error_to_string error) + +let ignore_query_params_in_response_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#IgnoreQueryParamsInResponse", + [ ("IgnoreQueryParamsInResponse", `Quick, ignore_query_params_in_response) ] ) + +let input_and_output_with_string_headers () = + Eio.Switch.run ~name:"InputAndOutputWithStringHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = Some [ "a"; "b"; "c" ]; + header_string_list = Some [ "a"; "b"; "c" ]; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = Some "Hello"; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-StringSet", "a, b, c"); ("X-StringList", "a, b, c"); ("X-String", "Hello") ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_numeric_headers () = + Eio.Switch.run ~name:"InputAndOutputWithNumericHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = Some [ 1; 2; 3 ]; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some 1.1; + header_float = Some 1.1; + header_long = Some (Smaws_Lib.CoreTypes.Int64.of_int 123); + header_integer = Some 123; + header_short = Some 123; + header_byte = Some 1; + header_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ + ("X-IntegerList", "1, 2, 3"); + ("X-Double", "1.1"); + ("X-Float", "1.1"); + ("X-Long", "123"); + ("X-Integer", "123"); + ("X-Short", "123"); + ("X-Byte", "1"); + ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_boolean_headers () = + Eio.Switch.run ~name:"InputAndOutputWithBooleanHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = Some [ true; false; true ]; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = Some false; + header_true_bool = Some true; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ + ("X-BooleanList", "true, false, true"); ("X-Boolean2", "false"); ("X-Boolean1", "true"); + ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_timestamp_headers () = + Eio.Switch.run ~name:"InputAndOutputWithTimestampHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = + Some + [ + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + ]; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-TimestampList", "Mon, 16 Dec 2019 23:48:18 GMT, Mon, 16 Dec 2019 23:48:18 GMT") ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_enum_headers () = + Eio.Switch.run ~name:"InputAndOutputWithEnumHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = Some [ FOO; BAR; BAZ ]; + header_enum = Some FOO; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-EnumList", "Foo, Bar, Baz"); ("X-Enum", "Foo") ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let rest_xml_supports_na_n_float_header_inputs () = + Eio.Switch.run ~name:"RestXmlSupportsNaNFloatHeaderInputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some Float.nan; + header_float = Some Float.nan; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Double", "NaN"); ("X-Float", "NaN") ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let rest_xml_supports_infinity_float_header_inputs () = + Eio.Switch.run ~name:"RestXmlSupportsInfinityFloatHeaderInputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some Float.infinity; + header_float = Some Float.infinity; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Double", "Infinity"); ("X-Float", "Infinity") ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let rest_xml_supports_negative_infinity_float_header_inputs () = + Eio.Switch.run ~name:"RestXmlSupportsNegativeInfinityFloatHeaderInputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.input_and_output_with_headers_i_o = + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some Float.neg_infinity; + header_float = Some Float.neg_infinity; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = InputAndOutputWithHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/InputAndOutputWithHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Double", "-Infinity"); ("X-Float", "-Infinity") ] + request.headers + in + () + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_string_headers () = + Eio.Switch.run ~name:"InputAndOutputWithStringHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("X-StringSet", "a, b, c"); ("X-StringList", "a, b, c"); ("X-String", "Hello") ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = Some [ "a"; "b"; "c" ]; + header_string_list = Some [ "a"; "b"; "c" ]; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = Some "Hello"; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_numeric_headers () = + Eio.Switch.run ~name:"InputAndOutputWithNumericHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers: + [ + ("X-IntegerList", "1, 2, 3"); + ("X-Double", "1.1"); + ("X-Float", "1.1"); + ("X-Long", "123"); + ("X-Integer", "123"); + ("X-Short", "123"); + ("X-Byte", "1"); + ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = Some [ 1; 2; 3 ]; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some 1.1; + header_float = Some 1.1; + header_long = Some (Smaws_Lib.CoreTypes.Int64.of_int 123); + header_integer = Some 123; + header_short = Some 123; + header_byte = Some 1; + header_string = None; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_boolean_headers () = + Eio.Switch.run ~name:"InputAndOutputWithBooleanHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers: + [ ("X-BooleanList", "true, false, true"); ("X-Boolean2", "false"); ("X-Boolean1", "true") ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = Some [ true; false; true ]; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = Some false; + header_true_bool = Some true; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_timestamp_headers () = + Eio.Switch.run ~name:"InputAndOutputWithTimestampHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("X-TimestampList", "Mon, 16 Dec 2019 23:48:18 GMT, Mon, 16 Dec 2019 23:48:18 GMT") ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = None; + header_enum = None; + header_timestamp_list = + Some + [ + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.); + ]; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_enum_headers () = + Eio.Switch.run ~name:"InputAndOutputWithEnumHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("X-EnumList", "Foo, Bar, Baz"); ("X-Enum", "Foo") ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = Some [ FOO; BAR; BAZ ]; + header_enum = Some FOO; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let rest_xml_supports_na_n_float_header_outputs () = + Eio.Switch.run ~name:"RestXmlSupportsNaNFloatHeaderOutputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("X-Double", "NaN"); ("X-Float", "NaN") ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some Float.nan; + header_float = Some Float.nan; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let rest_xml_supports_infinity_float_header_outputs () = + Eio.Switch.run ~name:"RestXmlSupportsInfinityFloatHeaderOutputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("X-Double", "Infinity"); ("X-Float", "Infinity") ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some Float.infinity; + header_float = Some Float.infinity; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let rest_xml_supports_negative_infinity_float_header_outputs () = + Eio.Switch.run ~name:"RestXmlSupportsNegativeInfinityFloatHeaderOutputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("X-Double", "-Infinity"); ("X-Float", "-Infinity") ] + (); + let response = + InputAndOutputWithHeaders.request ctx + { + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = None; + header_float = None; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + in + match response with + | Ok result -> + let expected = + ({ + header_enum_list = None; + header_enum = None; + header_timestamp_list = None; + header_boolean_list = None; + header_integer_list = None; + header_string_set = None; + header_string_list = None; + header_false_bool = None; + header_true_bool = None; + header_double = Some Float.neg_infinity; + header_float = Some Float.neg_infinity; + header_long = None; + header_integer = None; + header_short = None; + header_byte = None; + header_string = None; + } + : Types.input_and_output_with_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_input_and_output_with_headers_i_o + Types.equal_input_and_output_with_headers_i_o) + "expected output" expected result + | Error error -> failwith (InputAndOutputWithHeaders.error_to_string error) + +let input_and_output_with_headers_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#InputAndOutputWithHeaders", + [ + ("InputAndOutputWithStringHeaders", `Quick, input_and_output_with_string_headers); + ("InputAndOutputWithNumericHeaders", `Quick, input_and_output_with_numeric_headers); + ("InputAndOutputWithBooleanHeaders", `Quick, input_and_output_with_boolean_headers); + ("InputAndOutputWithTimestampHeaders", `Quick, input_and_output_with_timestamp_headers); + ("InputAndOutputWithEnumHeaders", `Quick, input_and_output_with_enum_headers); + ("RestXmlSupportsNaNFloatHeaderInputs", `Quick, rest_xml_supports_na_n_float_header_inputs); + ( "RestXmlSupportsInfinityFloatHeaderInputs", + `Quick, + rest_xml_supports_infinity_float_header_inputs ); + ( "RestXmlSupportsNegativeInfinityFloatHeaderInputs", + `Quick, + rest_xml_supports_negative_infinity_float_header_inputs ); + ("InputAndOutputWithStringHeaders", `Quick, input_and_output_with_string_headers); + ("InputAndOutputWithNumericHeaders", `Quick, input_and_output_with_numeric_headers); + ("InputAndOutputWithBooleanHeaders", `Quick, input_and_output_with_boolean_headers); + ("InputAndOutputWithTimestampHeaders", `Quick, input_and_output_with_timestamp_headers); + ("InputAndOutputWithEnumHeaders", `Quick, input_and_output_with_enum_headers); + ("RestXmlSupportsNaNFloatHeaderOutputs", `Quick, rest_xml_supports_na_n_float_header_outputs); + ( "RestXmlSupportsInfinityFloatHeaderOutputs", + `Quick, + rest_xml_supports_infinity_float_header_outputs ); + ( "RestXmlSupportsNegativeInfinityFloatHeaderOutputs", + `Quick, + rest_xml_supports_negative_infinity_float_header_outputs ); + ] ) + +let nested_xml_map_request () = + Eio.Switch.run ~name:"NestedXmlMapRequest" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.nested_xml_maps_request = + { flat_nested_map = None; nested_map = Some [ ("foo", [ ("bar", BAR) ]) ] } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = NestedXmlMaps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + ")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/NestedXmlMaps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (NestedXmlMaps.error_to_string error) + +let flat_nested_xml_map_request () = + Eio.Switch.run ~name:"FlatNestedXmlMapRequest" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.nested_xml_maps_request = + { flat_nested_map = Some [ ("foo", [ ("bar", BAR) ]) ]; nested_map = None } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = NestedXmlMaps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ \n\ + ")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/NestedXmlMaps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (NestedXmlMaps.error_to_string error) + +let nested_xml_map_response () = + Eio.Switch.run ~name:"NestedXmlMapResponse" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = NestedXmlMaps.request ctx { flat_nested_map = None; nested_map = None } in + match response with + | Ok result -> + let expected = + ({ flat_nested_map = None; nested_map = Some [ ("foo", [ ("bar", BAR) ]) ] } + : Types.nested_xml_maps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_nested_xml_maps_response + Types.equal_nested_xml_maps_response) + "expected output" expected result + | Error error -> failwith (NestedXmlMaps.error_to_string error) + +let flat_nested_xml_map_response () = + Eio.Switch.run ~name:"FlatNestedXmlMapResponse" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = NestedXmlMaps.request ctx { flat_nested_map = None; nested_map = None } in + match response with + | Ok result -> + let expected = + ({ flat_nested_map = Some [ ("foo", [ ("bar", BAR) ]) ]; nested_map = None } + : Types.nested_xml_maps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_nested_xml_maps_response + Types.equal_nested_xml_maps_response) + "expected output" expected result + | Error error -> failwith (NestedXmlMaps.error_to_string error) + +let nested_xml_maps_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#NestedXmlMaps", + [ + ("NestedXmlMapRequest", `Quick, nested_xml_map_request); + ("FlatNestedXmlMapRequest", `Quick, flat_nested_xml_map_request); + ("NestedXmlMapResponse", `Quick, nested_xml_map_response); + ("FlatNestedXmlMapResponse", `Quick, flat_nested_xml_map_response); + ] ) + +let nested_xml_map_with_xml_name_serializes () = + Eio.Switch.run ~name:"NestedXmlMapWithXmlNameSerializes" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.nested_xml_map_with_xml_name_request = + { + nested_xml_map_with_xml_name_map = + Some + [ + ("foo", [ ("bar", "Baz"); ("fizz", "Buzz") ]); + ("qux", [ ("foobar", "Bar"); ("fizzbuzz", "Buzz") ]); + ]; + } + in + Mock.mock_response + ?body: + (Some + " \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Baz\n\ + \ \n\ + \ \n\ + \ fizz\n\ + \ Buzz\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ qux\n\ + \ \n\ + \ \n\ + \ foobar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ fizzbuzz\n\ + \ Buzz\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = NestedXmlMapWithXmlName.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + " \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Baz\n\ + \ \n\ + \ \n\ + \ fizz\n\ + \ Buzz\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ qux\n\ + \ \n\ + \ \n\ + \ foobar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ fizzbuzz\n\ + \ Buzz\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/NestedXmlMapWithXmlName") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (NestedXmlMapWithXmlName.error_to_string error) + +let nested_xml_map_with_xml_name_deserializes () = + Eio.Switch.run ~name:"NestedXmlMapWithXmlNameDeserializes" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + " \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ \n\ + \ bar\n\ + \ Baz\n\ + \ \n\ + \ \n\ + \ fizz\n\ + \ Buzz\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ qux\n\ + \ \n\ + \ \n\ + \ foobar\n\ + \ Bar\n\ + \ \n\ + \ \n\ + \ fizzbuzz\n\ + \ Buzz\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \ \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = NestedXmlMapWithXmlName.request ctx { nested_xml_map_with_xml_name_map = None } in + match response with + | Ok result -> + let expected = + ({ + nested_xml_map_with_xml_name_map = + Some + [ + ("foo", [ ("bar", "Baz"); ("fizz", "Buzz") ]); + ("qux", [ ("foobar", "Bar"); ("fizzbuzz", "Buzz") ]); + ]; + } + : Types.nested_xml_map_with_xml_name_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_nested_xml_map_with_xml_name_response + Types.equal_nested_xml_map_with_xml_name_response) + "expected output" expected result + | Error error -> failwith (NestedXmlMapWithXmlName.error_to_string error) + +let nested_xml_map_with_xml_name_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#NestedXmlMapWithXmlName", + [ + ("NestedXmlMapWithXmlNameSerializes", `Quick, nested_xml_map_with_xml_name_serializes); + ("NestedXmlMapWithXmlNameDeserializes", `Quick, nested_xml_map_with_xml_name_deserializes); + ] ) + +let no_input_and_no_output () = + Eio.Switch.run ~name:"NoInputAndNoOutput" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Smaws_Lib.Smithy_api.Types.unit_ = () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = NoInputAndNoOutput.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/NoInputAndNoOutput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (NoInputAndNoOutput.error_to_string error) + +let no_input_and_no_output () = + Eio.Switch.run ~name:"NoInputAndNoOutput" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[] (); + let response = NoInputAndNoOutput.request ctx () in + match response with + | Ok result -> + let expected = () in + check Alcotest.unit "expected output" expected result + | Error error -> failwith (NoInputAndNoOutput.error_to_string error) + +let no_input_and_no_output_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#NoInputAndNoOutput", + [ + ("NoInputAndNoOutput", `Quick, no_input_and_no_output); + ("NoInputAndNoOutput", `Quick, no_input_and_no_output); + ] ) + +let no_input_and_output () = + Eio.Switch.run ~name:"NoInputAndOutput" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Smaws_Lib.Smithy_api.Types.unit_ = () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = NoInputAndOutput.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/NoInputAndOutputOutput") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (NoInputAndOutput.error_to_string error) + +let no_input_and_output () = + Eio.Switch.run ~name:"NoInputAndOutput" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[] (); + let response = NoInputAndOutput.request ctx () in + match response with + | Ok result -> + let expected = (() : Types.no_input_and_output_output) in + check + (Alcotest_http.testable_nan_aware Types.pp_no_input_and_output_output + Types.equal_no_input_and_output_output) + "expected output" expected result + | Error error -> failwith (NoInputAndOutput.error_to_string error) + +let no_input_and_output_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#NoInputAndOutput", + [ + ("NoInputAndOutput", `Quick, no_input_and_output); + ("NoInputAndOutput", `Quick, no_input_and_output); + ] ) + +let null_and_empty_headers () = + Eio.Switch.run ~name:"NullAndEmptyHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.null_and_empty_headers_i_o = { c = Some []; b = Some ""; a = None } in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = NullAndEmptyHeadersClient.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/NullAndEmptyHeadersClient") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-C", ""); ("X-B", "") ] + request.headers + in + () + | Error error -> failwith (NullAndEmptyHeadersClient.error_to_string error) + +let null_and_empty_headers_client_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#NullAndEmptyHeadersClient", + [ ("NullAndEmptyHeaders", `Quick, null_and_empty_headers) ] ) + +let null_and_empty_headers () = + Eio.Switch.run ~name:"NullAndEmptyHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 ~headers:[ ("X-C", ""); ("X-B", "") ] (); + let response = NullAndEmptyHeadersServer.request ctx { c = None; b = None; a = None } in + match response with + | Ok result -> + let expected = ({ c = Some []; b = Some ""; a = None } : Types.null_and_empty_headers_i_o) in + check + (Alcotest_http.testable_nan_aware Types.pp_null_and_empty_headers_i_o + Types.equal_null_and_empty_headers_i_o) + "expected output" expected result + | Error error -> failwith (NullAndEmptyHeadersServer.error_to_string error) + +let null_and_empty_headers_server_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#NullAndEmptyHeadersServer", + [ ("NullAndEmptyHeaders", `Quick, null_and_empty_headers) ] ) + +let rest_xml_omits_null_query () = + Eio.Switch.run ~name:"RestXmlOmitsNullQuery" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.omits_null_serializes_empty_string_input = + { empty_string = None; null_value = None } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = OmitsNullSerializesEmptyString.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/OmitsNullSerializesEmptyString") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (OmitsNullSerializesEmptyString.error_to_string error) + +let rest_xml_serializes_empty_string () = + Eio.Switch.run ~name:"RestXmlSerializesEmptyString" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.omits_null_serializes_empty_string_input = + { empty_string = Some ""; null_value = None } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = OmitsNullSerializesEmptyString.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `GET request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/OmitsNullSerializesEmptyString") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (OmitsNullSerializesEmptyString.error_to_string error) + +let omits_null_serializes_empty_string_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#OmitsNullSerializesEmptyString", + [ + ("RestXmlOmitsNullQuery", `Quick, rest_xml_omits_null_query); + ("RestXmlSerializesEmptyString", `Quick, rest_xml_serializes_empty_string); + ] ) + +let sdk_applied_content_encoding_rest_xml () = + Eio.Switch.run ~name:"SDKAppliedContentEncoding_restXml" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.put_with_content_encoding_input = + { + data = + Some + "RjCEL3kBwqPivZUXGiyA5JCujtWgJAkKRlnTEsNYfBRGOS0f7LT6R3bCSOXeJ4auSHzQ4BEZZTklUyj5\n\ + 1HEojihShQC2jkQJrNdGOZNSW49yRO0XbnGmeczUHbZqZRelLFKW4xjru9uTuB8lFCtwoGgciFsgqTF8\n\ + 5HYcoqINTRxuAwGuRUMoNO473QT0BtCQoKUkAyVaypG0hBZdGNoJhunBfW0d3HWTYlzz9pXElyZhq3C1\n\ + 2PDB17GEoOYXmTxDecysmPOdo5z6T0HFhujfeJFIQQ8dirmXcG4F3v0bZdf6AZ3jsiVh6RnEXIPxPbOi\n\ + gIXDWTMUr4Pg3f2LdYCM01eAb2qTdgsEN0MUDhEIfn68I2tnWvcozyUFpg1ez6pyWP8ssWVfFrckREIM\n\ + Mb0cTUVqSVSM8bnFiF9SoXM6ZoGMKfX1mT708OYk7SqZ1JlCTkecDJDoR5ED2q2MWKUGR6jjnEV0GtD8\n\ + WJO6AcF0DptY9Hk16Bav3z6c5FeBvrGDrxTFVgRUk8SychzjrcqJ4qskwN8rL3zslC0oqobQRnLFOvwJ\n\ + prSzBIwdH2yAuxokXAdVRa1u9NGNRvfWJfKkwbbVz8yV76RUF9KNhAUmwyYDrLnxNj8ROl8B7dv8Gans\n\ + 7Bit52wcdiJyjBW1pAodB7zqqVwtBx5RaSpF7kEMXexYXp9N0J1jlXzdeg5Wgg4pO7TJNr2joiPVAiFf\n\ + efwMMCNBkYx2z7cRxVxCJZMXXzxSKMGgdTN24bJ5UgE0TxyV52RC0wGWG49S1x5jGrvmxKCIgYPs0w3Z\n\ + 0I3XcdB0WEj4x4xRztB9Cx2Mc4qFYQdzS9kOioAgNBti1rBySZ8lFZM2zqxvBsJTTJsmcKPr1crqiXjM\n\ + oVWdM4ObOO6QA7Pu4c1hT68CrTmbcecjFcxHkgsqdixnFtN6keMGL9Z2YMjZOjYYzbUEwLJqUVWalkIB\n\ + BkgBRqZpzxx5nB5t0qDH35KjsfKM5cinQaFoRq9y9Z82xdCoKZOsUbxZkk1kVmy1jPDCBhkhixkc5PKS\n\ + FoSKTbeK7kuCEZCtR9OfF2k2MqbygGFsFu2sgb1Zn2YdDbaRwRGeaLhswta09UNSMUo8aTixgoYVHxwy\n\ + vraLB6olPSPegeLOnmBeWyKmEfPdbpdGm4ev4vA2AUFuLIeFz0LkCSN0NgQMrr8ALEm1UNpJLReg1ZAX\n\ + zZh7gtQTZUaBVdMJokaJpLk6FPxSA6zkwB5TegSqhrFIsmvpY3VNWmTUq7H0iADdh3dRQ8Is97bTsbwu\n\ + vAEOjh4FQ9wPSFzEtcSJeYQft5GfWYPisDImjjvHVFshFFkNy2nN18pJmhVPoJc456tgbdfEIdGhIADC\n\ + 6UPcSSzE1FxlPpILqZrp3i4NvvKoiOa4a8tnALd2XRHHmsvALn2Wmfu07b86gZlu4yOyuUFNoWI6tFvd\n\ + bHnqSJYNQlFESv13gJw609DBzNnrIgBGYBAcDRrIGAnflRKwVDUnDFrUQmE8xNG6jRlyb1p2Y2RrfBtG\n\ + cKqhuGNiT2DfxpY89ektZ98waPhJrFEPJToNH8EADzBorh3T0h4YP1IeLmaI7SOxeuVrk1kjRqMK0rUB\n\ + lUJgJNtCE35jCyoHMwPQlyi78ZaVv8COVQ24zcGpw0MTy6JUsDzAC3jLNY6xCb40SZV9XzG7nWvXA5Ej\n\ + YC1gTXxF4AtFexIdDZ4RJbtYMyXt8LsEJerwwpkfqvDwsiFuqYC6vIn9RoZO5kI0F35XtUITDQYKZ4eq\n\ + WBV0itxTyyR5Rp6g30pZEmEqOusDaIh96CEmHpOBYAQZ7u1QTfzRdysIGMpzbx5gj9Dxm2PO1glWzY7P\n\ + lVqQiBlXSGDOkBkrB6SkiAxknt9zsPdTTsf3r3nid4hdiPrZmGWNgjOO1khSxZSzBdltrCESNnQmlnP5\n\ + ZOHA0eSYXwy8j4od5ZmjA3IpFOEPW2MutMbxIbJpg5dIx2x7WxespftenRLgl3CxcpPDcnb9w8LCHBg7\n\ + SEjrEer6Y8wVLFWsQiv6nTdCPZz9cGqwgtCaiHRy8lTWFgdfWd397vw9rduGld3uUFeFRGjYrphqEmHi\n\ + hiG0GhE6wRFVUsGJtvOCYkVREvbEdxPFeJvlAvOcs9HKbtptlTusvYB86vR2bNcIY4f5JZu2X6sGa354\n\ + 7LRk0ps2zqYjat3hMR7XDC8KiKceBteFsXoDjfVxTYKelpedTxqWAafrKhaoAVuNM98PSnkuIWGzjSUC\n\ + NsDJTt6vt1D1afBVPWVmnQ7ZQdtEtLIEwAWYjemAztreELIr1E9fPEILm1Ke4KctP9I0I72Dh4eylNZD\n\ + 0DEr2Hg7cWFckuZ0Av5d0IPRARXikEGDHl8uh12TXL9v2Uh0ZVSJMEYvxGSbZvkWz8TjWSk3hKA2a7GL\n\ + Jm3Ho7e1C34gE1XRGcEthxvURxt4OKBqN3ZNaMIuDTWinoQAutMcUqtm4MoL7RGPiCHUrvTwQPSirsmA\n\ + QmOEu8nOpnP77Fivh9jLGx5ta7nL6jrsWUsBqiN1lzpdPYLRR4mUIAj6sNWiDEk4pkbHSMEcqbWw6Zl7\n\ + psEyPDHalCNhWMA3RSK3skURzQDZ0oBV5W7vjVIZ4d3uCKsk6zrzEI9u5mx7p9RdNKodXfzqYt0ULdtc\n\ + 3RW0hIfw2KvrO3BD2QrtgAkfrFBGVvlJSUoh0MvLz8DeXxfuiuq9Ttu7wvsqVI4Piah6WNEXtHHGPJO3\n\ + Ghc75Bnv2To4VS2v8rmyKAPIIVTuYBHZN6sZ4FhFzbrslCIdk0eadaU60naqiNWU3CsxplIYGyeThmJ7\n\ + 9u4h6Y2OmiPZjFPS2bAzwgAozYTVefII9aEaWZ0hxHZeu1FW7r79dkdO73ZqRfas9u8Z7LLBPCw5pV0F\n\ + 5I0pHDgNb6MogoxF4NZJfVtIX1vCHhhVLrXjrYNJU2fD9Fw8kT8Ie2HDBJnqAvYKmryQ1r9ulo3Me3rH\n\ + q9s2Y5uCDxu9iQNhnpwIm57WYGFeqd2fnQeY2IziD3Jgx0KSrmOH0jgi0RwJyfGXaORPq3bQQqljuACo\n\ + kO6io9t5VI8PbNxSHTRbtYiPciUslbT0g7SpCLrRPOBRJ4DDk56pjghpeoUagJ5xJ4wjBzBuXnAGkNnP\n\ + Tfpiuz2r3oSBAi8sB9wiYK2z9sp4gZyQsqdVNzAEgKatOxBRBmJCBYpjO98ZQrF83XApPpfFg0ujB2PW\n\ + 1iYF9NkgwIKB5oB6KVTOmSKJk11mVermPgeugHbzdd2zUP6fP8fWbhseqk2t8ahGvqjs2CDHFIWXl5jc\n\ + fCknbykE3ANt7lnAfJQ2ddduLGiqrX4HWx6jcWw08Es6BkleO0IDbaWrb95d5isvFlzJsf0TyDIXF4uq\n\ + bBDCi0XPWqtRJ2iqmnJa2GbBe9GmAOWMkBFSilMyC4sR395WSDpD56fx0NGoU6cHrRu9xF2Bgh7RGSfl\n\ + ch2GXEeE02fDpSHFNvJBlOEqqfkIX6oCa6KY9NThqeIjYsT184XR2ZI7akXRaw1gMOGpk4FmUxk6WIuX\n\ + 4ei1SLQgSdl7OEdRtJklZ76eFrMbkJQ2TDhu8f7mVuiy53GUMIvCrP9xYGZGmCIDm2e4U2BDi3F7C5xK\n\ + 3bDZXwlQp6z4BSqTy2OVEWxXUJfjPMOL5Mc7AvDeKtxAS73pVIv0HgHIa4NBAdC7uLG0zXuu1FF6z2XY\n\ + yUhk03fMZhYe7vVxsul3WE7U01fuN8z2y0eKwBW1RFBE1eKIaR9Y01sIWQWbSrfHfDrdZiElhmhHehfs\n\ + 0EfrR4sLYdQshJuvhTeKGJDaEhtPQwwJ9mUYGtuCL9RozWx1XI4bHNlzBTW0BVokYiJGlPe7wdxNzJD7\n\ + JgS7Lwv6jGKngVf86imGZyzqwiteWFPdNUoWdTvUPSMO5xIUK9mo5QpwbBOAmyYzVq42o3Qs90N9khEV\n\ + U36LB99fw8PtGHH5wsCHshfauwnNPj0blGXzke0kQ4JNCVH7Jtn0Y0aeejkSxFtwtxoYs6zHl1Lxxpsd\n\ + sw5vBy49CEtoltDW367lVAwDjWdx20msGB7qJCkEDrzu7EXSO22782QX9NBRcN9ppX0C25I0FMA4Wnhz\n\ + 9zIpiXRrsTH35jzM8Cjt4EVLGNU3O0HuEvAer3cENnMJtngdrT86ox3fihMQbiuy4Bh4DEcP5in2VjbT\n\ + 3qbnoCNvOi8Fmmf7KlGlWAOceL5OHVE5lljjQEMzEQOCEgrk5mDKgwSBJQBNauIDSC1a5iEQjB8Xxp4C\n\ + qeKyyWY9IOntNrtU5ny4lNprHJd36dKFeBLKcGCOvgHBXdOZloMF0YTRExw7hreEO9IoTGVHJ4teWsNr\n\ + HdtagUHjkeZkdMMfnUGNv5aBNtFMqhcZH6EitEa9lGPkKBbJpoom3u8D8EHSIF1H5EZqqx9TLY5hWAIG\n\ + PwJ4qwkpCGw5rCLVrjw7ARKukIFzNULANqjHUMcJ002TlUosJM4xJ4aAgckpLVGOGuPDhGAAexEcQmbg\n\ + UsZdmqQrtuVUyyLteLbLbqtR6CTlcAIwY3xyMCmPgyefE0FEUODBoxQtRUuYTL9RC5o1sYb2PvcxUQfb\n\ + iJFi2CAl99pAzcckU2qVCxniARslIxM5pmMRGsQX9ZzYAfZrbg6ce6S74I8UMlgRQ2QVyvUjKKOE6IrJ\n\ + Lng370emHfe5m6LZULD5YiZutkD5ipjL2Bz77DvTE5kNPUhuoKBcTJcUgytfXAKUTWOcRKNlq0GImrxM\n\ + Jfr7AWbLFFNKGLeTrVDBwpcokJCv0zcOKWe8fd2xkeXkZTdmM66IgM27cyYmtQ6YF26Kd0qrWJeVZJV9\n\ + 3fyLYYvKN5csbRY2BHoYE5ERARRW65IrpkXMf48OrCXMtDIP0Z7wxI9DiTeKKeH4uuguhCJnwzR3WxLA\n\ + VU6eBJEd7ZjS6JA83w7decq8uDI7LGKjcz1FySp3B7fE9DkHRGXxbsL7Fjar6vW2mAv8CuvI20B6jctp\n\ + 2yLDs24sPfB3sSxrrlhbuT1m6DZqiN0dl6umKx7NGZhmOTVGr20jfcxhqPQwTJfd7kel4rvxip4BqkvT\n\ + 7STy8knJ2BXGyJeNgwo1PXUZRDVy0LCTsSF1RFuRZe8cktHl9lgw8ntdPn1pVFL0MwJkJfdXBNUp5gNv\n\ + 50FTkrpo1t6wq4CVbcfj2XOrOzvBUzNH26sXGABI1gGxCdp2jEZrHgqQaWIaTJVTuguZhxqDvdYsrwFW\n\ + YN58uuNcKHIrGdRSigyZInwQDYk0pjcqdSeU0WVU3Y9htzZBR7XRaCJr5YTZvq7fwermb5tuwb37lPLq\n\ + B2IGg0iftkVbXaSyfCwVaRbfLBb88so0QqpmJGirFu8FcDiXOV1zTr8yW9XLdYQuUjh43xrXLdgsuYff\n\ + CagInUk1eU1aLjVZoJRsNmStmOEpAqlYMwTvx7w6j2f421Cxr5cNZBIVlAxlXN2QiDqJ9v3sHhHkTanc\n\ + lQuH8ptUyX8qncpBuXXBn7cSez9N0EoxCBl1GHUagbjstgJo4gzLvTmVIY6MiWYOBitzNUHfyqKwtKUr\n\ + VoSCdZcGeA9lHUPA7PUprRRaT3m1hGKPyshtVS2ikG48w3oVerln1N1qGdtz46gZCrndw3LZ1B362RfW\n\ + zDPuXbpsyLsRMTt1Rz1oKHRXp3iE41hkhQH6pxlvyCW2INnHt5XU8zRamOB3oW0udOhMpQFDjRkOcy06\n\ + b4t0QTHvoRqmBna3WXzIMZyeK3GChF5eF8oDXRbjhk7BB6YKCgqwWUzEJ5K47HMSlhFkBUjaPRjdGM0z\n\ + zOMwhW6b1NvSwP7XM1P5yi1oPvOspts1vr29SXqrMMrBhVogeodWyd69NqrO4jkyBxKmlXifoTowpfiY\n\ + 2cUCE0XMZqxUN39LCP09JqZifaEcBEo3mgtm1tWu5QR2GNq7UyQf4RIPSDOpDCAtwoPhRgdT1lJdcj4U\n\ + lnH0wrJ8Uwu7c08L7ErnIrDATqCrOjpSbzGP1xHENABYONC4TknFPrJ8pe40A8fzGT0qBw9mAM1SKcHO\n\ + foiLcMC9AjHTqJzDG3xplSLPG9or2rMeq7Fzp9r0y7uJRMxgg51EbjfvYlH466A3ggvL2WQlDXjJqPW3\n\ + BJGWAWDNN9LK8f46bADKPxakpkx23S9O47rGSXfDhVSIZsDympxWX1UOzWwMZRHkofVeKqizgbKkGgUT\n\ + WykE9gRoRAOd9wfHZDYKa9i0LaPDiaUMvnU1gdBIqIoiVsdJ9swX47oxvMtOxtcS0zlD6llDkBuIiU5g\n\ + PwRCYmtkkb25c8iRJXwGFPjI1wJ34I1z1ENicPdosPiUe9ZC2jnXIKzEdv01x2ER7DNDF3yxOwOhxNxI\n\ + GqsmC92j25UQQFu9ZstOZ28AoCkuOYs0Uycm5u8jR1T39dMBwrko09rC65ENLnsxM8oebmyFCPiGJ1ED\n\ + 5Xqc9qZ237f1OnETAoEOwqUSvrdPTv56U7hV91EMTyC812MLQpr2710E3VVpsUCUMNhIxdt7UXZ1UNFb\n\ + jgzpZLXnf4DHrv6B7kq6UI50KMxcw1HZE2GpODfUTzNFLaqdrvzxKe5eUWdcojBaRbD4fFdVYJTElYDH\n\ + NNVh6ofkoeWcs9CWGFmSBe0T4K8phFeygQg0prKMELNEy6qENzVtG9ZDcqj3a7L6ZLtvq50anWp7fAVu\n\ + fwz55g4iM2Z2fA0pnwHDL7tt67zTxGITvsnJsZSpeq1EQsZcwtkBV9liu7Rl7jiVT1IIRtchB8TsTiaA\n\ + wVHIQQ9RIOTiPQdKNqi1kC9iGlUqWK93gblNWlBw1eYB9Wk8FQogutwTf0caNMx8D4nPbANcmOOlskIy\n\ + zALh15OlTrWnhP95rf08AN2J026zDE2DUF9k0eCevYBQIDjqKNW4XCZnjbHoIcKzbY5VzPbMs3ZyMz8K\n\ + SucBmgPg6wrSK5ykbkapS5vuqvXc9GbjQJ8bPNzoxoWGyjbZvDs2OBrIqBmcQb2DLJ8v38McQ4mC4UsS\n\ + jf4PyfSCtpk274QZjvLCZbLiCBxQegk7jUU0NmTFJAcYCxd9xMWdlFkiszcltT2YzwuFFz7iA6aa4n5L\n\ + HpBNfUA01GcAi1aCMYhmooS4zSlYcSOZkovMz36U3Fd9WtqIEOJLi7HMgHQDgNMdK6DTzAdHQtxerxVF\n\ + HJnPrfNVG7270r3bp0bPnLNYLhObbAn6zqSAUeLtI2Y4KJDjBKCAh2vvYGbu0e2REYJWRj7MkGevsSSy\n\ + b1kCXLt6tKGWAb7lt5c0xyJgUIJW7pdtnwgT0ZCa24BecCAwNnG5U2EwQbcjZGsFxqNGfaemd3oFEhES\n\ + BaE0Fxms9UKTnMafu8wvZ2xymMrUduuRzOjDeX7oD5YsLC88V8CGMLxbbxIpt94KGykbr6e7L0R4oZl1\n\ + tKMgFwQ2p9Txdbp0Y293LcsJymKizqI0F2xEp7y4SmWOJqHZtsbz80wVV9nv41CvtfxuSoGZJ5cNB7pI\n\ + BgzNcQCeH3Jt0RaGGwboxxpuFbzilmkMFXxJm87tD4WNgu01nHfGCKeQcySEBZpVfJgi6sDFJ8uWnvKm\n\ + 9mPLHurtWzEfKqUEa1iC71bXjw5wrvhv9BYW8JSUELHmDquftQyKdq0DZXhULMHGQLf4e95WIaoA14LL\n\ + bThz77kuhKULPTu2MNrBUKGorurhGugo5gs4ZUezSsUOe3KxYdrFMdGgny1GgTxMSMTp2RAZytKjv4kQ\n\ + Vx7XgzvpQLIbDjUPAkJv6lScwIRq1W3Ne0Rh0V6Bmn6U5uIuWnJjULmbaQiSODj3z0mAZvak0mSWIGwT\n\ + TX83HztcC4W7e1f6a1thmcc5K61Icehla2hBELWPpixTkyC4eEVmk9Rq0m0ZXtx0JX2ZQXqXDEyePyMe\n\ + J70sdSzXk72zusqhY4yuOMGgbYNHqxOToK6NxujR7e4dV3Wk5JnSUthym8scjcPeCiKDNY4cHfTMnDXJ\n\ + 9zLVy01LtNKYpJ1s8FxVxigmxQNKEbIamxhx6yqwGC4aiISVOOUEjvNOdaUfXfUsE6jEwtwxyGxjlRK1\n\ + cLyxXttq4QWN6PehgHv7jXykzPjInbEysebFvvPOOMdunmJvcCNMSvjUda8fL6xfGo0FDrLg8XZipd6S\n\ + oPVdYtyIM1Dg40KbBA3JuumPYtXuJaHrZnjZmdnM5OVo4ZNxktfCVT0c6bnD4bAeyn4bYt1ZPaX6hQHh\n\ + JtvNYfpD0ONYlmqKuToQAMlz52Fh6bj45EbX89L5eLlSpWeyBlGotzriB0EPlclrGi5l2B5oPb1aB1ag\n\ + yyYuu44l0F1oOVYnBIZsxIsHVITxi9lEuVPFkWASOUNuVQXfM4n5hxWR9qtuKnIcPsvbJsv1U10XlKh3\n\ + KisqPhHU15xrCLr5gwFxPUKiNTLUBrkzgBOHXPVsHcLCiSD0YU56TRGfvEom43TWUKPPfl9Z54tgVQuT\n\ + jCRlaljAzeniQIcbbHZnn3f0HxbDG3DFYqWSxNrXabHhRsIOhhUHSPENyhGSTVO5t0XX5CdMspJPCd02\n\ + 3Oqv32ccbUK4O3YH6LEvp0WO3kSl5n50odVkI9B0i0iq4UPFGMkM8bEQJbgJoOH71P10vtdevJFQE4g2\n\ + yhimiM53ZJRWgSZveHtENZc0Gjo0F9eioak9BnPpY1QxAFPC817svuhEstcU69bLCA4D1rO5R8AuIIBq\n\ + yQJcifFLvbpAEYTLKJqysZrU8EEl3TSdC13A9hZvk4NC8VGEDAxcNrKw313dZp17kZPO5HSd1y6sljAW\n\ + A9M1d6FMYV5SlBWf3WZNCUPS7qKNlda2YBsC6IUVB363f5RLGQOQHwbaijBSRCkrVoRxBHtc0Bd5J9V9\n\ + P5uMTXkpZOxRcCQvImGgcmGuxxLb5zTqfS2xu7v3Sf3IIesSt9tVzcEcdbEvLGVJkLk4mb3G30DbIbri\n\ + PZ09JkweDvMaQ3bxT2nfkz3Ilihkw9jqikkCCCz7E8h6z6KbhQErEW9VzJZzMCgJsyPjFam6iNwpe07S\n\ + hyOvNVw2t9wpzL5xM11DvVzQwDaWEytNRHzDBs4KwEtpI2IpjUyVZHSwA0UGqqkzoCgrJFlNOvPlXqcS\n\ + IcREouUIBmuttkrhPWJtSxOOgpsdvBR3kTOzAXNzSKxoaBAb0c5SDMUc6FIyGA8x5wg5DkUgjFUUodEt\n\ + OYaB2VHVePW9mxHeBTdKWLzJow4ZZvjnoBuVigXljKCNh137ckV2y3Yg3Xi4UzJEI2V5Rw9AfnMs7xUw\n\ + VHOFCg189maD3bmZAe7b4eaGZhyy4HVKjqCXmIH7vsEjRvbnfB0SQxxpuqBDJbHNCtW4vM643ZQQBVPP\n\ + a7oXSQIq9w2dHp0A7dtkocCZdQp9FKR9XdJAFIbVSHzIF1ZogeZlc0pXuNE0tagvD57xwDRFkAuoQyMu\n\ + YDdZasXrpSmEE5UjHVkyYsISn8QsfXurzDybX468aoRoks654jjmRY5zi1oB8TcMdC2c3sicNaqfeuhd\n\ + H1nPX7l4RpdqWMR7gGx9slXtG8S3KxpOi4qCD7yg3saD66nun4dzksQURoTUdXyrJR5UpHsfIlTF1aJa\n\ + MdXyQtQnrkl00TeghQd00rRFZsCnhi0qrCSKiBfB2EVrd9RPpbgwJGZHuIQecdBmNetc2ylSEClqVBPR\n\ + GOPPIxrnswEZjmnS0jxKW9VSM1QVxSPJnPFswCqT95SoKD6CP4xdX28WIUGiNaIKodXXJHEIsXBCxLsr\n\ + PwWPCtoplC6hhpKmW5dQo92iCTyY2KioKzO8XR6FKm6qonMKVEwQNtlYE9c97KMtEnp25VOdMP46SQXS\n\ + YsSVp7vm8LP87VYI8SOKcW3s2oedYFtt45rvDzoTF0GmS6wELQ9uo98HhjQAI1Dt91cgjJOwygNmLoZE\n\ + X5K2zQiNA163uMCl5xzaBqY4YTL0wgALg3IFdYSp0RFYLWdt6IxoGI1tnoxcjlUEPo5eGIc3mS3SmaLn\n\ + OdumfUQQ4Jgmgaa5anUVQsfBDrlAN5oaX7O0JO71SSPSWiHBsT9WIPy2J1Cace9ZZLRxblFPSXcvsuHh\n\ + hvnhWQltEDAe7MgvkFQ8lGVFa8jhzijoF9kLmMhMILSzYnfXnZPNP7TlAAwlLHK1RqlpHskJqb6CPpGP\n\ + QvOAhEMsM3zJ2KejZx0esxkjxA0ZufVvGAMN3vTUMplQaF4RiQkp9fzBXf3CMk01dWjOMMIEXTeKzIQe\n\ + EcffzjixWU9FpAyGp2rVl4ETRgqljOGw4UgK31r0ZIEGnH0xGz1FtbW1OcQM008JVujRqulCucEMmntr\n"; + encoding = None; + } + in + Mock.mock_response ?body:None ~status:200 ~headers:[ ("Content-Type", "application/json") ] (); + let response = PutWithContentEncoding.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = () in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/requestcompression/putcontentwithencoding") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Encoding", "gzip") ] + request.headers + in + () + | Error error -> failwith (PutWithContentEncoding.error_to_string error) + +let sdk_appended_gzip_after_provided_encoding_rest_xml () = + Eio.Switch.run ~name:"SDKAppendedGzipAfterProvidedEncoding_restXml" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.put_with_content_encoding_input = + { + data = + Some + "RjCEL3kBwqPivZUXGiyA5JCujtWgJAkKRlnTEsNYfBRGOS0f7LT6R3bCSOXeJ4auSHzQ4BEZZTklUyj5\n\ + 1HEojihShQC2jkQJrNdGOZNSW49yRO0XbnGmeczUHbZqZRelLFKW4xjru9uTuB8lFCtwoGgciFsgqTF8\n\ + 5HYcoqINTRxuAwGuRUMoNO473QT0BtCQoKUkAyVaypG0hBZdGNoJhunBfW0d3HWTYlzz9pXElyZhq3C1\n\ + 2PDB17GEoOYXmTxDecysmPOdo5z6T0HFhujfeJFIQQ8dirmXcG4F3v0bZdf6AZ3jsiVh6RnEXIPxPbOi\n\ + gIXDWTMUr4Pg3f2LdYCM01eAb2qTdgsEN0MUDhEIfn68I2tnWvcozyUFpg1ez6pyWP8ssWVfFrckREIM\n\ + Mb0cTUVqSVSM8bnFiF9SoXM6ZoGMKfX1mT708OYk7SqZ1JlCTkecDJDoR5ED2q2MWKUGR6jjnEV0GtD8\n\ + WJO6AcF0DptY9Hk16Bav3z6c5FeBvrGDrxTFVgRUk8SychzjrcqJ4qskwN8rL3zslC0oqobQRnLFOvwJ\n\ + prSzBIwdH2yAuxokXAdVRa1u9NGNRvfWJfKkwbbVz8yV76RUF9KNhAUmwyYDrLnxNj8ROl8B7dv8Gans\n\ + 7Bit52wcdiJyjBW1pAodB7zqqVwtBx5RaSpF7kEMXexYXp9N0J1jlXzdeg5Wgg4pO7TJNr2joiPVAiFf\n\ + efwMMCNBkYx2z7cRxVxCJZMXXzxSKMGgdTN24bJ5UgE0TxyV52RC0wGWG49S1x5jGrvmxKCIgYPs0w3Z\n\ + 0I3XcdB0WEj4x4xRztB9Cx2Mc4qFYQdzS9kOioAgNBti1rBySZ8lFZM2zqxvBsJTTJsmcKPr1crqiXjM\n\ + oVWdM4ObOO6QA7Pu4c1hT68CrTmbcecjFcxHkgsqdixnFtN6keMGL9Z2YMjZOjYYzbUEwLJqUVWalkIB\n\ + BkgBRqZpzxx5nB5t0qDH35KjsfKM5cinQaFoRq9y9Z82xdCoKZOsUbxZkk1kVmy1jPDCBhkhixkc5PKS\n\ + FoSKTbeK7kuCEZCtR9OfF2k2MqbygGFsFu2sgb1Zn2YdDbaRwRGeaLhswta09UNSMUo8aTixgoYVHxwy\n\ + vraLB6olPSPegeLOnmBeWyKmEfPdbpdGm4ev4vA2AUFuLIeFz0LkCSN0NgQMrr8ALEm1UNpJLReg1ZAX\n\ + zZh7gtQTZUaBVdMJokaJpLk6FPxSA6zkwB5TegSqhrFIsmvpY3VNWmTUq7H0iADdh3dRQ8Is97bTsbwu\n\ + vAEOjh4FQ9wPSFzEtcSJeYQft5GfWYPisDImjjvHVFshFFkNy2nN18pJmhVPoJc456tgbdfEIdGhIADC\n\ + 6UPcSSzE1FxlPpILqZrp3i4NvvKoiOa4a8tnALd2XRHHmsvALn2Wmfu07b86gZlu4yOyuUFNoWI6tFvd\n\ + bHnqSJYNQlFESv13gJw609DBzNnrIgBGYBAcDRrIGAnflRKwVDUnDFrUQmE8xNG6jRlyb1p2Y2RrfBtG\n\ + cKqhuGNiT2DfxpY89ektZ98waPhJrFEPJToNH8EADzBorh3T0h4YP1IeLmaI7SOxeuVrk1kjRqMK0rUB\n\ + lUJgJNtCE35jCyoHMwPQlyi78ZaVv8COVQ24zcGpw0MTy6JUsDzAC3jLNY6xCb40SZV9XzG7nWvXA5Ej\n\ + YC1gTXxF4AtFexIdDZ4RJbtYMyXt8LsEJerwwpkfqvDwsiFuqYC6vIn9RoZO5kI0F35XtUITDQYKZ4eq\n\ + WBV0itxTyyR5Rp6g30pZEmEqOusDaIh96CEmHpOBYAQZ7u1QTfzRdysIGMpzbx5gj9Dxm2PO1glWzY7P\n\ + lVqQiBlXSGDOkBkrB6SkiAxknt9zsPdTTsf3r3nid4hdiPrZmGWNgjOO1khSxZSzBdltrCESNnQmlnP5\n\ + ZOHA0eSYXwy8j4od5ZmjA3IpFOEPW2MutMbxIbJpg5dIx2x7WxespftenRLgl3CxcpPDcnb9w8LCHBg7\n\ + SEjrEer6Y8wVLFWsQiv6nTdCPZz9cGqwgtCaiHRy8lTWFgdfWd397vw9rduGld3uUFeFRGjYrphqEmHi\n\ + hiG0GhE6wRFVUsGJtvOCYkVREvbEdxPFeJvlAvOcs9HKbtptlTusvYB86vR2bNcIY4f5JZu2X6sGa354\n\ + 7LRk0ps2zqYjat3hMR7XDC8KiKceBteFsXoDjfVxTYKelpedTxqWAafrKhaoAVuNM98PSnkuIWGzjSUC\n\ + NsDJTt6vt1D1afBVPWVmnQ7ZQdtEtLIEwAWYjemAztreELIr1E9fPEILm1Ke4KctP9I0I72Dh4eylNZD\n\ + 0DEr2Hg7cWFckuZ0Av5d0IPRARXikEGDHl8uh12TXL9v2Uh0ZVSJMEYvxGSbZvkWz8TjWSk3hKA2a7GL\n\ + Jm3Ho7e1C34gE1XRGcEthxvURxt4OKBqN3ZNaMIuDTWinoQAutMcUqtm4MoL7RGPiCHUrvTwQPSirsmA\n\ + QmOEu8nOpnP77Fivh9jLGx5ta7nL6jrsWUsBqiN1lzpdPYLRR4mUIAj6sNWiDEk4pkbHSMEcqbWw6Zl7\n\ + psEyPDHalCNhWMA3RSK3skURzQDZ0oBV5W7vjVIZ4d3uCKsk6zrzEI9u5mx7p9RdNKodXfzqYt0ULdtc\n\ + 3RW0hIfw2KvrO3BD2QrtgAkfrFBGVvlJSUoh0MvLz8DeXxfuiuq9Ttu7wvsqVI4Piah6WNEXtHHGPJO3\n\ + Ghc75Bnv2To4VS2v8rmyKAPIIVTuYBHZN6sZ4FhFzbrslCIdk0eadaU60naqiNWU3CsxplIYGyeThmJ7\n\ + 9u4h6Y2OmiPZjFPS2bAzwgAozYTVefII9aEaWZ0hxHZeu1FW7r79dkdO73ZqRfas9u8Z7LLBPCw5pV0F\n\ + 5I0pHDgNb6MogoxF4NZJfVtIX1vCHhhVLrXjrYNJU2fD9Fw8kT8Ie2HDBJnqAvYKmryQ1r9ulo3Me3rH\n\ + q9s2Y5uCDxu9iQNhnpwIm57WYGFeqd2fnQeY2IziD3Jgx0KSrmOH0jgi0RwJyfGXaORPq3bQQqljuACo\n\ + kO6io9t5VI8PbNxSHTRbtYiPciUslbT0g7SpCLrRPOBRJ4DDk56pjghpeoUagJ5xJ4wjBzBuXnAGkNnP\n\ + Tfpiuz2r3oSBAi8sB9wiYK2z9sp4gZyQsqdVNzAEgKatOxBRBmJCBYpjO98ZQrF83XApPpfFg0ujB2PW\n\ + 1iYF9NkgwIKB5oB6KVTOmSKJk11mVermPgeugHbzdd2zUP6fP8fWbhseqk2t8ahGvqjs2CDHFIWXl5jc\n\ + fCknbykE3ANt7lnAfJQ2ddduLGiqrX4HWx6jcWw08Es6BkleO0IDbaWrb95d5isvFlzJsf0TyDIXF4uq\n\ + bBDCi0XPWqtRJ2iqmnJa2GbBe9GmAOWMkBFSilMyC4sR395WSDpD56fx0NGoU6cHrRu9xF2Bgh7RGSfl\n\ + ch2GXEeE02fDpSHFNvJBlOEqqfkIX6oCa6KY9NThqeIjYsT184XR2ZI7akXRaw1gMOGpk4FmUxk6WIuX\n\ + 4ei1SLQgSdl7OEdRtJklZ76eFrMbkJQ2TDhu8f7mVuiy53GUMIvCrP9xYGZGmCIDm2e4U2BDi3F7C5xK\n\ + 3bDZXwlQp6z4BSqTy2OVEWxXUJfjPMOL5Mc7AvDeKtxAS73pVIv0HgHIa4NBAdC7uLG0zXuu1FF6z2XY\n\ + yUhk03fMZhYe7vVxsul3WE7U01fuN8z2y0eKwBW1RFBE1eKIaR9Y01sIWQWbSrfHfDrdZiElhmhHehfs\n\ + 0EfrR4sLYdQshJuvhTeKGJDaEhtPQwwJ9mUYGtuCL9RozWx1XI4bHNlzBTW0BVokYiJGlPe7wdxNzJD7\n\ + JgS7Lwv6jGKngVf86imGZyzqwiteWFPdNUoWdTvUPSMO5xIUK9mo5QpwbBOAmyYzVq42o3Qs90N9khEV\n\ + U36LB99fw8PtGHH5wsCHshfauwnNPj0blGXzke0kQ4JNCVH7Jtn0Y0aeejkSxFtwtxoYs6zHl1Lxxpsd\n\ + sw5vBy49CEtoltDW367lVAwDjWdx20msGB7qJCkEDrzu7EXSO22782QX9NBRcN9ppX0C25I0FMA4Wnhz\n\ + 9zIpiXRrsTH35jzM8Cjt4EVLGNU3O0HuEvAer3cENnMJtngdrT86ox3fihMQbiuy4Bh4DEcP5in2VjbT\n\ + 3qbnoCNvOi8Fmmf7KlGlWAOceL5OHVE5lljjQEMzEQOCEgrk5mDKgwSBJQBNauIDSC1a5iEQjB8Xxp4C\n\ + qeKyyWY9IOntNrtU5ny4lNprHJd36dKFeBLKcGCOvgHBXdOZloMF0YTRExw7hreEO9IoTGVHJ4teWsNr\n\ + HdtagUHjkeZkdMMfnUGNv5aBNtFMqhcZH6EitEa9lGPkKBbJpoom3u8D8EHSIF1H5EZqqx9TLY5hWAIG\n\ + PwJ4qwkpCGw5rCLVrjw7ARKukIFzNULANqjHUMcJ002TlUosJM4xJ4aAgckpLVGOGuPDhGAAexEcQmbg\n\ + UsZdmqQrtuVUyyLteLbLbqtR6CTlcAIwY3xyMCmPgyefE0FEUODBoxQtRUuYTL9RC5o1sYb2PvcxUQfb\n\ + iJFi2CAl99pAzcckU2qVCxniARslIxM5pmMRGsQX9ZzYAfZrbg6ce6S74I8UMlgRQ2QVyvUjKKOE6IrJ\n\ + Lng370emHfe5m6LZULD5YiZutkD5ipjL2Bz77DvTE5kNPUhuoKBcTJcUgytfXAKUTWOcRKNlq0GImrxM\n\ + Jfr7AWbLFFNKGLeTrVDBwpcokJCv0zcOKWe8fd2xkeXkZTdmM66IgM27cyYmtQ6YF26Kd0qrWJeVZJV9\n\ + 3fyLYYvKN5csbRY2BHoYE5ERARRW65IrpkXMf48OrCXMtDIP0Z7wxI9DiTeKKeH4uuguhCJnwzR3WxLA\n\ + VU6eBJEd7ZjS6JA83w7decq8uDI7LGKjcz1FySp3B7fE9DkHRGXxbsL7Fjar6vW2mAv8CuvI20B6jctp\n\ + 2yLDs24sPfB3sSxrrlhbuT1m6DZqiN0dl6umKx7NGZhmOTVGr20jfcxhqPQwTJfd7kel4rvxip4BqkvT\n\ + 7STy8knJ2BXGyJeNgwo1PXUZRDVy0LCTsSF1RFuRZe8cktHl9lgw8ntdPn1pVFL0MwJkJfdXBNUp5gNv\n\ + 50FTkrpo1t6wq4CVbcfj2XOrOzvBUzNH26sXGABI1gGxCdp2jEZrHgqQaWIaTJVTuguZhxqDvdYsrwFW\n\ + YN58uuNcKHIrGdRSigyZInwQDYk0pjcqdSeU0WVU3Y9htzZBR7XRaCJr5YTZvq7fwermb5tuwb37lPLq\n\ + B2IGg0iftkVbXaSyfCwVaRbfLBb88so0QqpmJGirFu8FcDiXOV1zTr8yW9XLdYQuUjh43xrXLdgsuYff\n\ + CagInUk1eU1aLjVZoJRsNmStmOEpAqlYMwTvx7w6j2f421Cxr5cNZBIVlAxlXN2QiDqJ9v3sHhHkTanc\n\ + lQuH8ptUyX8qncpBuXXBn7cSez9N0EoxCBl1GHUagbjstgJo4gzLvTmVIY6MiWYOBitzNUHfyqKwtKUr\n\ + VoSCdZcGeA9lHUPA7PUprRRaT3m1hGKPyshtVS2ikG48w3oVerln1N1qGdtz46gZCrndw3LZ1B362RfW\n\ + zDPuXbpsyLsRMTt1Rz1oKHRXp3iE41hkhQH6pxlvyCW2INnHt5XU8zRamOB3oW0udOhMpQFDjRkOcy06\n\ + b4t0QTHvoRqmBna3WXzIMZyeK3GChF5eF8oDXRbjhk7BB6YKCgqwWUzEJ5K47HMSlhFkBUjaPRjdGM0z\n\ + zOMwhW6b1NvSwP7XM1P5yi1oPvOspts1vr29SXqrMMrBhVogeodWyd69NqrO4jkyBxKmlXifoTowpfiY\n\ + 2cUCE0XMZqxUN39LCP09JqZifaEcBEo3mgtm1tWu5QR2GNq7UyQf4RIPSDOpDCAtwoPhRgdT1lJdcj4U\n\ + lnH0wrJ8Uwu7c08L7ErnIrDATqCrOjpSbzGP1xHENABYONC4TknFPrJ8pe40A8fzGT0qBw9mAM1SKcHO\n\ + foiLcMC9AjHTqJzDG3xplSLPG9or2rMeq7Fzp9r0y7uJRMxgg51EbjfvYlH466A3ggvL2WQlDXjJqPW3\n\ + BJGWAWDNN9LK8f46bADKPxakpkx23S9O47rGSXfDhVSIZsDympxWX1UOzWwMZRHkofVeKqizgbKkGgUT\n\ + WykE9gRoRAOd9wfHZDYKa9i0LaPDiaUMvnU1gdBIqIoiVsdJ9swX47oxvMtOxtcS0zlD6llDkBuIiU5g\n\ + PwRCYmtkkb25c8iRJXwGFPjI1wJ34I1z1ENicPdosPiUe9ZC2jnXIKzEdv01x2ER7DNDF3yxOwOhxNxI\n\ + GqsmC92j25UQQFu9ZstOZ28AoCkuOYs0Uycm5u8jR1T39dMBwrko09rC65ENLnsxM8oebmyFCPiGJ1ED\n\ + 5Xqc9qZ237f1OnETAoEOwqUSvrdPTv56U7hV91EMTyC812MLQpr2710E3VVpsUCUMNhIxdt7UXZ1UNFb\n\ + jgzpZLXnf4DHrv6B7kq6UI50KMxcw1HZE2GpODfUTzNFLaqdrvzxKe5eUWdcojBaRbD4fFdVYJTElYDH\n\ + NNVh6ofkoeWcs9CWGFmSBe0T4K8phFeygQg0prKMELNEy6qENzVtG9ZDcqj3a7L6ZLtvq50anWp7fAVu\n\ + fwz55g4iM2Z2fA0pnwHDL7tt67zTxGITvsnJsZSpeq1EQsZcwtkBV9liu7Rl7jiVT1IIRtchB8TsTiaA\n\ + wVHIQQ9RIOTiPQdKNqi1kC9iGlUqWK93gblNWlBw1eYB9Wk8FQogutwTf0caNMx8D4nPbANcmOOlskIy\n\ + zALh15OlTrWnhP95rf08AN2J026zDE2DUF9k0eCevYBQIDjqKNW4XCZnjbHoIcKzbY5VzPbMs3ZyMz8K\n\ + SucBmgPg6wrSK5ykbkapS5vuqvXc9GbjQJ8bPNzoxoWGyjbZvDs2OBrIqBmcQb2DLJ8v38McQ4mC4UsS\n\ + jf4PyfSCtpk274QZjvLCZbLiCBxQegk7jUU0NmTFJAcYCxd9xMWdlFkiszcltT2YzwuFFz7iA6aa4n5L\n\ + HpBNfUA01GcAi1aCMYhmooS4zSlYcSOZkovMz36U3Fd9WtqIEOJLi7HMgHQDgNMdK6DTzAdHQtxerxVF\n\ + HJnPrfNVG7270r3bp0bPnLNYLhObbAn6zqSAUeLtI2Y4KJDjBKCAh2vvYGbu0e2REYJWRj7MkGevsSSy\n\ + b1kCXLt6tKGWAb7lt5c0xyJgUIJW7pdtnwgT0ZCa24BecCAwNnG5U2EwQbcjZGsFxqNGfaemd3oFEhES\n\ + BaE0Fxms9UKTnMafu8wvZ2xymMrUduuRzOjDeX7oD5YsLC88V8CGMLxbbxIpt94KGykbr6e7L0R4oZl1\n\ + tKMgFwQ2p9Txdbp0Y293LcsJymKizqI0F2xEp7y4SmWOJqHZtsbz80wVV9nv41CvtfxuSoGZJ5cNB7pI\n\ + BgzNcQCeH3Jt0RaGGwboxxpuFbzilmkMFXxJm87tD4WNgu01nHfGCKeQcySEBZpVfJgi6sDFJ8uWnvKm\n\ + 9mPLHurtWzEfKqUEa1iC71bXjw5wrvhv9BYW8JSUELHmDquftQyKdq0DZXhULMHGQLf4e95WIaoA14LL\n\ + bThz77kuhKULPTu2MNrBUKGorurhGugo5gs4ZUezSsUOe3KxYdrFMdGgny1GgTxMSMTp2RAZytKjv4kQ\n\ + Vx7XgzvpQLIbDjUPAkJv6lScwIRq1W3Ne0Rh0V6Bmn6U5uIuWnJjULmbaQiSODj3z0mAZvak0mSWIGwT\n\ + TX83HztcC4W7e1f6a1thmcc5K61Icehla2hBELWPpixTkyC4eEVmk9Rq0m0ZXtx0JX2ZQXqXDEyePyMe\n\ + J70sdSzXk72zusqhY4yuOMGgbYNHqxOToK6NxujR7e4dV3Wk5JnSUthym8scjcPeCiKDNY4cHfTMnDXJ\n\ + 9zLVy01LtNKYpJ1s8FxVxigmxQNKEbIamxhx6yqwGC4aiISVOOUEjvNOdaUfXfUsE6jEwtwxyGxjlRK1\n\ + cLyxXttq4QWN6PehgHv7jXykzPjInbEysebFvvPOOMdunmJvcCNMSvjUda8fL6xfGo0FDrLg8XZipd6S\n\ + oPVdYtyIM1Dg40KbBA3JuumPYtXuJaHrZnjZmdnM5OVo4ZNxktfCVT0c6bnD4bAeyn4bYt1ZPaX6hQHh\n\ + JtvNYfpD0ONYlmqKuToQAMlz52Fh6bj45EbX89L5eLlSpWeyBlGotzriB0EPlclrGi5l2B5oPb1aB1ag\n\ + yyYuu44l0F1oOVYnBIZsxIsHVITxi9lEuVPFkWASOUNuVQXfM4n5hxWR9qtuKnIcPsvbJsv1U10XlKh3\n\ + KisqPhHU15xrCLr5gwFxPUKiNTLUBrkzgBOHXPVsHcLCiSD0YU56TRGfvEom43TWUKPPfl9Z54tgVQuT\n\ + jCRlaljAzeniQIcbbHZnn3f0HxbDG3DFYqWSxNrXabHhRsIOhhUHSPENyhGSTVO5t0XX5CdMspJPCd02\n\ + 3Oqv32ccbUK4O3YH6LEvp0WO3kSl5n50odVkI9B0i0iq4UPFGMkM8bEQJbgJoOH71P10vtdevJFQE4g2\n\ + yhimiM53ZJRWgSZveHtENZc0Gjo0F9eioak9BnPpY1QxAFPC817svuhEstcU69bLCA4D1rO5R8AuIIBq\n\ + yQJcifFLvbpAEYTLKJqysZrU8EEl3TSdC13A9hZvk4NC8VGEDAxcNrKw313dZp17kZPO5HSd1y6sljAW\n\ + A9M1d6FMYV5SlBWf3WZNCUPS7qKNlda2YBsC6IUVB363f5RLGQOQHwbaijBSRCkrVoRxBHtc0Bd5J9V9\n\ + P5uMTXkpZOxRcCQvImGgcmGuxxLb5zTqfS2xu7v3Sf3IIesSt9tVzcEcdbEvLGVJkLk4mb3G30DbIbri\n\ + PZ09JkweDvMaQ3bxT2nfkz3Ilihkw9jqikkCCCz7E8h6z6KbhQErEW9VzJZzMCgJsyPjFam6iNwpe07S\n\ + hyOvNVw2t9wpzL5xM11DvVzQwDaWEytNRHzDBs4KwEtpI2IpjUyVZHSwA0UGqqkzoCgrJFlNOvPlXqcS\n\ + IcREouUIBmuttkrhPWJtSxOOgpsdvBR3kTOzAXNzSKxoaBAb0c5SDMUc6FIyGA8x5wg5DkUgjFUUodEt\n\ + OYaB2VHVePW9mxHeBTdKWLzJow4ZZvjnoBuVigXljKCNh137ckV2y3Yg3Xi4UzJEI2V5Rw9AfnMs7xUw\n\ + VHOFCg189maD3bmZAe7b4eaGZhyy4HVKjqCXmIH7vsEjRvbnfB0SQxxpuqBDJbHNCtW4vM643ZQQBVPP\n\ + a7oXSQIq9w2dHp0A7dtkocCZdQp9FKR9XdJAFIbVSHzIF1ZogeZlc0pXuNE0tagvD57xwDRFkAuoQyMu\n\ + YDdZasXrpSmEE5UjHVkyYsISn8QsfXurzDybX468aoRoks654jjmRY5zi1oB8TcMdC2c3sicNaqfeuhd\n\ + H1nPX7l4RpdqWMR7gGx9slXtG8S3KxpOi4qCD7yg3saD66nun4dzksQURoTUdXyrJR5UpHsfIlTF1aJa\n\ + MdXyQtQnrkl00TeghQd00rRFZsCnhi0qrCSKiBfB2EVrd9RPpbgwJGZHuIQecdBmNetc2ylSEClqVBPR\n\ + GOPPIxrnswEZjmnS0jxKW9VSM1QVxSPJnPFswCqT95SoKD6CP4xdX28WIUGiNaIKodXXJHEIsXBCxLsr\n\ + PwWPCtoplC6hhpKmW5dQo92iCTyY2KioKzO8XR6FKm6qonMKVEwQNtlYE9c97KMtEnp25VOdMP46SQXS\n\ + YsSVp7vm8LP87VYI8SOKcW3s2oedYFtt45rvDzoTF0GmS6wELQ9uo98HhjQAI1Dt91cgjJOwygNmLoZE\n\ + X5K2zQiNA163uMCl5xzaBqY4YTL0wgALg3IFdYSp0RFYLWdt6IxoGI1tnoxcjlUEPo5eGIc3mS3SmaLn\n\ + OdumfUQQ4Jgmgaa5anUVQsfBDrlAN5oaX7O0JO71SSPSWiHBsT9WIPy2J1Cace9ZZLRxblFPSXcvsuHh\n\ + hvnhWQltEDAe7MgvkFQ8lGVFa8jhzijoF9kLmMhMILSzYnfXnZPNP7TlAAwlLHK1RqlpHskJqb6CPpGP\n\ + QvOAhEMsM3zJ2KejZx0esxkjxA0ZufVvGAMN3vTUMplQaF4RiQkp9fzBXf3CMk01dWjOMMIEXTeKzIQe\n\ + EcffzjixWU9FpAyGp2rVl4ETRgqljOGw4UgK31r0ZIEGnH0xGz1FtbW1OcQM008JVujRqulCucEMmntr\n"; + encoding = Some "custom"; + } + in + Mock.mock_response ?body:None ~status:200 ~headers:[ ("Content-Type", "application/json") ] (); + let response = PutWithContentEncoding.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = () in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/requestcompression/putcontentwithencoding") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Encoding", "custom, gzip") ] + request.headers + in + () + | Error error -> failwith (PutWithContentEncoding.error_to_string error) + +let put_with_content_encoding_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#PutWithContentEncoding", + [ + ("SDKAppliedContentEncoding_restXml", `Quick, sdk_applied_content_encoding_rest_xml); + ( "SDKAppendedGzipAfterProvidedEncoding_restXml", + `Quick, + sdk_appended_gzip_after_provided_encoding_rest_xml ); + ] ) + +let query_idempotency_token_auto_fill () = + Eio.Switch.run ~name:"QueryIdempotencyTokenAutoFill" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.query_idempotency_token_auto_fill_input = { token = None } in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = + Smaws_Lib.Uuid.with_generator + (fun _ -> "00000000-0000-4000-8000-000000000000") + (fun () -> QueryIdempotencyTokenAutoFill.request ctx input) + in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/QueryIdempotencyTokenAutoFill") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (QueryIdempotencyTokenAutoFill.error_to_string error) + +let query_idempotency_token_auto_fill_is_set () = + Eio.Switch.run ~name:"QueryIdempotencyTokenAutoFillIsSet" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.query_idempotency_token_auto_fill_input = + { token = Some "00000000-0000-4000-8000-000000000000" } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = QueryIdempotencyTokenAutoFill.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/QueryIdempotencyTokenAutoFill") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (QueryIdempotencyTokenAutoFill.error_to_string error) + +let query_idempotency_token_auto_fill_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#QueryIdempotencyTokenAutoFill", + [ + ("QueryIdempotencyTokenAutoFill", `Quick, query_idempotency_token_auto_fill); + ("QueryIdempotencyTokenAutoFillIsSet", `Quick, query_idempotency_token_auto_fill_is_set); + ] ) + +let rest_xml_query_params_string_list_map () = + Eio.Switch.run ~name:"RestXmlQueryParamsStringListMap" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.query_params_as_string_list_map_input = + { foo = Some [ ("baz", [ "bar"; "qux" ]) ]; qux = Some "named" } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = QueryParamsAsStringListMap.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/StringListMap") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (QueryParamsAsStringListMap.error_to_string error) + +let query_params_as_string_list_map_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#QueryParamsAsStringListMap", + [ ("RestXmlQueryParamsStringListMap", `Quick, rest_xml_query_params_string_list_map) ] ) + +let rest_xml_query_precedence () = + Eio.Switch.run ~name:"RestXmlQueryPrecedence" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.query_precedence_input = + { baz = Some [ ("bar", "fromMap"); ("qux", "alsoFromMap") ]; foo = Some "named" } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = QueryPrecedence.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/Precedence") + request.uri + in + let () = check Alcotest_http.headers_testable "expected request headers" [] request.headers in + () + | Error error -> failwith (QueryPrecedence.error_to_string error) + +let query_precedence_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#QueryPrecedence", + [ ("RestXmlQueryPrecedence", `Quick, rest_xml_query_precedence) ] ) + +let recursive_shapes () = + Eio.Switch.run ~name:"RecursiveShapes" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.recursive_shapes_request = + { + nested = + Some + { + nested = + Some + { + recursive_member = + Some + { + nested = Some { recursive_member = None; bar = Some "Bar2" }; + foo = Some "Foo2"; + }; + bar = Some "Bar1"; + }; + foo = Some "Foo1"; + }; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ Foo1\n\ + \ \n\ + \ Bar1\n\ + \ \n\ + \ Foo2\n\ + \ \n\ + \ Bar2\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = RecursiveShapes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ Foo1\n\ + \ \n\ + \ Bar1\n\ + \ \n\ + \ Foo2\n\ + \ \n\ + \ Bar2\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/RecursiveShapes") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (RecursiveShapes.error_to_string error) + +let recursive_shapes () = + Eio.Switch.run ~name:"RecursiveShapes" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ Foo1\n\ + \ \n\ + \ Bar1\n\ + \ \n\ + \ Foo2\n\ + \ \n\ + \ Bar2\n\ + \ \n\ + \ \n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = RecursiveShapes.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ + nested = + Some + { + nested = + Some + { + recursive_member = + Some + { + nested = Some { recursive_member = None; bar = Some "Bar2" }; + foo = Some "Foo2"; + }; + bar = Some "Bar1"; + }; + foo = Some "Foo1"; + }; + } + : Types.recursive_shapes_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_recursive_shapes_response + Types.equal_recursive_shapes_response) + "expected output" expected result + | Error error -> failwith (RecursiveShapes.error_to_string error) + +let recursive_shapes_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#RecursiveShapes", + [ ("RecursiveShapes", `Quick, recursive_shapes); ("RecursiveShapes", `Quick, recursive_shapes) ] + ) + +let simple_scalar_properties () = + Eio.Switch.run ~name:"SimpleScalarProperties" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.simple_scalar_properties_request = + { + double_value = Some 6.5; + float_value = Some 5.5; + long_value = Some (Smaws_Lib.CoreTypes.Int64.of_int 4); + integer_value = Some 3; + short_value = Some 2; + byte_value = Some 1; + false_boolean_value = Some false; + true_boolean_value = Some true; + string_value = Some "string"; + foo = Some "Foo"; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ string\n\ + \ true\n\ + \ false\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ 4\n\ + \ 5.5\n\ + \ 6.5\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = SimpleScalarProperties.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ string\n\ + \ true\n\ + \ false\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ 4\n\ + \ 5.5\n\ + \ 6.5\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/SimpleScalarProperties") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_with_escaped_character () = + Eio.Switch.run ~name:"SimpleScalarPropertiesWithEscapedCharacter" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.simple_scalar_properties_request = + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = Some ""; + foo = Some "Foo"; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ <string>\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = SimpleScalarProperties.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ <string>\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/SimpleScalarProperties") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_with_white_space () = + Eio.Switch.run ~name:"SimpleScalarPropertiesWithWhiteSpace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.simple_scalar_properties_request = + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = Some " string with white space "; + foo = Some "Foo"; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ string with white space \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = SimpleScalarProperties.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ string with white space \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/SimpleScalarProperties") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_pure_white_space () = + Eio.Switch.run ~name:"SimpleScalarPropertiesPureWhiteSpace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.simple_scalar_properties_request = + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = Some " "; + foo = Some "Foo"; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = SimpleScalarProperties.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/SimpleScalarProperties") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let rest_xml_supports_na_n_float_inputs () = + Eio.Switch.run ~name:"RestXmlSupportsNaNFloatInputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.simple_scalar_properties_request = + { + double_value = Some Float.nan; + float_value = Some Float.nan; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ NaN\n\ + \ NaN\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = SimpleScalarProperties.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ NaN\n\ + \ NaN\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/SimpleScalarProperties") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let rest_xml_supports_infinity_float_inputs () = + Eio.Switch.run ~name:"RestXmlSupportsInfinityFloatInputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.simple_scalar_properties_request = + { + double_value = Some Float.infinity; + float_value = Some Float.infinity; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ Infinity\n\ + \ Infinity\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = SimpleScalarProperties.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ Infinity\n\ + \ Infinity\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/SimpleScalarProperties") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let rest_xml_supports_negative_infinity_float_inputs () = + Eio.Switch.run ~name:"RestXmlSupportsNegativeInfinityFloatInputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.simple_scalar_properties_request = + { + double_value = Some Float.neg_infinity; + float_value = Some Float.neg_infinity; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ -Infinity\n\ + \ -Infinity\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = SimpleScalarProperties.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ -Infinity\n\ + \ -Infinity\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/SimpleScalarProperties") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties () = + Eio.Switch.run ~name:"SimpleScalarProperties" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ string\n\ + \ true\n\ + \ false\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ 4\n\ + \ 5.5\n\ + \ 6.5\n\ + \n") + ~status:200 + ~headers:[ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = Some 6.5; + float_value = Some 5.5; + long_value = Some (Smaws_Lib.CoreTypes.Int64.of_int 4); + integer_value = Some 3; + short_value = Some 2; + byte_value = Some 1; + false_boolean_value = Some false; + true_boolean_value = Some true; + string_value = Some "string"; + foo = Some "Foo"; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_with_escaped_character () = + Eio.Switch.run ~name:"SimpleScalarPropertiesWithEscapedCharacter" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ <string>\n\ + \n") + ~status:200 + ~headers:[ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = Some ""; + foo = Some "Foo"; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_with_xml_preamble () = + Eio.Switch.run ~name:"SimpleScalarPropertiesWithXMLPreamble" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \n\ + \ \n\ + \ string\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = Some "string"; + foo = Some "Foo"; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_with_white_space () = + Eio.Switch.run ~name:"SimpleScalarPropertiesWithWhiteSpace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \n\ + \ string with white space \n\ + \n") + ~status:200 + ~headers:[ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = Some " string with white space "; + foo = Some "Foo"; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_pure_white_space () = + Eio.Switch.run ~name:"SimpleScalarPropertiesPureWhiteSpace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("X-Foo", "Foo"); ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = Some " "; + foo = Some "Foo"; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let rest_xml_supports_na_n_float_outputs () = + Eio.Switch.run ~name:"RestXmlSupportsNaNFloatOutputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ NaN\n\ + \ NaN\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = Some Float.nan; + float_value = Some Float.nan; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let rest_xml_supports_infinity_float_outputs () = + Eio.Switch.run ~name:"RestXmlSupportsInfinityFloatOutputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ Infinity\n\ + \ Infinity\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = Some Float.infinity; + float_value = Some Float.infinity; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let rest_xml_supports_negative_infinity_float_outputs () = + Eio.Switch.run ~name:"RestXmlSupportsNegativeInfinityFloatOutputs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ -Infinity\n\ + \ -Infinity\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + SimpleScalarProperties.request ctx + { + double_value = None; + float_value = None; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + in + match response with + | Ok result -> + let expected = + ({ + double_value = Some Float.neg_infinity; + float_value = Some Float.neg_infinity; + long_value = None; + integer_value = None; + short_value = None; + byte_value = None; + false_boolean_value = None; + true_boolean_value = None; + string_value = None; + foo = None; + } + : Types.simple_scalar_properties_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_simple_scalar_properties_response + Types.equal_simple_scalar_properties_response) + "expected output" expected result + | Error error -> failwith (SimpleScalarProperties.error_to_string error) + +let simple_scalar_properties_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#SimpleScalarProperties", + [ + ("SimpleScalarProperties", `Quick, simple_scalar_properties); + ( "SimpleScalarPropertiesWithEscapedCharacter", + `Quick, + simple_scalar_properties_with_escaped_character ); + ("SimpleScalarPropertiesWithWhiteSpace", `Quick, simple_scalar_properties_with_white_space); + ("SimpleScalarPropertiesPureWhiteSpace", `Quick, simple_scalar_properties_pure_white_space); + ("RestXmlSupportsNaNFloatInputs", `Quick, rest_xml_supports_na_n_float_inputs); + ("RestXmlSupportsInfinityFloatInputs", `Quick, rest_xml_supports_infinity_float_inputs); + ( "RestXmlSupportsNegativeInfinityFloatInputs", + `Quick, + rest_xml_supports_negative_infinity_float_inputs ); + ("SimpleScalarProperties", `Quick, simple_scalar_properties); + ( "SimpleScalarPropertiesWithEscapedCharacter", + `Quick, + simple_scalar_properties_with_escaped_character ); + ("SimpleScalarPropertiesWithXMLPreamble", `Quick, simple_scalar_properties_with_xml_preamble); + ("SimpleScalarPropertiesWithWhiteSpace", `Quick, simple_scalar_properties_with_white_space); + ("SimpleScalarPropertiesPureWhiteSpace", `Quick, simple_scalar_properties_pure_white_space); + ("RestXmlSupportsNaNFloatOutputs", `Quick, rest_xml_supports_na_n_float_outputs); + ("RestXmlSupportsInfinityFloatOutputs", `Quick, rest_xml_supports_infinity_float_outputs); + ( "RestXmlSupportsNegativeInfinityFloatOutputs", + `Quick, + rest_xml_supports_negative_infinity_float_outputs ); + ] ) + +let timestamp_format_headers () = + Eio.Switch.run ~name:"TimestampFormatHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.timestamp_format_headers_i_o = + { + target_date_time = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + target_http_date = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + target_epoch_seconds = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + default_format = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + member_date_time = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + member_http_date = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + member_epoch_seconds = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + } + in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = TimestampFormatHeaders.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some (Smaws_Lib.Json.of_string "")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/TimestampFormatHeaders") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ + ("X-targetDateTime", "2019-12-16T23:48:18Z"); + ("X-targetHttpDate", "Mon, 16 Dec 2019 23:48:18 GMT"); + ("X-targetEpochSeconds", "1576540098"); + ("X-defaultFormat", "Mon, 16 Dec 2019 23:48:18 GMT"); + ("X-memberDateTime", "2019-12-16T23:48:18Z"); + ("X-memberHttpDate", "Mon, 16 Dec 2019 23:48:18 GMT"); + ("X-memberEpochSeconds", "1576540098"); + ] + request.headers + in + () + | Error error -> failwith (TimestampFormatHeaders.error_to_string error) + +let timestamp_format_headers () = + Eio.Switch.run ~name:"TimestampFormatHeaders" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response ?body:(Some "") ~status:200 + ~headers: + [ + ("X-targetDateTime", "2019-12-16T23:48:18Z"); + ("X-targetHttpDate", "Mon, 16 Dec 2019 23:48:18 GMT"); + ("X-targetEpochSeconds", "1576540098"); + ("X-defaultFormat", "Mon, 16 Dec 2019 23:48:18 GMT"); + ("X-memberDateTime", "2019-12-16T23:48:18Z"); + ("X-memberHttpDate", "Mon, 16 Dec 2019 23:48:18 GMT"); + ("X-memberEpochSeconds", "1576540098"); + ] + (); + let response = + TimestampFormatHeaders.request ctx + { + target_date_time = None; + target_http_date = None; + target_epoch_seconds = None; + default_format = None; + member_date_time = None; + member_http_date = None; + member_epoch_seconds = None; + } + in + match response with + | Ok result -> + let expected = + ({ + target_date_time = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + target_http_date = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + target_epoch_seconds = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + default_format = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + member_date_time = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + member_http_date = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + member_epoch_seconds = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1576540098.)); + } + : Types.timestamp_format_headers_i_o) + in + check + (Alcotest_http.testable_nan_aware Types.pp_timestamp_format_headers_i_o + Types.equal_timestamp_format_headers_i_o) + "expected output" expected result + | Error error -> failwith (TimestampFormatHeaders.error_to_string error) + +let timestamp_format_headers_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#TimestampFormatHeaders", + [ + ("TimestampFormatHeaders", `Quick, timestamp_format_headers); + ("TimestampFormatHeaders", `Quick, timestamp_format_headers); + ] ) + +let xml_attributes () = + Eio.Switch.run ~name:"XmlAttributes" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_attributes_request = { attr = Some "test"; foo = Some "hi" } in + Mock.mock_response + ?body: + (Some "\n hi\n\n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlAttributes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n hi\n\n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlAttributes") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlAttributes.error_to_string error) + +let xml_attributes_with_escaping () = + Eio.Switch.run ~name:"XmlAttributesWithEscaping" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_attributes_request = { attr = Some ""; foo = Some "hi" } in + Mock.mock_response + ?body: + (Some + "\n\ + \ hi\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlAttributes.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ hi\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlAttributes") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlAttributes.error_to_string error) + +let xml_attributes () = + Eio.Switch.run ~name:"XmlAttributes" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some "\n hi\n\n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlAttributes.request ctx { attr = None; foo = None } in + match response with + | Ok result -> + let expected = ({ attr = Some "test"; foo = Some "hi" } : Types.xml_attributes_response) in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_attributes_response + Types.equal_xml_attributes_response) + "expected output" expected result + | Error error -> failwith (XmlAttributes.error_to_string error) + +let xml_attributes_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlAttributes", + [ + ("XmlAttributes", `Quick, xml_attributes); + ("XmlAttributesWithEscaping", `Quick, xml_attributes_with_escaping); + ("XmlAttributes", `Quick, xml_attributes); + ] ) + +let xml_attributes_in_middle () = + Eio.Switch.run ~name:"XmlAttributesInMiddle" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_attributes_in_middle_request = + { payload = Some { baz = Some "Baz"; attr = Some "attributeValue"; foo = Some "Foo" } } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ Foo\n\ + \ Baz\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlAttributesInMiddle.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ Foo\n\ + \ Baz\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/XmlAttributesInMiddle") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlAttributesInMiddle.error_to_string error) + +let xml_attributes_in_middle () = + Eio.Switch.run ~name:"XmlAttributesInMiddle" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ Foo\n\ + \ Baz\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlAttributesInMiddle.request ctx { payload = None } in + match response with + | Ok result -> + let expected = + ({ payload = Some { baz = Some "Baz"; attr = Some "attributeValue"; foo = Some "Foo" } } + : Types.xml_attributes_in_middle_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_attributes_in_middle_response + Types.equal_xml_attributes_in_middle_response) + "expected output" expected result + | Error error -> failwith (XmlAttributesInMiddle.error_to_string error) + +let xml_attributes_in_middle_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlAttributesInMiddle", + [ + ("XmlAttributesInMiddle", `Quick, xml_attributes_in_middle); + ("XmlAttributesInMiddle", `Quick, xml_attributes_in_middle); + ] ) + +let xml_attributes_on_payload () = + Eio.Switch.run ~name:"XmlAttributesOnPayload" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_attributes_on_payload_request = + { payload = Some { attr = Some "test"; foo = Some "hi" } } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ hi\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlAttributesOnPayload.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ hi\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/XmlAttributesOnPayload") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlAttributesOnPayload.error_to_string error) + +let xml_attributes_on_payload () = + Eio.Switch.run ~name:"XmlAttributesOnPayload" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ hi\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlAttributesOnPayload.request ctx { payload = None } in + match response with + | Ok result -> + let expected = + ({ payload = Some { attr = Some "test"; foo = Some "hi" } } + : Types.xml_attributes_on_payload_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_attributes_on_payload_response + Types.equal_xml_attributes_on_payload_response) + "expected output" expected result + | Error error -> failwith (XmlAttributesOnPayload.error_to_string error) + +let xml_attributes_on_payload_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlAttributesOnPayload", + [ + ("XmlAttributesOnPayload", `Quick, xml_attributes_on_payload); + ("XmlAttributesOnPayload", `Quick, xml_attributes_on_payload); + ] ) + +let xml_blobs () = + Eio.Switch.run ~name:"XmlBlobs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_blobs_request = + { data = Some (Smaws_Lib.CoreTypes.Blob.of_string "value") } + in + Mock.mock_response + ?body:(Some "\n dmFsdWU=\n\n") ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlBlobs.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n dmFsdWU=\n\n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlBlobs") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlBlobs.error_to_string error) + +let xml_blobs () = + Eio.Switch.run ~name:"XmlBlobs" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body:(Some "\n dmFsdWU=\n\n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlBlobs.request ctx { data = None } in + match response with + | Ok result -> + let expected = + ({ data = Some (Smaws_Lib.CoreTypes.Blob.of_string "value") } : Types.xml_blobs_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_blobs_response Types.equal_xml_blobs_response) + "expected output" expected result + | Error error -> failwith (XmlBlobs.error_to_string error) + +let xml_blobs_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlBlobs", + [ ("XmlBlobs", `Quick, xml_blobs); ("XmlBlobs", `Quick, xml_blobs) ] ) + +let xml_empty_blobs_test_suite : unit Alcotest.test = ("aws.protocoltests.restxml#XmlEmptyBlobs", []) + +let xml_empty_lists () = + Eio.Switch.run ~name:"XmlEmptyLists" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_empty_lists_request = + { + flattened_structure_list = None; + structure_list = None; + flattened_list_with_namespace = None; + flattened_list_with_member_namespace = None; + flattened_list2 = None; + flattened_list = None; + renamed_list_members = None; + nested_string_list = None; + int_enum_list = None; + enum_list = None; + timestamp_list = None; + boolean_list = None; + integer_list = None; + string_set = Some []; + string_list = Some []; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlEmptyLists.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlEmptyLists") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlEmptyLists.error_to_string error) + +let xml_empty_lists_test_suite : unit Alcotest.test = + ("aws.protocoltests.restxml#XmlEmptyLists", [ ("XmlEmptyLists", `Quick, xml_empty_lists) ]) + +let xml_empty_maps () = + Eio.Switch.run ~name:"XmlEmptyMaps" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_empty_maps_request = { my_map = Some [] } in + Mock.mock_response + ?body:(Some "\n \n\n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlEmptyMaps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n \n\n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlEmptyMaps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlEmptyMaps.error_to_string error) + +let xml_empty_maps_test_suite : unit Alcotest.test = + ("aws.protocoltests.restxml#XmlEmptyMaps", [ ("XmlEmptyMaps", `Quick, xml_empty_maps) ]) + +let xml_empty_strings () = + Eio.Switch.run ~name:"XmlEmptyStrings" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_empty_strings_request = { empty_string = Some "" } in + Mock.mock_response + ?body: + (Some "\n \n\n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlEmptyStrings.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/XmlEmptyStrings") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlEmptyStrings.error_to_string error) + +let xml_empty_strings_test_suite : unit Alcotest.test = + ("aws.protocoltests.restxml#XmlEmptyStrings", [ ("XmlEmptyStrings", `Quick, xml_empty_strings) ]) + +let xml_enums () = + Eio.Switch.run ~name:"XmlEnums" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_enums_request = + { + foo_enum_map = Some [ ("hi", FOO); ("zero", ZERO) ]; + foo_enum_set = Some [ FOO; ZERO ]; + foo_enum_list = Some [ FOO; ZERO ]; + foo_enum3 = Some ONE; + foo_enum2 = Some ZERO; + foo_enum1 = Some FOO; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ Foo\n\ + \ 0\n\ + \ 1\n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ \n\ + \ hi\n\ + \ Foo\n\ + \ \n\ + \ \n\ + \ zero\n\ + \ 0\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlEnums.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ Foo\n\ + \ 0\n\ + \ 1\n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ \n\ + \ hi\n\ + \ Foo\n\ + \ \n\ + \ \n\ + \ zero\n\ + \ 0\n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlEnums") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlEnums.error_to_string error) + +let xml_enums () = + Eio.Switch.run ~name:"XmlEnums" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ Foo\n\ + \ 0\n\ + \ 1\n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ \n\ + \ hi\n\ + \ Foo\n\ + \ \n\ + \ \n\ + \ zero\n\ + \ 0\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlEnums.request ctx + { + foo_enum_map = None; + foo_enum_set = None; + foo_enum_list = None; + foo_enum3 = None; + foo_enum2 = None; + foo_enum1 = None; + } + in + match response with + | Ok result -> + let expected = + ({ + foo_enum_map = Some [ ("hi", FOO); ("zero", ZERO) ]; + foo_enum_set = Some [ FOO; ZERO ]; + foo_enum_list = Some [ FOO; ZERO ]; + foo_enum3 = Some ONE; + foo_enum2 = Some ZERO; + foo_enum1 = Some FOO; + } + : Types.xml_enums_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_enums_response Types.equal_xml_enums_response) + "expected output" expected result + | Error error -> failwith (XmlEnums.error_to_string error) + +let xml_enums_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlEnums", + [ ("XmlEnums", `Quick, xml_enums); ("XmlEnums", `Quick, xml_enums) ] ) + +let xml_int_enums () = + Eio.Switch.run ~name:"XmlIntEnums" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_int_enums_request = + { + int_enum_map = Some [ ("a", A); ("b", B) ]; + int_enum_set = Some [ A; B ]; + int_enum_list = Some [ A; B ]; + int_enum3 = Some C; + int_enum2 = Some B; + int_enum1 = Some A; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ \n\ + \ a\n\ + \ 1\n\ + \ \n\ + \ \n\ + \ b\n\ + \ 2\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlIntEnums.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ \n\ + \ a\n\ + \ 1\n\ + \ \n\ + \ \n\ + \ b\n\ + \ 2\n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlIntEnums") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlIntEnums.error_to_string error) + +let xml_int_enums () = + Eio.Switch.run ~name:"XmlIntEnums" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ \n\ + \ a\n\ + \ 1\n\ + \ \n\ + \ \n\ + \ b\n\ + \ 2\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlIntEnums.request ctx + { + int_enum_map = None; + int_enum_set = None; + int_enum_list = None; + int_enum3 = None; + int_enum2 = None; + int_enum1 = None; + } + in + match response with + | Ok result -> + let expected = + ({ + int_enum_map = Some [ ("a", A); ("b", B) ]; + int_enum_set = Some [ A; B ]; + int_enum_list = Some [ A; B ]; + int_enum3 = Some C; + int_enum2 = Some B; + int_enum1 = Some A; + } + : Types.xml_int_enums_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_int_enums_response + Types.equal_xml_int_enums_response) + "expected output" expected result + | Error error -> failwith (XmlIntEnums.error_to_string error) + +let xml_int_enums_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlIntEnums", + [ ("XmlIntEnums", `Quick, xml_int_enums); ("XmlIntEnums", `Quick, xml_int_enums) ] ) + +let xml_lists () = + Eio.Switch.run ~name:"XmlLists" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_lists_request = + { + flattened_structure_list = + Some [ { b = Some "6"; a = Some "5" }; { b = Some "8"; a = Some "7" } ]; + structure_list = Some [ { b = Some "2"; a = Some "1" }; { b = Some "4"; a = Some "3" } ]; + flattened_list_with_namespace = None; + flattened_list_with_member_namespace = None; + flattened_list2 = Some [ "yep"; "nope" ]; + flattened_list = Some [ "hi"; "bye" ]; + renamed_list_members = Some [ "foo"; "bar" ]; + nested_string_list = Some [ [ "foo"; "bar" ]; [ "baz"; "qux" ] ]; + int_enum_list = Some [ A; B ]; + enum_list = Some [ FOO; ZERO ]; + timestamp_list = + Some + [ + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.); + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.); + ]; + boolean_list = Some [ true; false ]; + integer_list = Some [ 1; 2 ]; + string_set = Some [ "foo"; "bar" ]; + string_list = Some [ "foo"; "bar" ]; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ true\n\ + \ false\n\ + \ \n\ + \ \n\ + \ 2014-04-29T18:30:38Z\n\ + \ 2014-04-29T18:30:38Z\n\ + \ \n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ baz\n\ + \ qux\n\ + \ \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ hi\n\ + \ bye\n\ + \ yep\n\ + \ nope\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ 3\n\ + \ 4\n\ + \ \n\ + \ \n\ + \ \n\ + \ 5\n\ + \ 6\n\ + \ \n\ + \ \n\ + \ 7\n\ + \ 8\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlLists.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ true\n\ + \ false\n\ + \ \n\ + \ \n\ + \ 2014-04-29T18:30:38Z\n\ + \ 2014-04-29T18:30:38Z\n\ + \ \n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ baz\n\ + \ qux\n\ + \ \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ hi\n\ + \ bye\n\ + \ yep\n\ + \ nope\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ 3\n\ + \ 4\n\ + \ \n\ + \ \n\ + \ \n\ + \ 5\n\ + \ 6\n\ + \ \n\ + \ \n\ + \ 7\n\ + \ 8\n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlLists") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlLists.error_to_string error) + +let xml_lists () = + Eio.Switch.run ~name:"XmlLists" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ true\n\ + \ false\n\ + \ \n\ + \ \n\ + \ 2014-04-29T18:30:38Z\n\ + \ 2014-04-29T18:30:38Z\n\ + \ \n\ + \ \n\ + \ Foo\n\ + \ 0\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ \n\ + \ baz\n\ + \ qux\n\ + \ \n\ + \ \n\ + \ \n\ + \ foo\n\ + \ bar\n\ + \ \n\ + \ hi\n\ + \ bye\n\ + \ yep\n\ + \ nope\n\ + \ a\n\ + \ b\n\ + \ a\n\ + \ b\n\ + \ \n\ + \ \n\ + \ 1\n\ + \ 2\n\ + \ \n\ + \ \n\ + \ 3\n\ + \ 4\n\ + \ \n\ + \ \n\ + \ \n\ + \ 5\n\ + \ 6\n\ + \ \n\ + \ \n\ + \ 7\n\ + \ 8\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlLists.request ctx + { + flattened_structure_list = None; + structure_list = None; + flattened_list_with_namespace = None; + flattened_list_with_member_namespace = None; + flattened_list2 = None; + flattened_list = None; + renamed_list_members = None; + nested_string_list = None; + int_enum_list = None; + enum_list = None; + timestamp_list = None; + boolean_list = None; + integer_list = None; + string_set = None; + string_list = None; + } + in + match response with + | Ok result -> + let expected = + ({ + flattened_structure_list = + Some [ { b = Some "6"; a = Some "5" }; { b = Some "8"; a = Some "7" } ]; + structure_list = Some [ { b = Some "2"; a = Some "1" }; { b = Some "4"; a = Some "3" } ]; + flattened_list_with_namespace = Some [ "a"; "b" ]; + flattened_list_with_member_namespace = Some [ "a"; "b" ]; + flattened_list2 = Some [ "yep"; "nope" ]; + flattened_list = Some [ "hi"; "bye" ]; + renamed_list_members = Some [ "foo"; "bar" ]; + nested_string_list = Some [ [ "foo"; "bar" ]; [ "baz"; "qux" ] ]; + int_enum_list = Some [ A; B ]; + enum_list = Some [ FOO; ZERO ]; + timestamp_list = + Some + [ + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.); + Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.); + ]; + boolean_list = Some [ true; false ]; + integer_list = Some [ 1; 2 ]; + string_set = Some [ "foo"; "bar" ]; + string_list = Some [ "foo"; "bar" ]; + } + : Types.xml_lists_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_lists_response Types.equal_xml_lists_response) + "expected output" expected result + | Error error -> failwith (XmlLists.error_to_string error) + +let xml_lists_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlLists", + [ ("XmlLists", `Quick, xml_lists); ("XmlLists", `Quick, xml_lists) ] ) + +let rest_xml_xml_map_with_xml_namespace () = + Eio.Switch.run ~name:"RestXmlXmlMapWithXmlNamespace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_map_with_xml_namespace_request = + { my_map = Some [ ("a", "A"); ("b", "B") ] } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ a\n\ + \ A\n\ + \ \n\ + \ \n\ + \ b\n\ + \ B\n\ + \ \n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlMapWithXmlNamespace.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ \n\ + \ a\n\ + \ A\n\ + \ \n\ + \ \n\ + \ b\n\ + \ B\n\ + \ \n\ + \ \n\ + ")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" + (Uri.of_string "/XmlMapWithXmlNamespace") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlMapWithXmlNamespace.error_to_string error) + +let rest_xml_xml_map_with_xml_namespace () = + Eio.Switch.run ~name:"RestXmlXmlMapWithXmlNamespace" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ a\n\ + \ A\n\ + \ \n\ + \ \n\ + \ b\n\ + \ B\n\ + \ \n\ + \ \n\ + ") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlMapWithXmlNamespace.request ctx { my_map = None } in + match response with + | Ok result -> + let expected = + ({ my_map = Some [ ("a", "A"); ("b", "B") ] } : Types.xml_map_with_xml_namespace_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_map_with_xml_namespace_response + Types.equal_xml_map_with_xml_namespace_response) + "expected output" expected result + | Error error -> failwith (XmlMapWithXmlNamespace.error_to_string error) + +let xml_map_with_xml_namespace_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlMapWithXmlNamespace", + [ + ("RestXmlXmlMapWithXmlNamespace", `Quick, rest_xml_xml_map_with_xml_namespace); + ("RestXmlXmlMapWithXmlNamespace", `Quick, rest_xml_xml_map_with_xml_namespace); + ] ) + +let xml_maps () = + Eio.Switch.run ~name:"XmlMaps" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_maps_request = + { my_map = Some [ ("foo", { hi = Some "there" }); ("baz", { hi = Some "bye" }) ] } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ there\n\ + \ \n\ + \ \n\ + \ \n\ + \ baz\n\ + \ \n\ + \ bye\n\ + \ \n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlMaps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ there\n\ + \ \n\ + \ \n\ + \ \n\ + \ baz\n\ + \ \n\ + \ bye\n\ + \ \n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlMaps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlMaps.error_to_string error) + +let xml_maps () = + Eio.Switch.run ~name:"XmlMaps" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ there\n\ + \ \n\ + \ \n\ + \ \n\ + \ baz\n\ + \ \n\ + \ bye\n\ + \ \n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlMaps.request ctx { my_map = None } in + match response with + | Ok result -> + let expected = + ({ my_map = Some [ ("foo", { hi = Some "there" }); ("baz", { hi = Some "bye" }) ] } + : Types.xml_maps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_maps_response Types.equal_xml_maps_response) + "expected output" expected result + | Error error -> failwith (XmlMaps.error_to_string error) + +let xml_maps_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlMaps", + [ ("XmlMaps", `Quick, xml_maps); ("XmlMaps", `Quick, xml_maps) ] ) + +let xml_maps_xml_name () = + Eio.Switch.run ~name:"XmlMapsXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_maps_xml_name_request = + { my_map = Some [ ("foo", { hi = Some "there" }); ("baz", { hi = Some "bye" }) ] } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ there\n\ + \ \n\ + \ \n\ + \ \n\ + \ baz\n\ + \ \n\ + \ bye\n\ + \ \n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlMapsXmlName.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ there\n\ + \ \n\ + \ \n\ + \ \n\ + \ baz\n\ + \ \n\ + \ bye\n\ + \ \n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlMapsXmlName") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlMapsXmlName.error_to_string error) + +let xml_maps_xml_name () = + Eio.Switch.run ~name:"XmlMapsXmlName" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ foo\n\ + \ \n\ + \ there\n\ + \ \n\ + \ \n\ + \ \n\ + \ baz\n\ + \ \n\ + \ bye\n\ + \ \n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlMapsXmlName.request ctx { my_map = None } in + match response with + | Ok result -> + let expected = + ({ my_map = Some [ ("foo", { hi = Some "there" }); ("baz", { hi = Some "bye" }) ] } + : Types.xml_maps_xml_name_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_maps_xml_name_response + Types.equal_xml_maps_xml_name_response) + "expected output" expected result + | Error error -> failwith (XmlMapsXmlName.error_to_string error) + +let xml_maps_xml_name_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlMapsXmlName", + [ ("XmlMapsXmlName", `Quick, xml_maps_xml_name); ("XmlMapsXmlName", `Quick, xml_maps_xml_name) ] + ) + +let xml_namespaces () = + Eio.Switch.run ~name:"XmlNamespaces" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_namespaces_request = + { nested = Some { values = Some [ "Bar"; "Baz" ]; foo = Some "Foo" } } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ Foo\n\ + \ \n\ + \ Bar\n\ + \ Baz\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlNamespaces.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ Foo\n\ + \ \n\ + \ Bar\n\ + \ Baz\n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlNamespaces") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlNamespaces.error_to_string error) + +let xml_namespaces () = + Eio.Switch.run ~name:"XmlNamespaces" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ Foo\n\ + \ \n\ + \ Bar\n\ + \ Baz\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlNamespaces.request ctx { nested = None } in + match response with + | Ok result -> + let expected = + ({ nested = Some { values = Some [ "Bar"; "Baz" ]; foo = Some "Foo" } } + : Types.xml_namespaces_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_namespaces_response + Types.equal_xml_namespaces_response) + "expected output" expected result + | Error error -> failwith (XmlNamespaces.error_to_string error) + +let xml_namespaces_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlNamespaces", + [ ("XmlNamespaces", `Quick, xml_namespaces); ("XmlNamespaces", `Quick, xml_namespaces) ] ) + +let xml_timestamps () = + Eio.Switch.run ~name:"XmlTimestamps" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_timestamps_request = + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlTimestamps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlTimestamps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_date_time_format () = + Eio.Switch.run ~name:"XmlTimestampsWithDateTimeFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_timestamps_request = + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + normal = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlTimestamps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlTimestamps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_date_time_on_target_format () = + Eio.Switch.run ~name:"XmlTimestampsWithDateTimeOnTargetFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_timestamps_request = + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + date_time = None; + normal = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlTimestamps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlTimestamps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_epoch_seconds_format () = + Eio.Switch.run ~name:"XmlTimestampsWithEpochSecondsFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_timestamps_request = + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + date_time_on_target = None; + date_time = None; + normal = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ 1398796238\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlTimestamps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ 1398796238\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlTimestamps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_epoch_seconds_on_target_format () = + Eio.Switch.run ~name:"XmlTimestampsWithEpochSecondsOnTargetFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_timestamps_request = + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ 1398796238\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlTimestamps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ 1398796238\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlTimestamps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_http_date_format () = + Eio.Switch.run ~name:"XmlTimestampsWithHttpDateFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_timestamps_request = + { + http_date_on_target = None; + http_date = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ Tue, 29 Apr 2014 18:30:38 GMT\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlTimestamps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ Tue, 29 Apr 2014 18:30:38 GMT\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlTimestamps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_http_date_on_target_format () = + Eio.Switch.run ~name:"XmlTimestampsWithHttpDateOnTargetFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_timestamps_request = + { + http_date_on_target = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ Tue, 29 Apr 2014 18:30:38 GMT\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlTimestamps.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ Tue, 29 Apr 2014 18:30:38 GMT\n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = + check Alcotest_http.method_testable "expected request method" `POST request.method_ + in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlTimestamps") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps () = + Eio.Switch.run ~name:"XmlTimestamps" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlTimestamps.request ctx + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + match response with + | Ok result -> + let expected = + ({ + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + } + : Types.xml_timestamps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_timestamps_response + Types.equal_xml_timestamps_response) + "expected output" expected result + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_date_time_format () = + Eio.Switch.run ~name:"XmlTimestampsWithDateTimeFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlTimestamps.request ctx + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + match response with + | Ok result -> + let expected = + ({ + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + normal = None; + } + : Types.xml_timestamps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_timestamps_response + Types.equal_xml_timestamps_response) + "expected output" expected result + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_date_time_on_target_format () = + Eio.Switch.run ~name:"XmlTimestampsWithDateTimeOnTargetFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 2014-04-29T18:30:38Z\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlTimestamps.request ctx + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + match response with + | Ok result -> + let expected = + ({ + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + date_time = None; + normal = None; + } + : Types.xml_timestamps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_timestamps_response + Types.equal_xml_timestamps_response) + "expected output" expected result + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_epoch_seconds_format () = + Eio.Switch.run ~name:"XmlTimestampsWithEpochSecondsFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 1398796238\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlTimestamps.request ctx + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + match response with + | Ok result -> + let expected = + ({ + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + date_time_on_target = None; + date_time = None; + normal = None; + } + : Types.xml_timestamps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_timestamps_response + Types.equal_xml_timestamps_response) + "expected output" expected result + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_epoch_seconds_on_target_format () = + Eio.Switch.run ~name:"XmlTimestampsWithEpochSecondsOnTargetFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ 1398796238\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlTimestamps.request ctx + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + match response with + | Ok result -> + let expected = + ({ + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + : Types.xml_timestamps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_timestamps_response + Types.equal_xml_timestamps_response) + "expected output" expected result + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_http_date_format () = + Eio.Switch.run ~name:"XmlTimestampsWithHttpDateFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ Tue, 29 Apr 2014 18:30:38 GMT\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlTimestamps.request ctx + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + match response with + | Ok result -> + let expected = + ({ + http_date_on_target = None; + http_date = Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + : Types.xml_timestamps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_timestamps_response + Types.equal_xml_timestamps_response) + "expected output" expected result + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_with_http_date_on_target_format () = + Eio.Switch.run ~name:"XmlTimestampsWithHttpDateOnTargetFormat" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ Tue, 29 Apr 2014 18:30:38 GMT\n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = + XmlTimestamps.request ctx + { + http_date_on_target = None; + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + in + match response with + | Ok result -> + let expected = + ({ + http_date_on_target = + Some (Option.get (Smaws_Lib.CoreTypes.Timestamp.of_float_s 1398796238.)); + http_date = None; + epoch_seconds_on_target = None; + epoch_seconds = None; + date_time_on_target = None; + date_time = None; + normal = None; + } + : Types.xml_timestamps_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_timestamps_response + Types.equal_xml_timestamps_response) + "expected output" expected result + | Error error -> failwith (XmlTimestamps.error_to_string error) + +let xml_timestamps_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlTimestamps", + [ + ("XmlTimestamps", `Quick, xml_timestamps); + ("XmlTimestampsWithDateTimeFormat", `Quick, xml_timestamps_with_date_time_format); + ( "XmlTimestampsWithDateTimeOnTargetFormat", + `Quick, + xml_timestamps_with_date_time_on_target_format ); + ("XmlTimestampsWithEpochSecondsFormat", `Quick, xml_timestamps_with_epoch_seconds_format); + ( "XmlTimestampsWithEpochSecondsOnTargetFormat", + `Quick, + xml_timestamps_with_epoch_seconds_on_target_format ); + ("XmlTimestampsWithHttpDateFormat", `Quick, xml_timestamps_with_http_date_format); + ( "XmlTimestampsWithHttpDateOnTargetFormat", + `Quick, + xml_timestamps_with_http_date_on_target_format ); + ("XmlTimestamps", `Quick, xml_timestamps); + ("XmlTimestampsWithDateTimeFormat", `Quick, xml_timestamps_with_date_time_format); + ( "XmlTimestampsWithDateTimeOnTargetFormat", + `Quick, + xml_timestamps_with_date_time_on_target_format ); + ("XmlTimestampsWithEpochSecondsFormat", `Quick, xml_timestamps_with_epoch_seconds_format); + ( "XmlTimestampsWithEpochSecondsOnTargetFormat", + `Quick, + xml_timestamps_with_epoch_seconds_on_target_format ); + ("XmlTimestampsWithHttpDateFormat", `Quick, xml_timestamps_with_http_date_format); + ( "XmlTimestampsWithHttpDateOnTargetFormat", + `Quick, + xml_timestamps_with_http_date_on_target_format ); + ] ) + +let xml_unions_with_struct_member () = + Eio.Switch.run ~name:"XmlUnionsWithStructMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_unions_request = + { + union_value = + Some + (StructValue + { + double_value = Some 6.5; + float_value = Some 5.5; + long_value = Some (Smaws_Lib.CoreTypes.Int64.of_int 4); + integer_value = Some 3; + short_value = Some 2; + byte_value = Some 1; + boolean_value = Some true; + string_value = Some "string"; + }); + } + in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ string\n\ + \ true\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ 4\n\ + \ 5.5\n\ + \ 6.5\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlUnions.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ \n\ + \ string\n\ + \ true\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ 4\n\ + \ 5.5\n\ + \ 6.5\n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlUnions") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_with_string_member () = + Eio.Switch.run ~name:"XmlUnionsWithStringMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_unions_request = { union_value = Some (StringValue "some string") } in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ some string\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlUnions.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ some string\n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlUnions") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_with_boolean_member () = + Eio.Switch.run ~name:"XmlUnionsWithBooleanMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_unions_request = { union_value = Some (BooleanValue true) } in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ true\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlUnions.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ true\n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlUnions") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_with_union_member () = + Eio.Switch.run ~name:"XmlUnionsWithUnionMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + let input : Types.xml_unions_request = { union_value = Some (UnionValue (BooleanValue true)) } in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ true\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/json") ] + (); + let response = XmlUnions.request ctx input in + match response with + | Ok resp -> + let request = Mock.last_request () in + let () = + check Alcotest_http.input_body_json_testable "expected request body value" + (Some + (Smaws_Lib.Json.of_string + "\n\ + \ \n\ + \ \n\ + \ true\n\ + \ \n\ + \ \n\ + \n")) + (request.body + |> Option.map (function + | `Form _ -> failwith "not expecting form" + | `String x -> x + | `Compressed (x, _) -> x + | `None -> "{}") + |> Option.map Yojson.Basic.from_string) + in + let () = check Alcotest_http.method_testable "expected request method" `PUT request.method_ in + let () = + check Alcotest_http.uri_testable "expected request uri" (Uri.of_string "/XmlUnions") + request.uri + in + let () = + check Alcotest_http.headers_testable "expected request headers" + [ ("Content-Type", "application/xml") ] + request.headers + in + () + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_with_struct_member () = + Eio.Switch.run ~name:"XmlUnionsWithStructMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ string\n\ + \ true\n\ + \ 1\n\ + \ 2\n\ + \ 3\n\ + \ 4\n\ + \ 5.5\n\ + \ 6.5\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlUnions.request ctx { union_value = None } in + match response with + | Ok result -> + let expected = + ({ + union_value = + Some + (StructValue + { + double_value = Some 6.5; + float_value = Some 5.5; + long_value = Some (Smaws_Lib.CoreTypes.Int64.of_int 4); + integer_value = Some 3; + short_value = Some 2; + byte_value = Some 1; + boolean_value = Some true; + string_value = Some "string"; + }); + } + : Types.xml_unions_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_unions_response + Types.equal_xml_unions_response) + "expected output" expected result + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_with_string_member () = + Eio.Switch.run ~name:"XmlUnionsWithStringMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ some string\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlUnions.request ctx { union_value = None } in + match response with + | Ok result -> + let expected = + ({ union_value = Some (StringValue "some string") } : Types.xml_unions_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_unions_response + Types.equal_xml_unions_response) + "expected output" expected result + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_with_boolean_member () = + Eio.Switch.run ~name:"XmlUnionsWithBooleanMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ true\n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlUnions.request ctx { union_value = None } in + match response with + | Ok result -> + let expected = ({ union_value = Some (BooleanValue true) } : Types.xml_unions_response) in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_unions_response + Types.equal_xml_unions_response) + "expected output" expected result + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_with_union_member () = + Eio.Switch.run ~name:"XmlUnionsWithUnionMember" @@ fun sw -> + let module Mock = (val Http_mock.create_http_mock ()) in + let http_type = ((module Mock) : (module Smaws_Lib.Http.Client with type t = Mock.t)) in + let config = Config.dummy in + let ctx = Smaws_Lib.Context.make ~config ~http_type () in + Mock.mock_response + ?body: + (Some + "\n\ + \ \n\ + \ \n\ + \ true\n\ + \ \n\ + \ \n\ + \n") + ~status:200 + ~headers:[ ("Content-Type", "application/xml") ] + (); + let response = XmlUnions.request ctx { union_value = None } in + match response with + | Ok result -> + let expected = + ({ union_value = Some (UnionValue (BooleanValue true)) } : Types.xml_unions_response) + in + check + (Alcotest_http.testable_nan_aware Types.pp_xml_unions_response + Types.equal_xml_unions_response) + "expected output" expected result + | Error error -> failwith (XmlUnions.error_to_string error) + +let xml_unions_test_suite : unit Alcotest.test = + ( "aws.protocoltests.restxml#XmlUnions", + [ + ("XmlUnionsWithStructMember", `Quick, xml_unions_with_struct_member); + ("XmlUnionsWithStringMember", `Quick, xml_unions_with_string_member); + ("XmlUnionsWithBooleanMember", `Quick, xml_unions_with_boolean_member); + ("XmlUnionsWithUnionMember", `Quick, xml_unions_with_union_member); + ("XmlUnionsWithStructMember", `Quick, xml_unions_with_struct_member); + ("XmlUnionsWithStringMember", `Quick, xml_unions_with_string_member); + ("XmlUnionsWithBooleanMember", `Quick, xml_unions_with_boolean_member); + ("XmlUnionsWithUnionMember", `Quick, xml_unions_with_union_member); + ] ) + +let () = + Eio_main.run @@ fun env -> + Alcotest.run "aws.protocoltests.restxml" + [ + all_query_string_types_test_suite; + body_with_xml_name_test_suite; + constant_and_variable_query_string_test_suite; + constant_query_string_test_suite; + content_type_parameters_test_suite; + datetime_offsets_test_suite; + empty_input_and_empty_output_test_suite; + endpoint_operation_test_suite; + endpoint_with_host_label_header_operation_test_suite; + endpoint_with_host_label_operation_test_suite; + flattened_xml_map_test_suite; + flattened_xml_map_with_xml_name_test_suite; + flattened_xml_map_with_xml_namespace_test_suite; + fractional_seconds_test_suite; + greeting_with_errors_test_suite; + http_empty_prefix_headers_test_suite; + http_enum_payload_test_suite; + http_payload_traits_test_suite; + http_payload_traits_with_media_type_test_suite; + http_payload_with_member_xml_name_test_suite; + http_payload_with_structure_test_suite; + http_payload_with_union_test_suite; + http_payload_with_xml_name_test_suite; + http_payload_with_xml_namespace_test_suite; + http_payload_with_xml_namespace_and_prefix_test_suite; + http_prefix_headers_test_suite; + http_request_with_float_labels_test_suite; + http_request_with_greedy_label_in_path_test_suite; + http_request_with_labels_test_suite; + http_request_with_labels_and_timestamp_format_test_suite; + http_response_code_test_suite; + http_string_payload_test_suite; + ignore_query_params_in_response_test_suite; + input_and_output_with_headers_test_suite; + nested_xml_maps_test_suite; + nested_xml_map_with_xml_name_test_suite; + no_input_and_no_output_test_suite; + no_input_and_output_test_suite; + null_and_empty_headers_client_test_suite; + null_and_empty_headers_server_test_suite; + omits_null_serializes_empty_string_test_suite; + put_with_content_encoding_test_suite; + query_idempotency_token_auto_fill_test_suite; + query_params_as_string_list_map_test_suite; + query_precedence_test_suite; + recursive_shapes_test_suite; + simple_scalar_properties_test_suite; + timestamp_format_headers_test_suite; + xml_attributes_test_suite; + xml_attributes_in_middle_test_suite; + xml_attributes_on_payload_test_suite; + xml_blobs_test_suite; + xml_empty_blobs_test_suite; + xml_empty_lists_test_suite; + xml_empty_maps_test_suite; + xml_empty_strings_test_suite; + xml_enums_test_suite; + xml_int_enums_test_suite; + xml_lists_test_suite; + xml_map_with_xml_namespace_test_suite; + xml_maps_test_suite; + xml_maps_xml_name_test_suite; + xml_namespaces_test_suite; + xml_timestamps_test_suite; + xml_unions_test_suite; + ] diff --git a/model_tests/protocols/restxml/restxml.ml b/model_tests/protocols/restxml/restxml.ml new file mode 100644 index 00000000..20784e70 --- /dev/null +++ b/model_tests/protocols/restxml/restxml.ml @@ -0,0 +1,5 @@ +module Types = Types +include Builders +include Operations +module Xml_serializers = Xml_serializers +module Xml_deserializers = Xml_deserializers diff --git a/model_tests/protocols/restxml/service.ml b/model_tests/protocols/restxml/service.ml new file mode 100644 index 00000000..e69de29b diff --git a/model_tests/protocols/restxml/service_metadata.ml b/model_tests/protocols/restxml/service_metadata.ml new file mode 100644 index 00000000..2b923da0 --- /dev/null +++ b/model_tests/protocols/restxml/service_metadata.ml @@ -0,0 +1,8 @@ +let service = + let open Smaws_Lib.Service in + { + namespace = ""; + endpointPrefix = ""; + version = "2019-12-16"; + protocol = Smaws_Lib.Service.RestXml; + } diff --git a/model_tests/protocols/restxml/service_metadata.mli b/model_tests/protocols/restxml/service_metadata.mli new file mode 100644 index 00000000..c6925d79 --- /dev/null +++ b/model_tests/protocols/restxml/service_metadata.mli @@ -0,0 +1 @@ +val service : Smaws_Lib.Service.descriptor diff --git a/model_tests/protocols/restxml/types.ml b/model_tests/protocols/restxml/types.ml new file mode 100644 index 00000000..36f449c0 --- /dev/null +++ b/model_tests/protocols/restxml/types.ml @@ -0,0 +1,820 @@ +type xml_nested_union_struct = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_union_shape = + | StructValue of xml_nested_union_struct [@ocaml.doc ""] + | UnionValue of xml_union_shape [@ocaml.doc ""] + | DoubleValue of Smaws_Lib.Smithy_api.Types.double [@ocaml.doc ""] + | FloatValue of Smaws_Lib.Smithy_api.Types.float_ [@ocaml.doc ""] + | LongValue of Smaws_Lib.Smithy_api.Types.long [@ocaml.doc ""] + | IntegerValue of Smaws_Lib.Smithy_api.Types.integer [@ocaml.doc ""] + | ShortValue of Smaws_Lib.Smithy_api.Types.short [@ocaml.doc ""] + | ByteValue of Smaws_Lib.Smithy_api.Types.byte [@ocaml.doc ""] + | BooleanValue of Smaws_Lib.Smithy_api.Types.boolean_ [@ocaml.doc ""] + | StringValue of Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_unions_response = { union_value : xml_union_shape option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_unions_request = { union_value : xml_union_shape option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_timestamps_response = { + http_date_on_target : Shared.Types.http_date option; [@ocaml.doc ""] + http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + epoch_seconds_on_target : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + date_time_on_target : Shared.Types.date_time option; [@ocaml.doc ""] + date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + normal : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_timestamps_request = { + http_date_on_target : Shared.Types.http_date option; [@ocaml.doc ""] + http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + epoch_seconds_on_target : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + date_time_on_target : Shared.Types.date_time option; [@ocaml.doc ""] + date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + normal : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_timestamps_input_output = { + http_date_on_target : Shared.Types.http_date option; [@ocaml.doc ""] + http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + epoch_seconds_on_target : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + date_time_on_target : Shared.Types.date_time option; [@ocaml.doc ""] + date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + normal : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaced_list = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespace_nested = { + values : xml_namespaced_list option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaces_response = { nested : xml_namespace_nested option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaces_request = { nested : xml_namespace_nested option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaces_input_output = { nested : xml_namespace_nested option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_xml_name_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Shared.Types.greeting_struct) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_xml_name_response = { + my_map : xml_maps_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_xml_name_request = { + my_map : xml_maps_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Shared.Types.greeting_struct) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_response = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_request = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_response = { + my_map : xml_map_with_xml_namespace_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_request = { + my_map : xml_map_with_xml_namespace_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_input_output = { + my_map : xml_map_with_xml_namespace_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type renamed_list_members = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type list_with_member_namespace = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type list_with_namespace = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type structure_list_member = { + b : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + a : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type structure_list = structure_list_member list [@@ocaml.doc ""] [@@deriving show, eq] + +type xml_lists_response = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_lists_request = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_lists_input_output = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_int_enums_response = { + int_enum_map : Shared.Types.integer_enum_map option; [@ocaml.doc ""] + int_enum_set : Shared.Types.integer_enum_set option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + int_enum3 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum2 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum1 : Shared.Types.integer_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_int_enums_request = { + int_enum_map : Shared.Types.integer_enum_map option; [@ocaml.doc ""] + int_enum_set : Shared.Types.integer_enum_set option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + int_enum3 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum2 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum1 : Shared.Types.integer_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_int_enums_input_output = { + int_enum_map : Shared.Types.integer_enum_map option; [@ocaml.doc ""] + int_enum_set : Shared.Types.integer_enum_set option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + int_enum3 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum2 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum1 : Shared.Types.integer_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_enums_response = { + foo_enum_map : Shared.Types.foo_enum_map option; [@ocaml.doc ""] + foo_enum_set : Shared.Types.foo_enum_set option; [@ocaml.doc ""] + foo_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + foo_enum3 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum2 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum1 : Shared.Types.foo_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_enums_request = { + foo_enum_map : Shared.Types.foo_enum_map option; [@ocaml.doc ""] + foo_enum_set : Shared.Types.foo_enum_set option; [@ocaml.doc ""] + foo_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + foo_enum3 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum2 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum1 : Shared.Types.foo_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_enums_input_output = { + foo_enum_map : Shared.Types.foo_enum_map option; [@ocaml.doc ""] + foo_enum_set : Shared.Types.foo_enum_set option; [@ocaml.doc ""] + foo_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + foo_enum3 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum2 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum1 : Shared.Types.foo_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_strings_response = { + empty_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_strings_request = { + empty_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_maps_response = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_maps_request = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_lists_response = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_lists_request = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_blobs_response = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_blobs_request = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_blobs_response = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_blobs_request = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_response = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_request = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_payload_response = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_payload_request = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_on_payload_response = { + payload : xml_attributes_payload_response option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_on_payload_request = { + payload : xml_attributes_payload_request option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_middle_member_input_output = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_input_output = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_payload_response = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_response = { + payload : xml_attributes_in_middle_payload_response option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_payload_request = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_request = { + payload : xml_attributes_in_middle_payload_request option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type union_payload = Greeting of Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] +[@@ocaml.doc ""] [@@deriving show, eq] + +type timestamp_format_headers_i_o = { + target_date_time : Shared.Types.date_time option; [@ocaml.doc ""] + target_http_date : Shared.Types.http_date option; [@ocaml.doc ""] + target_epoch_seconds : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + default_format : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + member_date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + member_http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + member_epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type string_payload_input = { payload : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type string_enum = V [@ocaml.doc ""] [@@ocaml.doc ""] [@@deriving show, eq] + +type simple_scalar_properties_response = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + false_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + true_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type simple_scalar_properties_request = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + false_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + true_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type simple_scalar_properties_input_output = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + false_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + true_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type recursive_shapes_input_output_nested1 = { + nested : recursive_shapes_input_output_nested2 option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +and recursive_shapes_input_output_nested2 = { + recursive_member : recursive_shapes_input_output_nested1 option; [@ocaml.doc ""] + bar : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type recursive_shapes_response = { + nested : recursive_shapes_input_output_nested1 option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type recursive_shapes_request = { + nested : recursive_shapes_input_output_nested1 option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type query_precedence_input = { + baz : Shared.Types.string_map option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type query_params_as_string_list_map_input = { + foo : Shared.Types.string_list_map option; [@ocaml.doc ""] + qux : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type query_idempotency_token_auto_fill_input = { + token : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type put_with_content_encoding_input = { + data : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + encoding : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type omits_null_serializes_empty_string_input = { + empty_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + null_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type null_and_empty_headers_i_o = { + c : Shared.Types.string_list option; [@ocaml.doc ""] + b : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + a : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type no_input_and_output_output = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_inner_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_map = + (Smaws_Lib.Smithy_api.Types.string_ * nested_xml_map_with_xml_name_inner_map) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_response = { + nested_xml_map_with_xml_name_map : nested_xml_map_with_xml_name_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_request = { + nested_xml_map_with_xml_name_map : nested_xml_map_with_xml_name_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_map = (Smaws_Lib.Smithy_api.Types.string_ * Shared.Types.foo_enum_map) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_maps_response = { + flat_nested_map : nested_map option; [@ocaml.doc ""] + nested_map : nested_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_maps_request = { + flat_nested_map : nested_map option; [@ocaml.doc ""] + nested_map : nested_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type input_and_output_with_headers_i_o = { + header_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + header_enum : Shared.Types.foo_enum option; [@ocaml.doc ""] + header_timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + header_boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + header_integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + header_string_set : Shared.Types.string_set option; [@ocaml.doc ""] + header_string_list : Shared.Types.string_list option; [@ocaml.doc ""] + header_false_bool : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + header_true_bool : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + header_double : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + header_float : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + header_long : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + header_integer : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + header_short : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + header_byte : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + header_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type ignore_query_params_in_response_output = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_response_code_output = { + status : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_labels_and_timestamp_format_input = { + target_date_time : Shared.Types.date_time; [@ocaml.doc ""] + target_http_date : Shared.Types.http_date; [@ocaml.doc ""] + target_epoch_seconds : Shared.Types.epoch_seconds; [@ocaml.doc ""] + default_format : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] + member_date_time : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] + member_http_date : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] + member_epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_labels_input = { + timestamp : Smaws_Lib.Smithy_api.Types.timestamp; + [@ocaml.doc + "Note that this member has no format, so it's serialized as an RFC 3399 date-time."] + boolean_ : Smaws_Lib.Smithy_api.Types.boolean_; + [@ocaml.doc "Serialized in the path as true or false."] + double : Smaws_Lib.Smithy_api.Types.double; [@ocaml.doc ""] + float_ : Smaws_Lib.Smithy_api.Types.float_; [@ocaml.doc ""] + long : Smaws_Lib.Smithy_api.Types.long; [@ocaml.doc ""] + integer : Smaws_Lib.Smithy_api.Types.integer; [@ocaml.doc ""] + short : Smaws_Lib.Smithy_api.Types.short; [@ocaml.doc ""] + string_ : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_greedy_label_in_path_input = { + baz : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_float_labels_input = { + double : Smaws_Lib.Smithy_api.Types.double; [@ocaml.doc ""] + float_ : Smaws_Lib.Smithy_api.Types.float_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type foo_prefix_headers = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_prefix_headers_input_output = { + foo_map : foo_prefix_headers option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type payload_with_xml_namespace_and_prefix = { + name : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_xml_namespace_and_prefix_input_output = { + nested : payload_with_xml_namespace_and_prefix option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type payload_with_xml_namespace = { + name : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_xml_namespace_input_output = { + nested : payload_with_xml_namespace option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type payload_with_xml_name = { name : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_xml_name_input_output = { + nested : payload_with_xml_name option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_union_input_output = { nested : union_payload option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_payload = { + name : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + greeting : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_structure_input_output = { nested : nested_payload option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_member_xml_name_input_output = { + nested : payload_with_xml_name option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_traits_with_media_type_input_output = { + blob : Shared.Types.text_plain_blob option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_traits_input_output = { + blob : Smaws_Lib.Smithy_api.Types.blob option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type enum_payload_input = { payload : string_enum option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_empty_prefix_headers_output = { + specific_header : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + prefix_headers : Shared.Types.string_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_empty_prefix_headers_input = { + specific_header : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + prefix_headers : Shared.Types.string_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type invalid_greeting = { message : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc "This error is thrown when an invalid greeting value is provided."] +[@@deriving show, eq] + +type complex_nested_error_data = { foo : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type complex_error = { + nested : complex_nested_error_data option; [@ocaml.doc ""] + top_level : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + header : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc "This error is thrown when a request is invalid."] [@@deriving show, eq] + +type greeting_with_errors_output = { + greeting : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type fractional_seconds_output = { datetime : Shared.Types.date_time option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_namespace_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_namespace_output = { + my_map : flattened_xml_map_with_xml_namespace_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_name_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_name_response = { + my_map : flattened_xml_map_with_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_name_request = { + my_map : flattened_xml_map_with_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_response = { my_map : Shared.Types.foo_enum_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_request = { my_map : Shared.Types.foo_enum_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type endpoint_with_host_label_operation_request = { + label : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type host_label_header_input = { account_id : Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type empty_input_and_empty_output_output = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type empty_input_and_empty_output_input = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type datetime_offsets_output = { datetime : Shared.Types.date_time option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type content_type_parameters_output = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type content_type_parameters_input = { + value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type constant_query_string_input = { hello : Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type constant_and_variable_query_string_input = { + maybe_set : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type body_with_xml_name_input_output = { nested : payload_with_xml_name option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type all_query_string_types_input = { + query_params_map_of_strings : Shared.Types.string_map option; [@ocaml.doc ""] + query_integer_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + query_integer_enum : Shared.Types.integer_enum option; [@ocaml.doc ""] + query_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + query_enum : Shared.Types.foo_enum option; [@ocaml.doc ""] + query_timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + query_timestamp : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + query_boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + query_boolean : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + query_double_list : Shared.Types.double_list option; [@ocaml.doc ""] + query_double : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + query_float : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + query_long : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + query_integer_set : Shared.Types.integer_set option; [@ocaml.doc ""] + query_integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + query_integer : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + query_short : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + query_byte : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + query_string_set : Shared.Types.string_set option; [@ocaml.doc ""] + query_string_list : Shared.Types.string_list option; [@ocaml.doc ""] + query_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_maps_input_output = { + flat_nested_map : nested_map option; [@ocaml.doc ""] + nested_map : nested_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_input_output = { + nested_xml_map_with_xml_name_map : nested_xml_map_with_xml_name_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] diff --git a/model_tests/protocols/restxml/types.mli b/model_tests/protocols/restxml/types.mli new file mode 100644 index 00000000..36f449c0 --- /dev/null +++ b/model_tests/protocols/restxml/types.mli @@ -0,0 +1,820 @@ +type xml_nested_union_struct = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_union_shape = + | StructValue of xml_nested_union_struct [@ocaml.doc ""] + | UnionValue of xml_union_shape [@ocaml.doc ""] + | DoubleValue of Smaws_Lib.Smithy_api.Types.double [@ocaml.doc ""] + | FloatValue of Smaws_Lib.Smithy_api.Types.float_ [@ocaml.doc ""] + | LongValue of Smaws_Lib.Smithy_api.Types.long [@ocaml.doc ""] + | IntegerValue of Smaws_Lib.Smithy_api.Types.integer [@ocaml.doc ""] + | ShortValue of Smaws_Lib.Smithy_api.Types.short [@ocaml.doc ""] + | ByteValue of Smaws_Lib.Smithy_api.Types.byte [@ocaml.doc ""] + | BooleanValue of Smaws_Lib.Smithy_api.Types.boolean_ [@ocaml.doc ""] + | StringValue of Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_unions_response = { union_value : xml_union_shape option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_unions_request = { union_value : xml_union_shape option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_timestamps_response = { + http_date_on_target : Shared.Types.http_date option; [@ocaml.doc ""] + http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + epoch_seconds_on_target : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + date_time_on_target : Shared.Types.date_time option; [@ocaml.doc ""] + date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + normal : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_timestamps_request = { + http_date_on_target : Shared.Types.http_date option; [@ocaml.doc ""] + http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + epoch_seconds_on_target : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + date_time_on_target : Shared.Types.date_time option; [@ocaml.doc ""] + date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + normal : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_timestamps_input_output = { + http_date_on_target : Shared.Types.http_date option; [@ocaml.doc ""] + http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + epoch_seconds_on_target : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + date_time_on_target : Shared.Types.date_time option; [@ocaml.doc ""] + date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + normal : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaced_list = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespace_nested = { + values : xml_namespaced_list option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaces_response = { nested : xml_namespace_nested option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaces_request = { nested : xml_namespace_nested option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_namespaces_input_output = { nested : xml_namespace_nested option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_xml_name_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Shared.Types.greeting_struct) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_xml_name_response = { + my_map : xml_maps_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_xml_name_request = { + my_map : xml_maps_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Shared.Types.greeting_struct) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_response = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_maps_request = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_response = { + my_map : xml_map_with_xml_namespace_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_request = { + my_map : xml_map_with_xml_namespace_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_map_with_xml_namespace_input_output = { + my_map : xml_map_with_xml_namespace_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type renamed_list_members = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type list_with_member_namespace = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type list_with_namespace = Smaws_Lib.Smithy_api.Types.string_ list +[@@ocaml.doc ""] [@@deriving show, eq] + +type structure_list_member = { + b : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + a : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type structure_list = structure_list_member list [@@ocaml.doc ""] [@@deriving show, eq] + +type xml_lists_response = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_lists_request = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_lists_input_output = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_int_enums_response = { + int_enum_map : Shared.Types.integer_enum_map option; [@ocaml.doc ""] + int_enum_set : Shared.Types.integer_enum_set option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + int_enum3 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum2 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum1 : Shared.Types.integer_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_int_enums_request = { + int_enum_map : Shared.Types.integer_enum_map option; [@ocaml.doc ""] + int_enum_set : Shared.Types.integer_enum_set option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + int_enum3 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum2 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum1 : Shared.Types.integer_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_int_enums_input_output = { + int_enum_map : Shared.Types.integer_enum_map option; [@ocaml.doc ""] + int_enum_set : Shared.Types.integer_enum_set option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + int_enum3 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum2 : Shared.Types.integer_enum option; [@ocaml.doc ""] + int_enum1 : Shared.Types.integer_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_enums_response = { + foo_enum_map : Shared.Types.foo_enum_map option; [@ocaml.doc ""] + foo_enum_set : Shared.Types.foo_enum_set option; [@ocaml.doc ""] + foo_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + foo_enum3 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum2 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum1 : Shared.Types.foo_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_enums_request = { + foo_enum_map : Shared.Types.foo_enum_map option; [@ocaml.doc ""] + foo_enum_set : Shared.Types.foo_enum_set option; [@ocaml.doc ""] + foo_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + foo_enum3 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum2 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum1 : Shared.Types.foo_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_enums_input_output = { + foo_enum_map : Shared.Types.foo_enum_map option; [@ocaml.doc ""] + foo_enum_set : Shared.Types.foo_enum_set option; [@ocaml.doc ""] + foo_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + foo_enum3 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum2 : Shared.Types.foo_enum option; [@ocaml.doc ""] + foo_enum1 : Shared.Types.foo_enum option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_strings_response = { + empty_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_strings_request = { + empty_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_maps_response = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_maps_request = { my_map : xml_maps_input_output_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_lists_response = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_lists_request = { + flattened_structure_list : structure_list option; [@ocaml.doc ""] + structure_list : structure_list option; [@ocaml.doc ""] + flattened_list_with_namespace : list_with_namespace option; [@ocaml.doc ""] + flattened_list_with_member_namespace : list_with_member_namespace option; [@ocaml.doc ""] + flattened_list2 : renamed_list_members option; [@ocaml.doc ""] + flattened_list : renamed_list_members option; [@ocaml.doc ""] + renamed_list_members : renamed_list_members option; [@ocaml.doc ""] + nested_string_list : Shared.Types.nested_string_list option; [@ocaml.doc ""] + int_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + string_set : Shared.Types.string_set option; [@ocaml.doc ""] + string_list : Shared.Types.string_list option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_blobs_response = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_empty_blobs_request = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_blobs_response = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_blobs_request = { data : Smaws_Lib.Smithy_api.Types.blob option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_response = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_request = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_payload_response = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_payload_request = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_on_payload_response = { + payload : xml_attributes_payload_response option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_on_payload_request = { + payload : xml_attributes_payload_request option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_middle_member_input_output = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_input_output = { + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_payload_response = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_response = { + payload : xml_attributes_in_middle_payload_response option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_payload_request = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + attr : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type xml_attributes_in_middle_request = { + payload : xml_attributes_in_middle_payload_request option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type union_payload = Greeting of Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] +[@@ocaml.doc ""] [@@deriving show, eq] + +type timestamp_format_headers_i_o = { + target_date_time : Shared.Types.date_time option; [@ocaml.doc ""] + target_http_date : Shared.Types.http_date option; [@ocaml.doc ""] + target_epoch_seconds : Shared.Types.epoch_seconds option; [@ocaml.doc ""] + default_format : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + member_date_time : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + member_http_date : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + member_epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type string_payload_input = { payload : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type string_enum = V [@ocaml.doc ""] [@@ocaml.doc ""] [@@deriving show, eq] + +type simple_scalar_properties_response = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + false_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + true_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type simple_scalar_properties_request = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + false_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + true_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type simple_scalar_properties_input_output = { + double_value : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + float_value : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + long_value : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + integer_value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + short_value : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + byte_value : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + false_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + true_boolean_value : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + string_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type recursive_shapes_input_output_nested1 = { + nested : recursive_shapes_input_output_nested2 option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +and recursive_shapes_input_output_nested2 = { + recursive_member : recursive_shapes_input_output_nested1 option; [@ocaml.doc ""] + bar : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type recursive_shapes_response = { + nested : recursive_shapes_input_output_nested1 option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type recursive_shapes_request = { + nested : recursive_shapes_input_output_nested1 option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type query_precedence_input = { + baz : Shared.Types.string_map option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type query_params_as_string_list_map_input = { + foo : Shared.Types.string_list_map option; [@ocaml.doc ""] + qux : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type query_idempotency_token_auto_fill_input = { + token : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type put_with_content_encoding_input = { + data : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + encoding : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type omits_null_serializes_empty_string_input = { + empty_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + null_value : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type null_and_empty_headers_i_o = { + c : Shared.Types.string_list option; [@ocaml.doc ""] + b : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + a : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type no_input_and_output_output = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_inner_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_map = + (Smaws_Lib.Smithy_api.Types.string_ * nested_xml_map_with_xml_name_inner_map) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_response = { + nested_xml_map_with_xml_name_map : nested_xml_map_with_xml_name_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_request = { + nested_xml_map_with_xml_name_map : nested_xml_map_with_xml_name_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_map = (Smaws_Lib.Smithy_api.Types.string_ * Shared.Types.foo_enum_map) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_maps_response = { + flat_nested_map : nested_map option; [@ocaml.doc ""] + nested_map : nested_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_maps_request = { + flat_nested_map : nested_map option; [@ocaml.doc ""] + nested_map : nested_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type input_and_output_with_headers_i_o = { + header_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + header_enum : Shared.Types.foo_enum option; [@ocaml.doc ""] + header_timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + header_boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + header_integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + header_string_set : Shared.Types.string_set option; [@ocaml.doc ""] + header_string_list : Shared.Types.string_list option; [@ocaml.doc ""] + header_false_bool : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + header_true_bool : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + header_double : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + header_float : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + header_long : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + header_integer : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + header_short : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + header_byte : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + header_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type ignore_query_params_in_response_output = { + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_response_code_output = { + status : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_labels_and_timestamp_format_input = { + target_date_time : Shared.Types.date_time; [@ocaml.doc ""] + target_http_date : Shared.Types.http_date; [@ocaml.doc ""] + target_epoch_seconds : Shared.Types.epoch_seconds; [@ocaml.doc ""] + default_format : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] + member_date_time : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] + member_http_date : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] + member_epoch_seconds : Smaws_Lib.Smithy_api.Types.timestamp; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_labels_input = { + timestamp : Smaws_Lib.Smithy_api.Types.timestamp; + [@ocaml.doc + "Note that this member has no format, so it's serialized as an RFC 3399 date-time."] + boolean_ : Smaws_Lib.Smithy_api.Types.boolean_; + [@ocaml.doc "Serialized in the path as true or false."] + double : Smaws_Lib.Smithy_api.Types.double; [@ocaml.doc ""] + float_ : Smaws_Lib.Smithy_api.Types.float_; [@ocaml.doc ""] + long : Smaws_Lib.Smithy_api.Types.long; [@ocaml.doc ""] + integer : Smaws_Lib.Smithy_api.Types.integer; [@ocaml.doc ""] + short : Smaws_Lib.Smithy_api.Types.short; [@ocaml.doc ""] + string_ : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_greedy_label_in_path_input = { + baz : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_request_with_float_labels_input = { + double : Smaws_Lib.Smithy_api.Types.double; [@ocaml.doc ""] + float_ : Smaws_Lib.Smithy_api.Types.float_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type foo_prefix_headers = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_prefix_headers_input_output = { + foo_map : foo_prefix_headers option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type payload_with_xml_namespace_and_prefix = { + name : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_xml_namespace_and_prefix_input_output = { + nested : payload_with_xml_namespace_and_prefix option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type payload_with_xml_namespace = { + name : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_xml_namespace_input_output = { + nested : payload_with_xml_namespace option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type payload_with_xml_name = { name : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_xml_name_input_output = { + nested : payload_with_xml_name option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_union_input_output = { nested : union_payload option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_payload = { + name : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + greeting : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_structure_input_output = { nested : nested_payload option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_with_member_xml_name_input_output = { + nested : payload_with_xml_name option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_traits_with_media_type_input_output = { + blob : Shared.Types.text_plain_blob option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_payload_traits_input_output = { + blob : Smaws_Lib.Smithy_api.Types.blob option; [@ocaml.doc ""] + foo : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type enum_payload_input = { payload : string_enum option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_empty_prefix_headers_output = { + specific_header : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + prefix_headers : Shared.Types.string_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type http_empty_prefix_headers_input = { + specific_header : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + prefix_headers : Shared.Types.string_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type invalid_greeting = { message : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc "This error is thrown when an invalid greeting value is provided."] +[@@deriving show, eq] + +type complex_nested_error_data = { foo : Smaws_Lib.Smithy_api.Types.string_ option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type complex_error = { + nested : complex_nested_error_data option; [@ocaml.doc ""] + top_level : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + header : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc "This error is thrown when a request is invalid."] [@@deriving show, eq] + +type greeting_with_errors_output = { + greeting : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type fractional_seconds_output = { datetime : Shared.Types.date_time option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_namespace_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_namespace_output = { + my_map : flattened_xml_map_with_xml_namespace_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_name_input_output_map = + (Smaws_Lib.Smithy_api.Types.string_ * Smaws_Lib.Smithy_api.Types.string_) list +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_name_response = { + my_map : flattened_xml_map_with_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_with_xml_name_request = { + my_map : flattened_xml_map_with_xml_name_input_output_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_response = { my_map : Shared.Types.foo_enum_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type flattened_xml_map_request = { my_map : Shared.Types.foo_enum_map option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type endpoint_with_host_label_operation_request = { + label : Smaws_Lib.Smithy_api.Types.string_; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type host_label_header_input = { account_id : Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type empty_input_and_empty_output_output = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type empty_input_and_empty_output_input = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type datetime_offsets_output = { datetime : Shared.Types.date_time option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type content_type_parameters_output = unit [@@ocaml.doc ""] [@@deriving show, eq] + +type content_type_parameters_input = { + value : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type constant_query_string_input = { hello : Smaws_Lib.Smithy_api.Types.string_ [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type constant_and_variable_query_string_input = { + maybe_set : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] + baz : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type body_with_xml_name_input_output = { nested : payload_with_xml_name option [@ocaml.doc ""] } +[@@ocaml.doc ""] [@@deriving show, eq] + +type all_query_string_types_input = { + query_params_map_of_strings : Shared.Types.string_map option; [@ocaml.doc ""] + query_integer_enum_list : Shared.Types.integer_enum_list option; [@ocaml.doc ""] + query_integer_enum : Shared.Types.integer_enum option; [@ocaml.doc ""] + query_enum_list : Shared.Types.foo_enum_list option; [@ocaml.doc ""] + query_enum : Shared.Types.foo_enum option; [@ocaml.doc ""] + query_timestamp_list : Shared.Types.timestamp_list option; [@ocaml.doc ""] + query_timestamp : Smaws_Lib.Smithy_api.Types.timestamp option; [@ocaml.doc ""] + query_boolean_list : Shared.Types.boolean_list option; [@ocaml.doc ""] + query_boolean : Smaws_Lib.Smithy_api.Types.boolean_ option; [@ocaml.doc ""] + query_double_list : Shared.Types.double_list option; [@ocaml.doc ""] + query_double : Smaws_Lib.Smithy_api.Types.double option; [@ocaml.doc ""] + query_float : Smaws_Lib.Smithy_api.Types.float_ option; [@ocaml.doc ""] + query_long : Smaws_Lib.Smithy_api.Types.long option; [@ocaml.doc ""] + query_integer_set : Shared.Types.integer_set option; [@ocaml.doc ""] + query_integer_list : Shared.Types.integer_list option; [@ocaml.doc ""] + query_integer : Smaws_Lib.Smithy_api.Types.integer option; [@ocaml.doc ""] + query_short : Smaws_Lib.Smithy_api.Types.short option; [@ocaml.doc ""] + query_byte : Smaws_Lib.Smithy_api.Types.byte option; [@ocaml.doc ""] + query_string_set : Shared.Types.string_set option; [@ocaml.doc ""] + query_string_list : Shared.Types.string_list option; [@ocaml.doc ""] + query_string : Smaws_Lib.Smithy_api.Types.string_ option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_maps_input_output = { + flat_nested_map : nested_map option; [@ocaml.doc ""] + nested_map : nested_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] + +type nested_xml_map_with_xml_name_input_output = { + nested_xml_map_with_xml_name_map : nested_xml_map_with_xml_name_map option; [@ocaml.doc ""] +} +[@@ocaml.doc ""] [@@deriving show, eq] diff --git a/model_tests/protocols/restxml/xml_deserializers.ml b/model_tests/protocols/restxml/xml_deserializers.ml new file mode 100644 index 00000000..b38097fe --- /dev/null +++ b/model_tests/protocols/restxml/xml_deserializers.ml @@ -0,0 +1,3390 @@ +open Smaws_Lib.Xml.Parse +open Types + +let unit_of_xml _ = () + +let xml_nested_union_struct_of_xml i = + let r_double_value = ref None in + let r_float_value = ref None in + let r_long_value = ref None in + let r_integer_value = ref None in + let r_short_value = ref None in + let r_byte_value = ref None in + let r_boolean_value = ref None in + let r_string_value = ref None in + Structure.scanSequence i + [ + "doubleValue"; + "floatValue"; + "longValue"; + "integerValue"; + "shortValue"; + "byteValue"; + "booleanValue"; + "stringValue"; + ] (fun tag _ -> + match tag with + | "doubleValue" -> + r_double_value := Some (Read.element_value i "doubleValue" Primitive.double_of_string ()) + | "floatValue" -> + r_float_value := Some (Read.element_value i "floatValue" Primitive.float_of_string ()) + | "longValue" -> + r_long_value := Some (Read.element_value i "longValue" Primitive.long_of_string ()) + | "integerValue" -> + r_integer_value := Some (Read.element_value i "integerValue" Primitive.int_of_string ()) + | "shortValue" -> + r_short_value := Some (Read.element_value i "shortValue" Primitive.int_of_string ()) + | "byteValue" -> + r_byte_value := Some (Read.element_value i "byteValue" Primitive.int_of_string ()) + | "booleanValue" -> + r_boolean_value := Some (Read.element_value i "booleanValue" Primitive.bool_of_string ()) + | "stringValue" -> r_string_value := Some (Read.element_value i "stringValue" Fun.id ()) + | _ -> Read.skip_element i); + ({ + double_value = ( ! ) r_double_value; + float_value = ( ! ) r_float_value; + long_value = ( ! ) r_long_value; + integer_value = ( ! ) r_integer_value; + short_value = ( ! ) r_short_value; + byte_value = ( ! ) r_byte_value; + boolean_value = ( ! ) r_boolean_value; + string_value = ( ! ) r_string_value; + } + : xml_nested_union_struct) + +let rec xml_union_shape_of_xml i = + let r_struct_value = ref None in + let r_union_value = ref None in + let r_double_value = ref None in + let r_float_value = ref None in + let r_long_value = ref None in + let r_integer_value = ref None in + let r_short_value = ref None in + let r_byte_value = ref None in + let r_boolean_value = ref None in + let r_string_value = ref None in + Structure.scanSequence i + [ + "structValue"; + "unionValue"; + "doubleValue"; + "floatValue"; + "longValue"; + "integerValue"; + "shortValue"; + "byteValue"; + "booleanValue"; + "stringValue"; + ] (fun tag _ -> + match tag with + | "structValue" -> + r_struct_value := + Some (Read.sequence i "structValue" (fun i _ -> xml_nested_union_struct_of_xml i) ()) + | "unionValue" -> + r_union_value := + Some (Read.sequence i "unionValue" (fun i _ -> xml_union_shape_of_xml i) ()) + | "doubleValue" -> + r_double_value := Some (Read.element_value i "doubleValue" Primitive.double_of_string ()) + | "floatValue" -> + r_float_value := Some (Read.element_value i "floatValue" Primitive.float_of_string ()) + | "longValue" -> + r_long_value := Some (Read.element_value i "longValue" Primitive.long_of_string ()) + | "integerValue" -> + r_integer_value := Some (Read.element_value i "integerValue" Primitive.int_of_string ()) + | "shortValue" -> + r_short_value := Some (Read.element_value i "shortValue" Primitive.int_of_string ()) + | "byteValue" -> + r_byte_value := Some (Read.element_value i "byteValue" Primitive.int_of_string ()) + | "booleanValue" -> + r_boolean_value := Some (Read.element_value i "booleanValue" Primitive.bool_of_string ()) + | "stringValue" -> r_string_value := Some (Read.element_value i "stringValue" Fun.id ()) + | _ -> Read.skip_element i); + (match ( ! ) r_struct_value with + | Some v -> StructValue v + | None -> ( + match ( ! ) r_union_value with + | Some v -> UnionValue v + | None -> ( + match ( ! ) r_double_value with + | Some v -> DoubleValue v + | None -> ( + match ( ! ) r_float_value with + | Some v -> FloatValue v + | None -> ( + match ( ! ) r_long_value with + | Some v -> LongValue v + | None -> ( + match ( ! ) r_integer_value with + | Some v -> IntegerValue v + | None -> ( + match ( ! ) r_short_value with + | Some v -> ShortValue v + | None -> ( + match ( ! ) r_byte_value with + | Some v -> ByteValue v + | None -> ( + match ( ! ) r_boolean_value with + | Some v -> BooleanValue v + | None -> ( + match ( ! ) r_string_value with + | Some v -> StringValue v + | None -> failwith "no union member present in xml response") + )))))))) + : xml_union_shape) + +let xml_unions_response_of_xml i = + let r_union_value = ref None in + Structure.scanSequence i [ "unionValue" ] (fun tag _ -> + match tag with + | "unionValue" -> + r_union_value := + Some (Read.sequence i "unionValue" (fun i _ -> xml_union_shape_of_xml i) ()) + | _ -> Read.skip_element i); + ({ union_value = ( ! ) r_union_value } : xml_unions_response) + +let xml_unions_request_of_xml i = + let r_union_value = ref None in + Structure.scanSequence i [ "unionValue" ] (fun tag _ -> + match tag with + | "unionValue" -> + r_union_value := + Some (Read.sequence i "unionValue" (fun i _ -> xml_union_shape_of_xml i) ()) + | _ -> Read.skip_element i); + ({ union_value = ( ! ) r_union_value } : xml_unions_request) + +let xml_timestamps_response_of_xml i = + let r_http_date_on_target = ref None in + let r_http_date = ref None in + let r_epoch_seconds_on_target = ref None in + let r_epoch_seconds = ref None in + let r_date_time_on_target = ref None in + let r_date_time = ref None in + let r_normal = ref None in + Structure.scanSequence i + [ + "httpDateOnTarget"; + "httpDate"; + "epochSecondsOnTarget"; + "epochSeconds"; + "dateTimeOnTarget"; + "dateTime"; + "normal"; + ] (fun tag _ -> + match tag with + | "httpDateOnTarget" -> + r_http_date_on_target := + Some + (Read.sequence i "httpDateOnTarget" + (fun i _ -> Shared.Xml_deserializers.http_date_of_xml i) + ()) + | "httpDate" -> + r_http_date := + Some (Read.element_value i "httpDate" Primitive.timestamp_httpdate_of_string ()) + | "epochSecondsOnTarget" -> + r_epoch_seconds_on_target := + Some + (Read.sequence i "epochSecondsOnTarget" + (fun i _ -> Shared.Xml_deserializers.epoch_seconds_of_xml i) + ()) + | "epochSeconds" -> + r_epoch_seconds := + Some (Read.element_value i "epochSeconds" Primitive.timestamp_epoch_of_string ()) + | "dateTimeOnTarget" -> + r_date_time_on_target := + Some + (Read.sequence i "dateTimeOnTarget" + (fun i _ -> Shared.Xml_deserializers.date_time_of_xml i) + ()) + | "dateTime" -> + r_date_time := Some (Read.element_value i "dateTime" Primitive.timestamp_iso_of_string ()) + | "normal" -> + r_normal := Some (Read.element_value i "normal" Primitive.timestamp_iso_of_string ()) + | _ -> Read.skip_element i); + ({ + http_date_on_target = ( ! ) r_http_date_on_target; + http_date = ( ! ) r_http_date; + epoch_seconds_on_target = ( ! ) r_epoch_seconds_on_target; + epoch_seconds = ( ! ) r_epoch_seconds; + date_time_on_target = ( ! ) r_date_time_on_target; + date_time = ( ! ) r_date_time; + normal = ( ! ) r_normal; + } + : xml_timestamps_response) + +let xml_timestamps_request_of_xml i = + let r_http_date_on_target = ref None in + let r_http_date = ref None in + let r_epoch_seconds_on_target = ref None in + let r_epoch_seconds = ref None in + let r_date_time_on_target = ref None in + let r_date_time = ref None in + let r_normal = ref None in + Structure.scanSequence i + [ + "httpDateOnTarget"; + "httpDate"; + "epochSecondsOnTarget"; + "epochSeconds"; + "dateTimeOnTarget"; + "dateTime"; + "normal"; + ] (fun tag _ -> + match tag with + | "httpDateOnTarget" -> + r_http_date_on_target := + Some + (Read.sequence i "httpDateOnTarget" + (fun i _ -> Shared.Xml_deserializers.http_date_of_xml i) + ()) + | "httpDate" -> + r_http_date := + Some (Read.element_value i "httpDate" Primitive.timestamp_httpdate_of_string ()) + | "epochSecondsOnTarget" -> + r_epoch_seconds_on_target := + Some + (Read.sequence i "epochSecondsOnTarget" + (fun i _ -> Shared.Xml_deserializers.epoch_seconds_of_xml i) + ()) + | "epochSeconds" -> + r_epoch_seconds := + Some (Read.element_value i "epochSeconds" Primitive.timestamp_epoch_of_string ()) + | "dateTimeOnTarget" -> + r_date_time_on_target := + Some + (Read.sequence i "dateTimeOnTarget" + (fun i _ -> Shared.Xml_deserializers.date_time_of_xml i) + ()) + | "dateTime" -> + r_date_time := Some (Read.element_value i "dateTime" Primitive.timestamp_iso_of_string ()) + | "normal" -> + r_normal := Some (Read.element_value i "normal" Primitive.timestamp_iso_of_string ()) + | _ -> Read.skip_element i); + ({ + http_date_on_target = ( ! ) r_http_date_on_target; + http_date = ( ! ) r_http_date; + epoch_seconds_on_target = ( ! ) r_epoch_seconds_on_target; + epoch_seconds = ( ! ) r_epoch_seconds; + date_time_on_target = ( ! ) r_date_time_on_target; + date_time = ( ! ) r_date_time; + normal = ( ! ) r_normal; + } + : xml_timestamps_request) + +let xml_timestamps_input_output_of_xml i = + let r_http_date_on_target = ref None in + let r_http_date = ref None in + let r_epoch_seconds_on_target = ref None in + let r_epoch_seconds = ref None in + let r_date_time_on_target = ref None in + let r_date_time = ref None in + let r_normal = ref None in + Structure.scanSequence i + [ + "httpDateOnTarget"; + "httpDate"; + "epochSecondsOnTarget"; + "epochSeconds"; + "dateTimeOnTarget"; + "dateTime"; + "normal"; + ] (fun tag _ -> + match tag with + | "httpDateOnTarget" -> + r_http_date_on_target := + Some + (Read.sequence i "httpDateOnTarget" + (fun i _ -> Shared.Xml_deserializers.http_date_of_xml i) + ()) + | "httpDate" -> + r_http_date := + Some (Read.element_value i "httpDate" Primitive.timestamp_httpdate_of_string ()) + | "epochSecondsOnTarget" -> + r_epoch_seconds_on_target := + Some + (Read.sequence i "epochSecondsOnTarget" + (fun i _ -> Shared.Xml_deserializers.epoch_seconds_of_xml i) + ()) + | "epochSeconds" -> + r_epoch_seconds := + Some (Read.element_value i "epochSeconds" Primitive.timestamp_epoch_of_string ()) + | "dateTimeOnTarget" -> + r_date_time_on_target := + Some + (Read.sequence i "dateTimeOnTarget" + (fun i _ -> Shared.Xml_deserializers.date_time_of_xml i) + ()) + | "dateTime" -> + r_date_time := Some (Read.element_value i "dateTime" Primitive.timestamp_iso_of_string ()) + | "normal" -> + r_normal := Some (Read.element_value i "normal" Primitive.timestamp_iso_of_string ()) + | _ -> Read.skip_element i); + ({ + http_date_on_target = ( ! ) r_http_date_on_target; + http_date = ( ! ) r_http_date; + epoch_seconds_on_target = ( ! ) r_epoch_seconds_on_target; + epoch_seconds = ( ! ) r_epoch_seconds; + date_time_on_target = ( ! ) r_date_time_on_target; + date_time = ( ! ) r_date_time; + normal = ( ! ) r_normal; + } + : xml_timestamps_input_output) + +let xml_namespaced_list_of_xml i = Read.elements_value i "member" Fun.id () + +let xml_namespace_nested_of_xml i = + let r_values = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "values"; "foo" ] (fun tag _ -> + match tag with + | "values" -> + r_values := + Some (Read.sequence i "values" (fun i _ -> Read.elements_value i "member" Fun.id ()) ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ values = ( ! ) r_values; foo = ( ! ) r_foo } : xml_namespace_nested) + +let xml_namespaces_response_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := Some (Read.sequence i "nested" (fun i _ -> xml_namespace_nested_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : xml_namespaces_response) + +let xml_namespaces_request_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := Some (Read.sequence i "nested" (fun i _ -> xml_namespace_nested_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : xml_namespaces_request) + +let xml_namespaces_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := Some (Read.sequence i "nested" (fun i _ -> xml_namespace_nested_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : xml_namespaces_input_output) + +let xml_maps_xml_name_input_output_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "Attribute" Fun.id () in + let v = + Read.sequence i "Setting" (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) () + in + (k, v)) + () + +let xml_maps_xml_name_response_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequence i "myMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "Attribute" Fun.id () in + let v = + Read.sequence i "Setting" + (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_maps_xml_name_response) + +let xml_maps_xml_name_request_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequence i "myMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "Attribute" Fun.id () in + let v = + Read.sequence i "Setting" + (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_maps_xml_name_request) + +let xml_maps_input_output_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) () + in + (k, v)) + () + +let xml_maps_response_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequence i "myMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_maps_response) + +let xml_maps_request_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequence i "myMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_maps_request) + +let xml_map_with_xml_namespace_input_output_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + () + +let xml_map_with_xml_namespace_response_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "KVP" ] (fun tag _ -> + match tag with + | "KVP" -> + r_my_map := + Some + (Read.sequence i "KVP" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_map_with_xml_namespace_response) + +let xml_map_with_xml_namespace_request_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "KVP" ] (fun tag _ -> + match tag with + | "KVP" -> + r_my_map := + Some + (Read.sequence i "KVP" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_map_with_xml_namespace_request) + +let xml_map_with_xml_namespace_input_output_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "KVP" ] (fun tag _ -> + match tag with + | "KVP" -> + r_my_map := + Some + (Read.sequence i "KVP" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_map_with_xml_namespace_input_output) + +let renamed_list_members_of_xml i = Read.elements_value i "item" Fun.id () +let list_with_member_namespace_of_xml i = Read.elements_value i "member" Fun.id () +let list_with_namespace_of_xml i = Read.elements_value i "member" Fun.id () + +let structure_list_member_of_xml i = + let r_b = ref None in + let r_a = ref None in + Structure.scanSequence i [ "other"; "value" ] (fun tag _ -> + match tag with + | "other" -> r_b := Some (Read.element_value i "other" Fun.id ()) + | "value" -> r_a := Some (Read.element_value i "value" Fun.id ()) + | _ -> Read.skip_element i); + ({ b = ( ! ) r_b; a = ( ! ) r_a } : structure_list_member) + +let structure_list_of_xml i = Read.sequences i "item" (fun i _ -> structure_list_member_of_xml i) () + +let xml_lists_response_of_xml i = + let r_flattened_structure_list = ref None in + let r_structure_list = ref None in + let r_flattened_list_with_namespace = ref None in + let r_flattened_list_with_member_namespace = ref None in + let r_flattened_list2 = ref None in + let r_flattened_list = ref None in + let r_renamed_list_members = ref None in + let r_nested_string_list = ref None in + let r_int_enum_list = ref None in + let r_enum_list = ref None in + let r_timestamp_list = ref None in + let r_boolean_list = ref None in + let r_integer_list = ref None in + let r_string_set = ref None in + let r_string_list = ref None in + Structure.scanSequence i + [ + "flattenedStructureList"; + "myStructureList"; + "flattenedListWithNamespace"; + "flattenedListWithMemberNamespace"; + "customName"; + "flattenedList"; + "renamed"; + "nestedStringList"; + "intEnumList"; + "enumList"; + "timestampList"; + "booleanList"; + "integerList"; + "stringSet"; + "stringList"; + ] (fun tag _ -> + match tag with + | "flattenedStructureList" -> + r_flattened_structure_list := + Some + (Read.sequences i "flattenedStructureList" + (fun i _ -> structure_list_member_of_xml i) + ()) + | "myStructureList" -> + r_structure_list := + Some + (Read.sequence i "myStructureList" + (fun i _ -> Read.sequences i "item" (fun i _ -> structure_list_member_of_xml i) ()) + ()) + | "flattenedListWithNamespace" -> + r_flattened_list_with_namespace := + Some (Read.elements_value i "flattenedListWithNamespace" Fun.id ()) + | "flattenedListWithMemberNamespace" -> + r_flattened_list_with_member_namespace := + Some (Read.elements_value i "flattenedListWithMemberNamespace" Fun.id ()) + | "customName" -> r_flattened_list2 := Some (Read.elements_value i "customName" Fun.id ()) + | "flattenedList" -> + r_flattened_list := Some (Read.elements_value i "flattenedList" Fun.id ()) + | "renamed" -> + r_renamed_list_members := + Some (Read.sequence i "renamed" (fun i _ -> Read.elements_value i "item" Fun.id ()) ()) + | "nestedStringList" -> + r_nested_string_list := + Some + (Read.sequence i "nestedStringList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.string_list_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "enumList" -> + r_enum_list := + Some + (Read.sequence i "enumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "timestampList" -> + r_timestamp_list := + Some + (Read.sequence i "timestampList" + (fun i _ -> Read.elements_value i "member" Primitive.timestamp_iso_of_string ()) + ()) + | "booleanList" -> + r_boolean_list := + Some + (Read.sequence i "booleanList" + (fun i _ -> Read.elements_value i "member" Primitive.bool_of_string ()) + ()) + | "integerList" -> + r_integer_list := + Some + (Read.sequence i "integerList" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "stringSet" -> + r_string_set := + Some + (Read.sequence i "stringSet" (fun i _ -> Read.elements_value i "member" Fun.id ()) ()) + | "stringList" -> + r_string_list := + Some + (Read.sequence i "stringList" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | _ -> Read.skip_element i); + ({ + flattened_structure_list = ( ! ) r_flattened_structure_list; + structure_list = ( ! ) r_structure_list; + flattened_list_with_namespace = ( ! ) r_flattened_list_with_namespace; + flattened_list_with_member_namespace = ( ! ) r_flattened_list_with_member_namespace; + flattened_list2 = ( ! ) r_flattened_list2; + flattened_list = ( ! ) r_flattened_list; + renamed_list_members = ( ! ) r_renamed_list_members; + nested_string_list = ( ! ) r_nested_string_list; + int_enum_list = ( ! ) r_int_enum_list; + enum_list = ( ! ) r_enum_list; + timestamp_list = ( ! ) r_timestamp_list; + boolean_list = ( ! ) r_boolean_list; + integer_list = ( ! ) r_integer_list; + string_set = ( ! ) r_string_set; + string_list = ( ! ) r_string_list; + } + : xml_lists_response) + +let xml_lists_request_of_xml i = + let r_flattened_structure_list = ref None in + let r_structure_list = ref None in + let r_flattened_list_with_namespace = ref None in + let r_flattened_list_with_member_namespace = ref None in + let r_flattened_list2 = ref None in + let r_flattened_list = ref None in + let r_renamed_list_members = ref None in + let r_nested_string_list = ref None in + let r_int_enum_list = ref None in + let r_enum_list = ref None in + let r_timestamp_list = ref None in + let r_boolean_list = ref None in + let r_integer_list = ref None in + let r_string_set = ref None in + let r_string_list = ref None in + Structure.scanSequence i + [ + "flattenedStructureList"; + "myStructureList"; + "flattenedListWithNamespace"; + "flattenedListWithMemberNamespace"; + "customName"; + "flattenedList"; + "renamed"; + "nestedStringList"; + "intEnumList"; + "enumList"; + "timestampList"; + "booleanList"; + "integerList"; + "stringSet"; + "stringList"; + ] (fun tag _ -> + match tag with + | "flattenedStructureList" -> + r_flattened_structure_list := + Some + (Read.sequences i "flattenedStructureList" + (fun i _ -> structure_list_member_of_xml i) + ()) + | "myStructureList" -> + r_structure_list := + Some + (Read.sequence i "myStructureList" + (fun i _ -> Read.sequences i "item" (fun i _ -> structure_list_member_of_xml i) ()) + ()) + | "flattenedListWithNamespace" -> + r_flattened_list_with_namespace := + Some (Read.elements_value i "flattenedListWithNamespace" Fun.id ()) + | "flattenedListWithMemberNamespace" -> + r_flattened_list_with_member_namespace := + Some (Read.elements_value i "flattenedListWithMemberNamespace" Fun.id ()) + | "customName" -> r_flattened_list2 := Some (Read.elements_value i "customName" Fun.id ()) + | "flattenedList" -> + r_flattened_list := Some (Read.elements_value i "flattenedList" Fun.id ()) + | "renamed" -> + r_renamed_list_members := + Some (Read.sequence i "renamed" (fun i _ -> Read.elements_value i "item" Fun.id ()) ()) + | "nestedStringList" -> + r_nested_string_list := + Some + (Read.sequence i "nestedStringList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.string_list_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "enumList" -> + r_enum_list := + Some + (Read.sequence i "enumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "timestampList" -> + r_timestamp_list := + Some + (Read.sequence i "timestampList" + (fun i _ -> Read.elements_value i "member" Primitive.timestamp_iso_of_string ()) + ()) + | "booleanList" -> + r_boolean_list := + Some + (Read.sequence i "booleanList" + (fun i _ -> Read.elements_value i "member" Primitive.bool_of_string ()) + ()) + | "integerList" -> + r_integer_list := + Some + (Read.sequence i "integerList" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "stringSet" -> + r_string_set := + Some + (Read.sequence i "stringSet" (fun i _ -> Read.elements_value i "member" Fun.id ()) ()) + | "stringList" -> + r_string_list := + Some + (Read.sequence i "stringList" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | _ -> Read.skip_element i); + ({ + flattened_structure_list = ( ! ) r_flattened_structure_list; + structure_list = ( ! ) r_structure_list; + flattened_list_with_namespace = ( ! ) r_flattened_list_with_namespace; + flattened_list_with_member_namespace = ( ! ) r_flattened_list_with_member_namespace; + flattened_list2 = ( ! ) r_flattened_list2; + flattened_list = ( ! ) r_flattened_list; + renamed_list_members = ( ! ) r_renamed_list_members; + nested_string_list = ( ! ) r_nested_string_list; + int_enum_list = ( ! ) r_int_enum_list; + enum_list = ( ! ) r_enum_list; + timestamp_list = ( ! ) r_timestamp_list; + boolean_list = ( ! ) r_boolean_list; + integer_list = ( ! ) r_integer_list; + string_set = ( ! ) r_string_set; + string_list = ( ! ) r_string_list; + } + : xml_lists_request) + +let xml_lists_input_output_of_xml i = + let r_flattened_structure_list = ref None in + let r_structure_list = ref None in + let r_flattened_list_with_namespace = ref None in + let r_flattened_list_with_member_namespace = ref None in + let r_flattened_list2 = ref None in + let r_flattened_list = ref None in + let r_renamed_list_members = ref None in + let r_nested_string_list = ref None in + let r_int_enum_list = ref None in + let r_enum_list = ref None in + let r_timestamp_list = ref None in + let r_boolean_list = ref None in + let r_integer_list = ref None in + let r_string_set = ref None in + let r_string_list = ref None in + Structure.scanSequence i + [ + "flattenedStructureList"; + "myStructureList"; + "flattenedListWithNamespace"; + "flattenedListWithMemberNamespace"; + "customName"; + "flattenedList"; + "renamed"; + "nestedStringList"; + "intEnumList"; + "enumList"; + "timestampList"; + "booleanList"; + "integerList"; + "stringSet"; + "stringList"; + ] (fun tag _ -> + match tag with + | "flattenedStructureList" -> + r_flattened_structure_list := + Some + (Read.sequences i "flattenedStructureList" + (fun i _ -> structure_list_member_of_xml i) + ()) + | "myStructureList" -> + r_structure_list := + Some + (Read.sequence i "myStructureList" + (fun i _ -> Read.sequences i "item" (fun i _ -> structure_list_member_of_xml i) ()) + ()) + | "flattenedListWithNamespace" -> + r_flattened_list_with_namespace := + Some (Read.elements_value i "flattenedListWithNamespace" Fun.id ()) + | "flattenedListWithMemberNamespace" -> + r_flattened_list_with_member_namespace := + Some (Read.elements_value i "flattenedListWithMemberNamespace" Fun.id ()) + | "customName" -> r_flattened_list2 := Some (Read.elements_value i "customName" Fun.id ()) + | "flattenedList" -> + r_flattened_list := Some (Read.elements_value i "flattenedList" Fun.id ()) + | "renamed" -> + r_renamed_list_members := + Some (Read.sequence i "renamed" (fun i _ -> Read.elements_value i "item" Fun.id ()) ()) + | "nestedStringList" -> + r_nested_string_list := + Some + (Read.sequence i "nestedStringList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.string_list_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "enumList" -> + r_enum_list := + Some + (Read.sequence i "enumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "timestampList" -> + r_timestamp_list := + Some + (Read.sequence i "timestampList" + (fun i _ -> Read.elements_value i "member" Primitive.timestamp_iso_of_string ()) + ()) + | "booleanList" -> + r_boolean_list := + Some + (Read.sequence i "booleanList" + (fun i _ -> Read.elements_value i "member" Primitive.bool_of_string ()) + ()) + | "integerList" -> + r_integer_list := + Some + (Read.sequence i "integerList" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "stringSet" -> + r_string_set := + Some + (Read.sequence i "stringSet" (fun i _ -> Read.elements_value i "member" Fun.id ()) ()) + | "stringList" -> + r_string_list := + Some + (Read.sequence i "stringList" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | _ -> Read.skip_element i); + ({ + flattened_structure_list = ( ! ) r_flattened_structure_list; + structure_list = ( ! ) r_structure_list; + flattened_list_with_namespace = ( ! ) r_flattened_list_with_namespace; + flattened_list_with_member_namespace = ( ! ) r_flattened_list_with_member_namespace; + flattened_list2 = ( ! ) r_flattened_list2; + flattened_list = ( ! ) r_flattened_list; + renamed_list_members = ( ! ) r_renamed_list_members; + nested_string_list = ( ! ) r_nested_string_list; + int_enum_list = ( ! ) r_int_enum_list; + enum_list = ( ! ) r_enum_list; + timestamp_list = ( ! ) r_timestamp_list; + boolean_list = ( ! ) r_boolean_list; + integer_list = ( ! ) r_integer_list; + string_set = ( ! ) r_string_set; + string_list = ( ! ) r_string_list; + } + : xml_lists_input_output) + +let xml_int_enums_response_of_xml i = + let r_int_enum_map = ref None in + let r_int_enum_set = ref None in + let r_int_enum_list = ref None in + let r_int_enum3 = ref None in + let r_int_enum2 = ref None in + let r_int_enum1 = ref None in + Structure.scanSequence i + [ "intEnumMap"; "intEnumSet"; "intEnumList"; "intEnum3"; "intEnum2"; "intEnum1" ] (fun tag _ -> + match tag with + | "intEnumMap" -> + r_int_enum_map := + Some + (Read.sequence i "intEnumMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + () + in + (k, v)) + ()) + ()) + | "intEnumSet" -> + r_int_enum_set := + Some + (Read.sequence i "intEnumSet" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "intEnum3" -> + r_int_enum3 := + Some + (Read.sequence i "intEnum3" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | "intEnum2" -> + r_int_enum2 := + Some + (Read.sequence i "intEnum2" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | "intEnum1" -> + r_int_enum1 := + Some + (Read.sequence i "intEnum1" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ + int_enum_map = ( ! ) r_int_enum_map; + int_enum_set = ( ! ) r_int_enum_set; + int_enum_list = ( ! ) r_int_enum_list; + int_enum3 = ( ! ) r_int_enum3; + int_enum2 = ( ! ) r_int_enum2; + int_enum1 = ( ! ) r_int_enum1; + } + : xml_int_enums_response) + +let xml_int_enums_request_of_xml i = + let r_int_enum_map = ref None in + let r_int_enum_set = ref None in + let r_int_enum_list = ref None in + let r_int_enum3 = ref None in + let r_int_enum2 = ref None in + let r_int_enum1 = ref None in + Structure.scanSequence i + [ "intEnumMap"; "intEnumSet"; "intEnumList"; "intEnum3"; "intEnum2"; "intEnum1" ] (fun tag _ -> + match tag with + | "intEnumMap" -> + r_int_enum_map := + Some + (Read.sequence i "intEnumMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + () + in + (k, v)) + ()) + ()) + | "intEnumSet" -> + r_int_enum_set := + Some + (Read.sequence i "intEnumSet" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "intEnum3" -> + r_int_enum3 := + Some + (Read.sequence i "intEnum3" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | "intEnum2" -> + r_int_enum2 := + Some + (Read.sequence i "intEnum2" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | "intEnum1" -> + r_int_enum1 := + Some + (Read.sequence i "intEnum1" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ + int_enum_map = ( ! ) r_int_enum_map; + int_enum_set = ( ! ) r_int_enum_set; + int_enum_list = ( ! ) r_int_enum_list; + int_enum3 = ( ! ) r_int_enum3; + int_enum2 = ( ! ) r_int_enum2; + int_enum1 = ( ! ) r_int_enum1; + } + : xml_int_enums_request) + +let xml_int_enums_input_output_of_xml i = + let r_int_enum_map = ref None in + let r_int_enum_set = ref None in + let r_int_enum_list = ref None in + let r_int_enum3 = ref None in + let r_int_enum2 = ref None in + let r_int_enum1 = ref None in + Structure.scanSequence i + [ "intEnumMap"; "intEnumSet"; "intEnumList"; "intEnum3"; "intEnum2"; "intEnum1" ] (fun tag _ -> + match tag with + | "intEnumMap" -> + r_int_enum_map := + Some + (Read.sequence i "intEnumMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + () + in + (k, v)) + ()) + ()) + | "intEnumSet" -> + r_int_enum_set := + Some + (Read.sequence i "intEnumSet" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "intEnum3" -> + r_int_enum3 := + Some + (Read.sequence i "intEnum3" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | "intEnum2" -> + r_int_enum2 := + Some + (Read.sequence i "intEnum2" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | "intEnum1" -> + r_int_enum1 := + Some + (Read.sequence i "intEnum1" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ + int_enum_map = ( ! ) r_int_enum_map; + int_enum_set = ( ! ) r_int_enum_set; + int_enum_list = ( ! ) r_int_enum_list; + int_enum3 = ( ! ) r_int_enum3; + int_enum2 = ( ! ) r_int_enum2; + int_enum1 = ( ! ) r_int_enum1; + } + : xml_int_enums_input_output) + +let xml_enums_response_of_xml i = + let r_foo_enum_map = ref None in + let r_foo_enum_set = ref None in + let r_foo_enum_list = ref None in + let r_foo_enum3 = ref None in + let r_foo_enum2 = ref None in + let r_foo_enum1 = ref None in + Structure.scanSequence i + [ "fooEnumMap"; "fooEnumSet"; "fooEnumList"; "fooEnum3"; "fooEnum2"; "fooEnum1" ] (fun tag _ -> + match tag with + | "fooEnumMap" -> + r_foo_enum_map := + Some + (Read.sequence i "fooEnumMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + () + in + (k, v)) + ()) + ()) + | "fooEnumSet" -> + r_foo_enum_set := + Some + (Read.sequence i "fooEnumSet" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "fooEnumList" -> + r_foo_enum_list := + Some + (Read.sequence i "fooEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "fooEnum3" -> + r_foo_enum3 := + Some + (Read.sequence i "fooEnum3" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "fooEnum2" -> + r_foo_enum2 := + Some + (Read.sequence i "fooEnum2" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "fooEnum1" -> + r_foo_enum1 := + Some + (Read.sequence i "fooEnum1" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ + foo_enum_map = ( ! ) r_foo_enum_map; + foo_enum_set = ( ! ) r_foo_enum_set; + foo_enum_list = ( ! ) r_foo_enum_list; + foo_enum3 = ( ! ) r_foo_enum3; + foo_enum2 = ( ! ) r_foo_enum2; + foo_enum1 = ( ! ) r_foo_enum1; + } + : xml_enums_response) + +let xml_enums_request_of_xml i = + let r_foo_enum_map = ref None in + let r_foo_enum_set = ref None in + let r_foo_enum_list = ref None in + let r_foo_enum3 = ref None in + let r_foo_enum2 = ref None in + let r_foo_enum1 = ref None in + Structure.scanSequence i + [ "fooEnumMap"; "fooEnumSet"; "fooEnumList"; "fooEnum3"; "fooEnum2"; "fooEnum1" ] (fun tag _ -> + match tag with + | "fooEnumMap" -> + r_foo_enum_map := + Some + (Read.sequence i "fooEnumMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + () + in + (k, v)) + ()) + ()) + | "fooEnumSet" -> + r_foo_enum_set := + Some + (Read.sequence i "fooEnumSet" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "fooEnumList" -> + r_foo_enum_list := + Some + (Read.sequence i "fooEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "fooEnum3" -> + r_foo_enum3 := + Some + (Read.sequence i "fooEnum3" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "fooEnum2" -> + r_foo_enum2 := + Some + (Read.sequence i "fooEnum2" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "fooEnum1" -> + r_foo_enum1 := + Some + (Read.sequence i "fooEnum1" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ + foo_enum_map = ( ! ) r_foo_enum_map; + foo_enum_set = ( ! ) r_foo_enum_set; + foo_enum_list = ( ! ) r_foo_enum_list; + foo_enum3 = ( ! ) r_foo_enum3; + foo_enum2 = ( ! ) r_foo_enum2; + foo_enum1 = ( ! ) r_foo_enum1; + } + : xml_enums_request) + +let xml_enums_input_output_of_xml i = + let r_foo_enum_map = ref None in + let r_foo_enum_set = ref None in + let r_foo_enum_list = ref None in + let r_foo_enum3 = ref None in + let r_foo_enum2 = ref None in + let r_foo_enum1 = ref None in + Structure.scanSequence i + [ "fooEnumMap"; "fooEnumSet"; "fooEnumList"; "fooEnum3"; "fooEnum2"; "fooEnum1" ] (fun tag _ -> + match tag with + | "fooEnumMap" -> + r_foo_enum_map := + Some + (Read.sequence i "fooEnumMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + () + in + (k, v)) + ()) + ()) + | "fooEnumSet" -> + r_foo_enum_set := + Some + (Read.sequence i "fooEnumSet" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "fooEnumList" -> + r_foo_enum_list := + Some + (Read.sequence i "fooEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "fooEnum3" -> + r_foo_enum3 := + Some + (Read.sequence i "fooEnum3" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "fooEnum2" -> + r_foo_enum2 := + Some + (Read.sequence i "fooEnum2" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "fooEnum1" -> + r_foo_enum1 := + Some + (Read.sequence i "fooEnum1" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ + foo_enum_map = ( ! ) r_foo_enum_map; + foo_enum_set = ( ! ) r_foo_enum_set; + foo_enum_list = ( ! ) r_foo_enum_list; + foo_enum3 = ( ! ) r_foo_enum3; + foo_enum2 = ( ! ) r_foo_enum2; + foo_enum1 = ( ! ) r_foo_enum1; + } + : xml_enums_input_output) + +let xml_empty_strings_response_of_xml i = + let r_empty_string = ref None in + Structure.scanSequence i [ "emptyString" ] (fun tag _ -> + match tag with + | "emptyString" -> r_empty_string := Some (Read.element_value i "emptyString" Fun.id ()) + | _ -> Read.skip_element i); + ({ empty_string = ( ! ) r_empty_string } : xml_empty_strings_response) + +let xml_empty_strings_request_of_xml i = + let r_empty_string = ref None in + Structure.scanSequence i [ "emptyString" ] (fun tag _ -> + match tag with + | "emptyString" -> r_empty_string := Some (Read.element_value i "emptyString" Fun.id ()) + | _ -> Read.skip_element i); + ({ empty_string = ( ! ) r_empty_string } : xml_empty_strings_request) + +let xml_empty_maps_response_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequence i "myMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_empty_maps_response) + +let xml_empty_maps_request_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequence i "myMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.greeting_struct_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : xml_empty_maps_request) + +let xml_empty_lists_response_of_xml i = + let r_flattened_structure_list = ref None in + let r_structure_list = ref None in + let r_flattened_list_with_namespace = ref None in + let r_flattened_list_with_member_namespace = ref None in + let r_flattened_list2 = ref None in + let r_flattened_list = ref None in + let r_renamed_list_members = ref None in + let r_nested_string_list = ref None in + let r_int_enum_list = ref None in + let r_enum_list = ref None in + let r_timestamp_list = ref None in + let r_boolean_list = ref None in + let r_integer_list = ref None in + let r_string_set = ref None in + let r_string_list = ref None in + Structure.scanSequence i + [ + "flattenedStructureList"; + "myStructureList"; + "flattenedListWithNamespace"; + "flattenedListWithMemberNamespace"; + "customName"; + "flattenedList"; + "renamed"; + "nestedStringList"; + "intEnumList"; + "enumList"; + "timestampList"; + "booleanList"; + "integerList"; + "stringSet"; + "stringList"; + ] (fun tag _ -> + match tag with + | "flattenedStructureList" -> + r_flattened_structure_list := + Some + (Read.sequences i "flattenedStructureList" + (fun i _ -> structure_list_member_of_xml i) + ()) + | "myStructureList" -> + r_structure_list := + Some + (Read.sequence i "myStructureList" + (fun i _ -> Read.sequences i "item" (fun i _ -> structure_list_member_of_xml i) ()) + ()) + | "flattenedListWithNamespace" -> + r_flattened_list_with_namespace := + Some (Read.elements_value i "flattenedListWithNamespace" Fun.id ()) + | "flattenedListWithMemberNamespace" -> + r_flattened_list_with_member_namespace := + Some (Read.elements_value i "flattenedListWithMemberNamespace" Fun.id ()) + | "customName" -> r_flattened_list2 := Some (Read.elements_value i "customName" Fun.id ()) + | "flattenedList" -> + r_flattened_list := Some (Read.elements_value i "flattenedList" Fun.id ()) + | "renamed" -> + r_renamed_list_members := + Some (Read.sequence i "renamed" (fun i _ -> Read.elements_value i "item" Fun.id ()) ()) + | "nestedStringList" -> + r_nested_string_list := + Some + (Read.sequence i "nestedStringList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.string_list_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "enumList" -> + r_enum_list := + Some + (Read.sequence i "enumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "timestampList" -> + r_timestamp_list := + Some + (Read.sequence i "timestampList" + (fun i _ -> Read.elements_value i "member" Primitive.timestamp_iso_of_string ()) + ()) + | "booleanList" -> + r_boolean_list := + Some + (Read.sequence i "booleanList" + (fun i _ -> Read.elements_value i "member" Primitive.bool_of_string ()) + ()) + | "integerList" -> + r_integer_list := + Some + (Read.sequence i "integerList" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "stringSet" -> + r_string_set := + Some + (Read.sequence i "stringSet" (fun i _ -> Read.elements_value i "member" Fun.id ()) ()) + | "stringList" -> + r_string_list := + Some + (Read.sequence i "stringList" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | _ -> Read.skip_element i); + ({ + flattened_structure_list = ( ! ) r_flattened_structure_list; + structure_list = ( ! ) r_structure_list; + flattened_list_with_namespace = ( ! ) r_flattened_list_with_namespace; + flattened_list_with_member_namespace = ( ! ) r_flattened_list_with_member_namespace; + flattened_list2 = ( ! ) r_flattened_list2; + flattened_list = ( ! ) r_flattened_list; + renamed_list_members = ( ! ) r_renamed_list_members; + nested_string_list = ( ! ) r_nested_string_list; + int_enum_list = ( ! ) r_int_enum_list; + enum_list = ( ! ) r_enum_list; + timestamp_list = ( ! ) r_timestamp_list; + boolean_list = ( ! ) r_boolean_list; + integer_list = ( ! ) r_integer_list; + string_set = ( ! ) r_string_set; + string_list = ( ! ) r_string_list; + } + : xml_empty_lists_response) + +let xml_empty_lists_request_of_xml i = + let r_flattened_structure_list = ref None in + let r_structure_list = ref None in + let r_flattened_list_with_namespace = ref None in + let r_flattened_list_with_member_namespace = ref None in + let r_flattened_list2 = ref None in + let r_flattened_list = ref None in + let r_renamed_list_members = ref None in + let r_nested_string_list = ref None in + let r_int_enum_list = ref None in + let r_enum_list = ref None in + let r_timestamp_list = ref None in + let r_boolean_list = ref None in + let r_integer_list = ref None in + let r_string_set = ref None in + let r_string_list = ref None in + Structure.scanSequence i + [ + "flattenedStructureList"; + "myStructureList"; + "flattenedListWithNamespace"; + "flattenedListWithMemberNamespace"; + "customName"; + "flattenedList"; + "renamed"; + "nestedStringList"; + "intEnumList"; + "enumList"; + "timestampList"; + "booleanList"; + "integerList"; + "stringSet"; + "stringList"; + ] (fun tag _ -> + match tag with + | "flattenedStructureList" -> + r_flattened_structure_list := + Some + (Read.sequences i "flattenedStructureList" + (fun i _ -> structure_list_member_of_xml i) + ()) + | "myStructureList" -> + r_structure_list := + Some + (Read.sequence i "myStructureList" + (fun i _ -> Read.sequences i "item" (fun i _ -> structure_list_member_of_xml i) ()) + ()) + | "flattenedListWithNamespace" -> + r_flattened_list_with_namespace := + Some (Read.elements_value i "flattenedListWithNamespace" Fun.id ()) + | "flattenedListWithMemberNamespace" -> + r_flattened_list_with_member_namespace := + Some (Read.elements_value i "flattenedListWithMemberNamespace" Fun.id ()) + | "customName" -> r_flattened_list2 := Some (Read.elements_value i "customName" Fun.id ()) + | "flattenedList" -> + r_flattened_list := Some (Read.elements_value i "flattenedList" Fun.id ()) + | "renamed" -> + r_renamed_list_members := + Some (Read.sequence i "renamed" (fun i _ -> Read.elements_value i "item" Fun.id ()) ()) + | "nestedStringList" -> + r_nested_string_list := + Some + (Read.sequence i "nestedStringList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.string_list_of_xml i) + ()) + ()) + | "intEnumList" -> + r_int_enum_list := + Some + (Read.sequence i "intEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "enumList" -> + r_enum_list := + Some + (Read.sequence i "enumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "timestampList" -> + r_timestamp_list := + Some + (Read.sequence i "timestampList" + (fun i _ -> Read.elements_value i "member" Primitive.timestamp_iso_of_string ()) + ()) + | "booleanList" -> + r_boolean_list := + Some + (Read.sequence i "booleanList" + (fun i _ -> Read.elements_value i "member" Primitive.bool_of_string ()) + ()) + | "integerList" -> + r_integer_list := + Some + (Read.sequence i "integerList" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "stringSet" -> + r_string_set := + Some + (Read.sequence i "stringSet" (fun i _ -> Read.elements_value i "member" Fun.id ()) ()) + | "stringList" -> + r_string_list := + Some + (Read.sequence i "stringList" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | _ -> Read.skip_element i); + ({ + flattened_structure_list = ( ! ) r_flattened_structure_list; + structure_list = ( ! ) r_structure_list; + flattened_list_with_namespace = ( ! ) r_flattened_list_with_namespace; + flattened_list_with_member_namespace = ( ! ) r_flattened_list_with_member_namespace; + flattened_list2 = ( ! ) r_flattened_list2; + flattened_list = ( ! ) r_flattened_list; + renamed_list_members = ( ! ) r_renamed_list_members; + nested_string_list = ( ! ) r_nested_string_list; + int_enum_list = ( ! ) r_int_enum_list; + enum_list = ( ! ) r_enum_list; + timestamp_list = ( ! ) r_timestamp_list; + boolean_list = ( ! ) r_boolean_list; + integer_list = ( ! ) r_integer_list; + string_set = ( ! ) r_string_set; + string_list = ( ! ) r_string_list; + } + : xml_empty_lists_request) + +let xml_empty_blobs_response_of_xml i = + let r_data = ref None in + Structure.scanSequence i [ "data" ] (fun tag _ -> + match tag with + | "data" -> r_data := Some (Read.element_value i "data" Primitive.blob_of_string ()) + | _ -> Read.skip_element i); + ({ data = ( ! ) r_data } : xml_empty_blobs_response) + +let xml_empty_blobs_request_of_xml i = + let r_data = ref None in + Structure.scanSequence i [ "data" ] (fun tag _ -> + match tag with + | "data" -> r_data := Some (Read.element_value i "data" Primitive.blob_of_string ()) + | _ -> Read.skip_element i); + ({ data = ( ! ) r_data } : xml_empty_blobs_request) + +let xml_blobs_response_of_xml i = + let r_data = ref None in + Structure.scanSequence i [ "data" ] (fun tag _ -> + match tag with + | "data" -> r_data := Some (Read.element_value i "data" Primitive.blob_of_string ()) + | _ -> Read.skip_element i); + ({ data = ( ! ) r_data } : xml_blobs_response) + +let xml_blobs_request_of_xml i = + let r_data = ref None in + Structure.scanSequence i [ "data" ] (fun tag _ -> + match tag with + | "data" -> r_data := Some (Read.element_value i "data" Primitive.blob_of_string ()) + | _ -> Read.skip_element i); + ({ data = ( ! ) r_data } : xml_blobs_request) + +let xml_attributes_response_of_xml i = + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "test"; "foo" ] (fun tag _ -> + match tag with + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ attr = ( ! ) r_attr; foo = ( ! ) r_foo } : xml_attributes_response) + +let xml_attributes_request_of_xml i = + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "test"; "foo" ] (fun tag _ -> + match tag with + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ attr = ( ! ) r_attr; foo = ( ! ) r_foo } : xml_attributes_request) + +let xml_attributes_payload_response_of_xml i = + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "test"; "foo" ] (fun tag _ -> + match tag with + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ attr = ( ! ) r_attr; foo = ( ! ) r_foo } : xml_attributes_payload_response) + +let xml_attributes_payload_request_of_xml i = + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "test"; "foo" ] (fun tag _ -> + match tag with + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ attr = ( ! ) r_attr; foo = ( ! ) r_foo } : xml_attributes_payload_request) + +let xml_attributes_on_payload_response_of_xml i = + let r_payload = ref None in + Structure.scanSequence i [ "payload" ] (fun tag _ -> + match tag with + | "payload" -> + r_payload := + Some + (Read.sequence i "payload" (fun i _ -> xml_attributes_payload_response_of_xml i) ()) + | _ -> Read.skip_element i); + ({ payload = ( ! ) r_payload } : xml_attributes_on_payload_response) + +let xml_attributes_on_payload_request_of_xml i = + let r_payload = ref None in + Structure.scanSequence i [ "payload" ] (fun tag _ -> + match tag with + | "payload" -> + r_payload := + Some (Read.sequence i "payload" (fun i _ -> xml_attributes_payload_request_of_xml i) ()) + | _ -> Read.skip_element i); + ({ payload = ( ! ) r_payload } : xml_attributes_on_payload_request) + +let xml_attributes_middle_member_input_output_of_xml i = + let r_baz = ref None in + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "baz"; "test"; "foo" ] (fun tag _ -> + match tag with + | "baz" -> r_baz := Some (Read.element_value i "baz" Fun.id ()) + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ baz = ( ! ) r_baz; attr = ( ! ) r_attr; foo = ( ! ) r_foo } + : xml_attributes_middle_member_input_output) + +let xml_attributes_input_output_of_xml i = + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "test"; "foo" ] (fun tag _ -> + match tag with + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ attr = ( ! ) r_attr; foo = ( ! ) r_foo } : xml_attributes_input_output) + +let xml_attributes_in_middle_payload_response_of_xml i = + let r_baz = ref None in + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "baz"; "test"; "foo" ] (fun tag _ -> + match tag with + | "baz" -> r_baz := Some (Read.element_value i "baz" Fun.id ()) + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ baz = ( ! ) r_baz; attr = ( ! ) r_attr; foo = ( ! ) r_foo } + : xml_attributes_in_middle_payload_response) + +let xml_attributes_in_middle_response_of_xml i = + let r_payload = ref None in + Structure.scanSequence i [ "payload" ] (fun tag _ -> + match tag with + | "payload" -> + r_payload := + Some + (Read.sequence i "payload" + (fun i _ -> xml_attributes_in_middle_payload_response_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ payload = ( ! ) r_payload } : xml_attributes_in_middle_response) + +let xml_attributes_in_middle_payload_request_of_xml i = + let r_baz = ref None in + let r_attr = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "baz"; "test"; "foo" ] (fun tag _ -> + match tag with + | "baz" -> r_baz := Some (Read.element_value i "baz" Fun.id ()) + | "test" -> r_attr := Some (Read.element_value i "test" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ baz = ( ! ) r_baz; attr = ( ! ) r_attr; foo = ( ! ) r_foo } + : xml_attributes_in_middle_payload_request) + +let xml_attributes_in_middle_request_of_xml i = + let r_payload = ref None in + Structure.scanSequence i [ "payload" ] (fun tag _ -> + match tag with + | "payload" -> + r_payload := + Some + (Read.sequence i "payload" + (fun i _ -> xml_attributes_in_middle_payload_request_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ payload = ( ! ) r_payload } : xml_attributes_in_middle_request) + +let union_payload_of_xml i = + let r_greeting = ref None in + Structure.scanSequence i [ "greeting" ] (fun tag _ -> + match tag with + | "greeting" -> r_greeting := Some (Read.element_value i "greeting" Fun.id ()) + | _ -> Read.skip_element i); + (match ( ! ) r_greeting with + | Some v -> Greeting v + | None -> failwith "no union member present in xml response" + : union_payload) + +let timestamp_format_headers_i_o_of_xml i = + let r_target_date_time = ref None in + let r_target_http_date = ref None in + let r_target_epoch_seconds = ref None in + let r_default_format = ref None in + let r_member_date_time = ref None in + let r_member_http_date = ref None in + let r_member_epoch_seconds = ref None in + Structure.scanSequence i + [ + "targetDateTime"; + "targetHttpDate"; + "targetEpochSeconds"; + "defaultFormat"; + "memberDateTime"; + "memberHttpDate"; + "memberEpochSeconds"; + ] (fun tag _ -> + match tag with + | "targetDateTime" -> + r_target_date_time := + Some + (Read.sequence i "targetDateTime" + (fun i _ -> Shared.Xml_deserializers.date_time_of_xml i) + ()) + | "targetHttpDate" -> + r_target_http_date := + Some + (Read.sequence i "targetHttpDate" + (fun i _ -> Shared.Xml_deserializers.http_date_of_xml i) + ()) + | "targetEpochSeconds" -> + r_target_epoch_seconds := + Some + (Read.sequence i "targetEpochSeconds" + (fun i _ -> Shared.Xml_deserializers.epoch_seconds_of_xml i) + ()) + | "defaultFormat" -> + r_default_format := + Some (Read.element_value i "defaultFormat" Primitive.timestamp_iso_of_string ()) + | "memberDateTime" -> + r_member_date_time := + Some (Read.element_value i "memberDateTime" Primitive.timestamp_iso_of_string ()) + | "memberHttpDate" -> + r_member_http_date := + Some (Read.element_value i "memberHttpDate" Primitive.timestamp_httpdate_of_string ()) + | "memberEpochSeconds" -> + r_member_epoch_seconds := + Some (Read.element_value i "memberEpochSeconds" Primitive.timestamp_epoch_of_string ()) + | _ -> Read.skip_element i); + ({ + target_date_time = ( ! ) r_target_date_time; + target_http_date = ( ! ) r_target_http_date; + target_epoch_seconds = ( ! ) r_target_epoch_seconds; + default_format = ( ! ) r_default_format; + member_date_time = ( ! ) r_member_date_time; + member_http_date = ( ! ) r_member_http_date; + member_epoch_seconds = ( ! ) r_member_epoch_seconds; + } + : timestamp_format_headers_i_o) + +let string_payload_input_of_xml i = + let r_payload = ref None in + Structure.scanSequence i [ "payload" ] (fun tag _ -> + match tag with + | "payload" -> r_payload := Some (Read.element_value i "payload" Fun.id ()) + | _ -> Read.skip_element i); + ({ payload = ( ! ) r_payload } : string_payload_input) + +let string_enum_of_xml i = + let s = Read.data i in + (match s with "enumvalue" -> V | _ -> failwith "unknown enum value" : string_enum) + +let simple_scalar_properties_response_of_xml i = + let r_double_value = ref None in + let r_float_value = ref None in + let r_long_value = ref None in + let r_integer_value = ref None in + let r_short_value = ref None in + let r_byte_value = ref None in + let r_false_boolean_value = ref None in + let r_true_boolean_value = ref None in + let r_string_value = ref None in + let r_foo = ref None in + Structure.scanSequence i + [ + "DoubleDribble"; + "floatValue"; + "longValue"; + "integerValue"; + "shortValue"; + "byteValue"; + "falseBooleanValue"; + "trueBooleanValue"; + "stringValue"; + "foo"; + ] (fun tag _ -> + match tag with + | "DoubleDribble" -> + r_double_value := + Some (Read.element_value i "DoubleDribble" Primitive.double_of_string ()) + | "floatValue" -> + r_float_value := Some (Read.element_value i "floatValue" Primitive.float_of_string ()) + | "longValue" -> + r_long_value := Some (Read.element_value i "longValue" Primitive.long_of_string ()) + | "integerValue" -> + r_integer_value := Some (Read.element_value i "integerValue" Primitive.int_of_string ()) + | "shortValue" -> + r_short_value := Some (Read.element_value i "shortValue" Primitive.int_of_string ()) + | "byteValue" -> + r_byte_value := Some (Read.element_value i "byteValue" Primitive.int_of_string ()) + | "falseBooleanValue" -> + r_false_boolean_value := + Some (Read.element_value i "falseBooleanValue" Primitive.bool_of_string ()) + | "trueBooleanValue" -> + r_true_boolean_value := + Some (Read.element_value i "trueBooleanValue" Primitive.bool_of_string ()) + | "stringValue" -> r_string_value := Some (Read.element_value i "stringValue" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ + double_value = ( ! ) r_double_value; + float_value = ( ! ) r_float_value; + long_value = ( ! ) r_long_value; + integer_value = ( ! ) r_integer_value; + short_value = ( ! ) r_short_value; + byte_value = ( ! ) r_byte_value; + false_boolean_value = ( ! ) r_false_boolean_value; + true_boolean_value = ( ! ) r_true_boolean_value; + string_value = ( ! ) r_string_value; + foo = ( ! ) r_foo; + } + : simple_scalar_properties_response) + +let simple_scalar_properties_request_of_xml i = + let r_double_value = ref None in + let r_float_value = ref None in + let r_long_value = ref None in + let r_integer_value = ref None in + let r_short_value = ref None in + let r_byte_value = ref None in + let r_false_boolean_value = ref None in + let r_true_boolean_value = ref None in + let r_string_value = ref None in + let r_foo = ref None in + Structure.scanSequence i + [ + "DoubleDribble"; + "floatValue"; + "longValue"; + "integerValue"; + "shortValue"; + "byteValue"; + "falseBooleanValue"; + "trueBooleanValue"; + "stringValue"; + "foo"; + ] (fun tag _ -> + match tag with + | "DoubleDribble" -> + r_double_value := + Some (Read.element_value i "DoubleDribble" Primitive.double_of_string ()) + | "floatValue" -> + r_float_value := Some (Read.element_value i "floatValue" Primitive.float_of_string ()) + | "longValue" -> + r_long_value := Some (Read.element_value i "longValue" Primitive.long_of_string ()) + | "integerValue" -> + r_integer_value := Some (Read.element_value i "integerValue" Primitive.int_of_string ()) + | "shortValue" -> + r_short_value := Some (Read.element_value i "shortValue" Primitive.int_of_string ()) + | "byteValue" -> + r_byte_value := Some (Read.element_value i "byteValue" Primitive.int_of_string ()) + | "falseBooleanValue" -> + r_false_boolean_value := + Some (Read.element_value i "falseBooleanValue" Primitive.bool_of_string ()) + | "trueBooleanValue" -> + r_true_boolean_value := + Some (Read.element_value i "trueBooleanValue" Primitive.bool_of_string ()) + | "stringValue" -> r_string_value := Some (Read.element_value i "stringValue" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ + double_value = ( ! ) r_double_value; + float_value = ( ! ) r_float_value; + long_value = ( ! ) r_long_value; + integer_value = ( ! ) r_integer_value; + short_value = ( ! ) r_short_value; + byte_value = ( ! ) r_byte_value; + false_boolean_value = ( ! ) r_false_boolean_value; + true_boolean_value = ( ! ) r_true_boolean_value; + string_value = ( ! ) r_string_value; + foo = ( ! ) r_foo; + } + : simple_scalar_properties_request) + +let simple_scalar_properties_input_output_of_xml i = + let r_double_value = ref None in + let r_float_value = ref None in + let r_long_value = ref None in + let r_integer_value = ref None in + let r_short_value = ref None in + let r_byte_value = ref None in + let r_false_boolean_value = ref None in + let r_true_boolean_value = ref None in + let r_string_value = ref None in + let r_foo = ref None in + Structure.scanSequence i + [ + "DoubleDribble"; + "floatValue"; + "longValue"; + "integerValue"; + "shortValue"; + "byteValue"; + "falseBooleanValue"; + "trueBooleanValue"; + "stringValue"; + "foo"; + ] (fun tag _ -> + match tag with + | "DoubleDribble" -> + r_double_value := + Some (Read.element_value i "DoubleDribble" Primitive.double_of_string ()) + | "floatValue" -> + r_float_value := Some (Read.element_value i "floatValue" Primitive.float_of_string ()) + | "longValue" -> + r_long_value := Some (Read.element_value i "longValue" Primitive.long_of_string ()) + | "integerValue" -> + r_integer_value := Some (Read.element_value i "integerValue" Primitive.int_of_string ()) + | "shortValue" -> + r_short_value := Some (Read.element_value i "shortValue" Primitive.int_of_string ()) + | "byteValue" -> + r_byte_value := Some (Read.element_value i "byteValue" Primitive.int_of_string ()) + | "falseBooleanValue" -> + r_false_boolean_value := + Some (Read.element_value i "falseBooleanValue" Primitive.bool_of_string ()) + | "trueBooleanValue" -> + r_true_boolean_value := + Some (Read.element_value i "trueBooleanValue" Primitive.bool_of_string ()) + | "stringValue" -> r_string_value := Some (Read.element_value i "stringValue" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ + double_value = ( ! ) r_double_value; + float_value = ( ! ) r_float_value; + long_value = ( ! ) r_long_value; + integer_value = ( ! ) r_integer_value; + short_value = ( ! ) r_short_value; + byte_value = ( ! ) r_byte_value; + false_boolean_value = ( ! ) r_false_boolean_value; + true_boolean_value = ( ! ) r_true_boolean_value; + string_value = ( ! ) r_string_value; + foo = ( ! ) r_foo; + } + : simple_scalar_properties_input_output) + +let rec recursive_shapes_input_output_nested1_of_xml i = + let r_nested = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "nested"; "foo" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := + Some + (Read.sequence i "nested" + (fun i _ -> recursive_shapes_input_output_nested2_of_xml i) + ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested; foo = ( ! ) r_foo } : recursive_shapes_input_output_nested1) + +and recursive_shapes_input_output_nested2_of_xml i = + let r_recursive_member = ref None in + let r_bar = ref None in + Structure.scanSequence i [ "recursiveMember"; "bar" ] (fun tag _ -> + match tag with + | "recursiveMember" -> + r_recursive_member := + Some + (Read.sequence i "recursiveMember" + (fun i _ -> recursive_shapes_input_output_nested1_of_xml i) + ()) + | "bar" -> r_bar := Some (Read.element_value i "bar" Fun.id ()) + | _ -> Read.skip_element i); + ({ recursive_member = ( ! ) r_recursive_member; bar = ( ! ) r_bar } + : recursive_shapes_input_output_nested2) + +let recursive_shapes_response_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := + Some + (Read.sequence i "nested" + (fun i _ -> recursive_shapes_input_output_nested1_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : recursive_shapes_response) + +let recursive_shapes_request_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := + Some + (Read.sequence i "nested" + (fun i _ -> recursive_shapes_input_output_nested1_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : recursive_shapes_request) + +let query_precedence_input_of_xml i = + let r_baz = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "baz"; "foo" ] (fun tag _ -> + match tag with + | "baz" -> + r_baz := + Some + (Read.sequence i "baz" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + ()) + ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ baz = ( ! ) r_baz; foo = ( ! ) r_foo } : query_precedence_input) + +let query_params_as_string_list_map_input_of_xml i = + let r_foo = ref None in + let r_qux = ref None in + Structure.scanSequence i [ "foo"; "qux" ] (fun tag _ -> + match tag with + | "foo" -> + r_foo := + Some + (Read.sequence i "foo" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.string_list_of_xml i) + () + in + (k, v)) + ()) + ()) + | "qux" -> r_qux := Some (Read.element_value i "qux" Fun.id ()) + | _ -> Read.skip_element i); + ({ foo = ( ! ) r_foo; qux = ( ! ) r_qux } : query_params_as_string_list_map_input) + +let query_idempotency_token_auto_fill_input_of_xml i = + let r_token = ref None in + Structure.scanSequence i [ "token" ] (fun tag _ -> + match tag with + | "token" -> r_token := Some (Read.element_value i "token" Fun.id ()) + | _ -> Read.skip_element i); + ({ token = ( ! ) r_token } : query_idempotency_token_auto_fill_input) + +let put_with_content_encoding_input_of_xml i = + let r_data = ref None in + let r_encoding = ref None in + Structure.scanSequence i [ "data"; "encoding" ] (fun tag _ -> + match tag with + | "data" -> r_data := Some (Read.element_value i "data" Fun.id ()) + | "encoding" -> r_encoding := Some (Read.element_value i "encoding" Fun.id ()) + | _ -> Read.skip_element i); + ({ data = ( ! ) r_data; encoding = ( ! ) r_encoding } : put_with_content_encoding_input) + +let omits_null_serializes_empty_string_input_of_xml i = + let r_empty_string = ref None in + let r_null_value = ref None in + Structure.scanSequence i [ "emptyString"; "nullValue" ] (fun tag _ -> + match tag with + | "emptyString" -> r_empty_string := Some (Read.element_value i "emptyString" Fun.id ()) + | "nullValue" -> r_null_value := Some (Read.element_value i "nullValue" Fun.id ()) + | _ -> Read.skip_element i); + ({ empty_string = ( ! ) r_empty_string; null_value = ( ! ) r_null_value } + : omits_null_serializes_empty_string_input) + +let null_and_empty_headers_i_o_of_xml i = + let r_c = ref None in + let r_b = ref None in + let r_a = ref None in + Structure.scanSequence i [ "c"; "b"; "a" ] (fun tag _ -> + match tag with + | "c" -> + r_c := Some (Read.sequence i "c" (fun i _ -> Read.elements_value i "member" Fun.id ()) ()) + | "b" -> r_b := Some (Read.element_value i "b" Fun.id ()) + | "a" -> r_a := Some (Read.element_value i "a" Fun.id ()) + | _ -> Read.skip_element i); + ({ c = ( ! ) r_c; b = ( ! ) r_b; a = ( ! ) r_a } : null_and_empty_headers_i_o) + +let no_input_and_output_output_of_xml i = () + +let nested_xml_map_with_xml_name_inner_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "InnerKey" Fun.id () in + let v = Read.element_value i "InnerValue" Fun.id () in + (k, v)) + () + +let nested_xml_map_with_xml_name_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "OuterKey" Fun.id () in + let v = + Read.sequence i "value" (fun i _ -> nested_xml_map_with_xml_name_inner_map_of_xml i) () + in + (k, v)) + () + +let nested_xml_map_with_xml_name_response_of_xml i = + let r_nested_xml_map_with_xml_name_map = ref None in + Structure.scanSequence i [ "nestedXmlMapWithXmlNameMap" ] (fun tag _ -> + match tag with + | "nestedXmlMapWithXmlNameMap" -> + r_nested_xml_map_with_xml_name_map := + Some + (Read.sequence i "nestedXmlMapWithXmlNameMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "OuterKey" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> nested_xml_map_with_xml_name_inner_map_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ nested_xml_map_with_xml_name_map = ( ! ) r_nested_xml_map_with_xml_name_map } + : nested_xml_map_with_xml_name_response) + +let nested_xml_map_with_xml_name_request_of_xml i = + let r_nested_xml_map_with_xml_name_map = ref None in + Structure.scanSequence i [ "nestedXmlMapWithXmlNameMap" ] (fun tag _ -> + match tag with + | "nestedXmlMapWithXmlNameMap" -> + r_nested_xml_map_with_xml_name_map := + Some + (Read.sequence i "nestedXmlMapWithXmlNameMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "OuterKey" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> nested_xml_map_with_xml_name_inner_map_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ nested_xml_map_with_xml_name_map = ( ! ) r_nested_xml_map_with_xml_name_map } + : nested_xml_map_with_xml_name_request) + +let nested_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" (fun i _ -> Shared.Xml_deserializers.foo_enum_map_of_xml i) () + in + (k, v)) + () + +let nested_xml_maps_response_of_xml i = + let r_flat_nested_map = ref None in + let r_nested_map = ref None in + Structure.scanSequence i [ "flatNestedMap"; "nestedMap" ] (fun tag _ -> + match tag with + | "flatNestedMap" -> + r_flat_nested_map := + Some + (Read.sequences i "flatNestedMap" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_map_of_xml i) + () + in + (k, v)) + ()) + | "nestedMap" -> + r_nested_map := + Some + (Read.sequence i "nestedMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_map_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ flat_nested_map = ( ! ) r_flat_nested_map; nested_map = ( ! ) r_nested_map } + : nested_xml_maps_response) + +let nested_xml_maps_request_of_xml i = + let r_flat_nested_map = ref None in + let r_nested_map = ref None in + Structure.scanSequence i [ "flatNestedMap"; "nestedMap" ] (fun tag _ -> + match tag with + | "flatNestedMap" -> + r_flat_nested_map := + Some + (Read.sequences i "flatNestedMap" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_map_of_xml i) + () + in + (k, v)) + ()) + | "nestedMap" -> + r_nested_map := + Some + (Read.sequence i "nestedMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_map_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ flat_nested_map = ( ! ) r_flat_nested_map; nested_map = ( ! ) r_nested_map } + : nested_xml_maps_request) + +let input_and_output_with_headers_i_o_of_xml i = + let r_header_enum_list = ref None in + let r_header_enum = ref None in + let r_header_timestamp_list = ref None in + let r_header_boolean_list = ref None in + let r_header_integer_list = ref None in + let r_header_string_set = ref None in + let r_header_string_list = ref None in + let r_header_false_bool = ref None in + let r_header_true_bool = ref None in + let r_header_double = ref None in + let r_header_float = ref None in + let r_header_long = ref None in + let r_header_integer = ref None in + let r_header_short = ref None in + let r_header_byte = ref None in + let r_header_string = ref None in + Structure.scanSequence i + [ + "headerEnumList"; + "headerEnum"; + "headerTimestampList"; + "headerBooleanList"; + "headerIntegerList"; + "headerStringSet"; + "headerStringList"; + "headerFalseBool"; + "headerTrueBool"; + "headerDouble"; + "headerFloat"; + "headerLong"; + "headerInteger"; + "headerShort"; + "headerByte"; + "headerString"; + ] (fun tag _ -> + match tag with + | "headerEnumList" -> + r_header_enum_list := + Some + (Read.sequence i "headerEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "headerEnum" -> + r_header_enum := + Some + (Read.sequence i "headerEnum" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "headerTimestampList" -> + r_header_timestamp_list := + Some + (Read.sequence i "headerTimestampList" + (fun i _ -> Read.elements_value i "member" Primitive.timestamp_iso_of_string ()) + ()) + | "headerBooleanList" -> + r_header_boolean_list := + Some + (Read.sequence i "headerBooleanList" + (fun i _ -> Read.elements_value i "member" Primitive.bool_of_string ()) + ()) + | "headerIntegerList" -> + r_header_integer_list := + Some + (Read.sequence i "headerIntegerList" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "headerStringSet" -> + r_header_string_set := + Some + (Read.sequence i "headerStringSet" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | "headerStringList" -> + r_header_string_list := + Some + (Read.sequence i "headerStringList" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | "headerFalseBool" -> + r_header_false_bool := + Some (Read.element_value i "headerFalseBool" Primitive.bool_of_string ()) + | "headerTrueBool" -> + r_header_true_bool := + Some (Read.element_value i "headerTrueBool" Primitive.bool_of_string ()) + | "headerDouble" -> + r_header_double := + Some (Read.element_value i "headerDouble" Primitive.double_of_string ()) + | "headerFloat" -> + r_header_float := Some (Read.element_value i "headerFloat" Primitive.float_of_string ()) + | "headerLong" -> + r_header_long := Some (Read.element_value i "headerLong" Primitive.long_of_string ()) + | "headerInteger" -> + r_header_integer := Some (Read.element_value i "headerInteger" Primitive.int_of_string ()) + | "headerShort" -> + r_header_short := Some (Read.element_value i "headerShort" Primitive.int_of_string ()) + | "headerByte" -> + r_header_byte := Some (Read.element_value i "headerByte" Primitive.int_of_string ()) + | "headerString" -> r_header_string := Some (Read.element_value i "headerString" Fun.id ()) + | _ -> Read.skip_element i); + ({ + header_enum_list = ( ! ) r_header_enum_list; + header_enum = ( ! ) r_header_enum; + header_timestamp_list = ( ! ) r_header_timestamp_list; + header_boolean_list = ( ! ) r_header_boolean_list; + header_integer_list = ( ! ) r_header_integer_list; + header_string_set = ( ! ) r_header_string_set; + header_string_list = ( ! ) r_header_string_list; + header_false_bool = ( ! ) r_header_false_bool; + header_true_bool = ( ! ) r_header_true_bool; + header_double = ( ! ) r_header_double; + header_float = ( ! ) r_header_float; + header_long = ( ! ) r_header_long; + header_integer = ( ! ) r_header_integer; + header_short = ( ! ) r_header_short; + header_byte = ( ! ) r_header_byte; + header_string = ( ! ) r_header_string; + } + : input_and_output_with_headers_i_o) + +let ignore_query_params_in_response_output_of_xml i = + let r_baz = ref None in + Structure.scanSequence i [ "baz" ] (fun tag _ -> + match tag with + | "baz" -> r_baz := Some (Read.element_value i "baz" Fun.id ()) + | _ -> Read.skip_element i); + ({ baz = ( ! ) r_baz } : ignore_query_params_in_response_output) + +let http_response_code_output_of_xml i = + let r_status = ref None in + Structure.scanSequence i [ "Status" ] (fun tag _ -> + match tag with + | "Status" -> r_status := Some (Read.element_value i "Status" Primitive.int_of_string ()) + | _ -> Read.skip_element i); + ({ status = ( ! ) r_status } : http_response_code_output) + +let http_request_with_labels_and_timestamp_format_input_of_xml i = + let r_target_date_time = ref None in + let r_target_http_date = ref None in + let r_target_epoch_seconds = ref None in + let r_default_format = ref None in + let r_member_date_time = ref None in + let r_member_http_date = ref None in + let r_member_epoch_seconds = ref None in + Structure.scanSequence i + [ + "targetDateTime"; + "targetHttpDate"; + "targetEpochSeconds"; + "defaultFormat"; + "memberDateTime"; + "memberHttpDate"; + "memberEpochSeconds"; + ] (fun tag _ -> + match tag with + | "targetDateTime" -> + r_target_date_time := + Some + (Read.sequence i "targetDateTime" + (fun i _ -> Shared.Xml_deserializers.date_time_of_xml i) + ()) + | "targetHttpDate" -> + r_target_http_date := + Some + (Read.sequence i "targetHttpDate" + (fun i _ -> Shared.Xml_deserializers.http_date_of_xml i) + ()) + | "targetEpochSeconds" -> + r_target_epoch_seconds := + Some + (Read.sequence i "targetEpochSeconds" + (fun i _ -> Shared.Xml_deserializers.epoch_seconds_of_xml i) + ()) + | "defaultFormat" -> + r_default_format := + Some (Read.element_value i "defaultFormat" Primitive.timestamp_iso_of_string ()) + | "memberDateTime" -> + r_member_date_time := + Some (Read.element_value i "memberDateTime" Primitive.timestamp_iso_of_string ()) + | "memberHttpDate" -> + r_member_http_date := + Some (Read.element_value i "memberHttpDate" Primitive.timestamp_httpdate_of_string ()) + | "memberEpochSeconds" -> + r_member_epoch_seconds := + Some (Read.element_value i "memberEpochSeconds" Primitive.timestamp_epoch_of_string ()) + | _ -> Read.skip_element i); + ({ + target_date_time = required "targetDateTime" (( ! ) r_target_date_time) i; + target_http_date = required "targetHttpDate" (( ! ) r_target_http_date) i; + target_epoch_seconds = required "targetEpochSeconds" (( ! ) r_target_epoch_seconds) i; + default_format = required "defaultFormat" (( ! ) r_default_format) i; + member_date_time = required "memberDateTime" (( ! ) r_member_date_time) i; + member_http_date = required "memberHttpDate" (( ! ) r_member_http_date) i; + member_epoch_seconds = required "memberEpochSeconds" (( ! ) r_member_epoch_seconds) i; + } + : http_request_with_labels_and_timestamp_format_input) + +let http_request_with_labels_input_of_xml i = + let r_timestamp = ref None in + let r_boolean_ = ref None in + let r_double = ref None in + let r_float_ = ref None in + let r_long = ref None in + let r_integer = ref None in + let r_short = ref None in + let r_string_ = ref None in + Structure.scanSequence i + [ "timestamp"; "boolean"; "double"; "float"; "long"; "integer"; "short"; "string" ] + (fun tag _ -> + match tag with + | "timestamp" -> + r_timestamp := + Some (Read.element_value i "timestamp" Primitive.timestamp_iso_of_string ()) + | "boolean" -> r_boolean_ := Some (Read.element_value i "boolean" Primitive.bool_of_string ()) + | "double" -> r_double := Some (Read.element_value i "double" Primitive.double_of_string ()) + | "float" -> r_float_ := Some (Read.element_value i "float" Primitive.float_of_string ()) + | "long" -> r_long := Some (Read.element_value i "long" Primitive.long_of_string ()) + | "integer" -> r_integer := Some (Read.element_value i "integer" Primitive.int_of_string ()) + | "short" -> r_short := Some (Read.element_value i "short" Primitive.int_of_string ()) + | "string" -> r_string_ := Some (Read.element_value i "string" Fun.id ()) + | _ -> Read.skip_element i); + ({ + timestamp = required "timestamp" (( ! ) r_timestamp) i; + boolean_ = required "boolean" (( ! ) r_boolean_) i; + double = required "double" (( ! ) r_double) i; + float_ = required "float" (( ! ) r_float_) i; + long = required "long" (( ! ) r_long) i; + integer = required "integer" (( ! ) r_integer) i; + short = required "short" (( ! ) r_short) i; + string_ = required "string" (( ! ) r_string_) i; + } + : http_request_with_labels_input) + +let http_request_with_greedy_label_in_path_input_of_xml i = + let r_baz = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "baz"; "foo" ] (fun tag _ -> + match tag with + | "baz" -> r_baz := Some (Read.element_value i "baz" Fun.id ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ baz = required "baz" (( ! ) r_baz) i; foo = required "foo" (( ! ) r_foo) i } + : http_request_with_greedy_label_in_path_input) + +let http_request_with_float_labels_input_of_xml i = + let r_double = ref None in + let r_float_ = ref None in + Structure.scanSequence i [ "double"; "float" ] (fun tag _ -> + match tag with + | "double" -> r_double := Some (Read.element_value i "double" Primitive.double_of_string ()) + | "float" -> r_float_ := Some (Read.element_value i "float" Primitive.float_of_string ()) + | _ -> Read.skip_element i); + ({ double = required "double" (( ! ) r_double) i; float_ = required "float" (( ! ) r_float_) i } + : http_request_with_float_labels_input) + +let foo_prefix_headers_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + () + +let http_prefix_headers_input_output_of_xml i = + let r_foo_map = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "fooMap"; "foo" ] (fun tag _ -> + match tag with + | "fooMap" -> + r_foo_map := + Some + (Read.sequence i "fooMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + ()) + ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ foo_map = ( ! ) r_foo_map; foo = ( ! ) r_foo } : http_prefix_headers_input_output) + +let payload_with_xml_namespace_and_prefix_of_xml i = + let r_name = ref None in + Structure.scanSequence i [ "name" ] (fun tag _ -> + match tag with + | "name" -> r_name := Some (Read.element_value i "name" Fun.id ()) + | _ -> Read.skip_element i); + ({ name = ( ! ) r_name } : payload_with_xml_namespace_and_prefix) + +let http_payload_with_xml_namespace_and_prefix_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := + Some + (Read.sequence i "nested" + (fun i _ -> payload_with_xml_namespace_and_prefix_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : http_payload_with_xml_namespace_and_prefix_input_output) + +let payload_with_xml_namespace_of_xml i = + let r_name = ref None in + Structure.scanSequence i [ "name" ] (fun tag _ -> + match tag with + | "name" -> r_name := Some (Read.element_value i "name" Fun.id ()) + | _ -> Read.skip_element i); + ({ name = ( ! ) r_name } : payload_with_xml_namespace) + +let http_payload_with_xml_namespace_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := + Some (Read.sequence i "nested" (fun i _ -> payload_with_xml_namespace_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : http_payload_with_xml_namespace_input_output) + +let payload_with_xml_name_of_xml i = + let r_name = ref None in + Structure.scanSequence i [ "name" ] (fun tag _ -> + match tag with + | "name" -> r_name := Some (Read.element_value i "name" Fun.id ()) + | _ -> Read.skip_element i); + ({ name = ( ! ) r_name } : payload_with_xml_name) + +let http_payload_with_xml_name_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := Some (Read.sequence i "nested" (fun i _ -> payload_with_xml_name_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : http_payload_with_xml_name_input_output) + +let http_payload_with_union_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := Some (Read.sequence i "nested" (fun i _ -> union_payload_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : http_payload_with_union_input_output) + +let nested_payload_of_xml i = + let r_name = ref None in + let r_greeting = ref None in + Structure.scanSequence i [ "name"; "greeting" ] (fun tag _ -> + match tag with + | "name" -> r_name := Some (Read.element_value i "name" Fun.id ()) + | "greeting" -> r_greeting := Some (Read.element_value i "greeting" Fun.id ()) + | _ -> Read.skip_element i); + ({ name = ( ! ) r_name; greeting = ( ! ) r_greeting } : nested_payload) + +let http_payload_with_structure_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := Some (Read.sequence i "nested" (fun i _ -> nested_payload_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : http_payload_with_structure_input_output) + +let http_payload_with_member_xml_name_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "Hola" ] (fun tag _ -> + match tag with + | "Hola" -> + r_nested := Some (Read.sequence i "Hola" (fun i _ -> payload_with_xml_name_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : http_payload_with_member_xml_name_input_output) + +let http_payload_traits_with_media_type_input_output_of_xml i = + let r_blob = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "blob"; "foo" ] (fun tag _ -> + match tag with + | "blob" -> + r_blob := + Some + (Read.sequence i "blob" + (fun i _ -> Shared.Xml_deserializers.text_plain_blob_of_xml i) + ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ blob = ( ! ) r_blob; foo = ( ! ) r_foo } : http_payload_traits_with_media_type_input_output) + +let http_payload_traits_input_output_of_xml i = + let r_blob = ref None in + let r_foo = ref None in + Structure.scanSequence i [ "blob"; "foo" ] (fun tag _ -> + match tag with + | "blob" -> r_blob := Some (Read.element_value i "blob" Primitive.blob_of_string ()) + | "foo" -> r_foo := Some (Read.element_value i "foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ blob = ( ! ) r_blob; foo = ( ! ) r_foo } : http_payload_traits_input_output) + +let enum_payload_input_of_xml i = + let r_payload = ref None in + Structure.scanSequence i [ "payload" ] (fun tag _ -> + match tag with + | "payload" -> + r_payload := Some (Read.sequence i "payload" (fun i _ -> string_enum_of_xml i) ()) + | _ -> Read.skip_element i); + ({ payload = ( ! ) r_payload } : enum_payload_input) + +let http_empty_prefix_headers_output_of_xml i = + let r_specific_header = ref None in + let r_prefix_headers = ref None in + Structure.scanSequence i [ "specificHeader"; "prefixHeaders" ] (fun tag _ -> + match tag with + | "specificHeader" -> + r_specific_header := Some (Read.element_value i "specificHeader" Fun.id ()) + | "prefixHeaders" -> + r_prefix_headers := + Some + (Read.sequence i "prefixHeaders" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ specific_header = ( ! ) r_specific_header; prefix_headers = ( ! ) r_prefix_headers } + : http_empty_prefix_headers_output) + +let http_empty_prefix_headers_input_of_xml i = + let r_specific_header = ref None in + let r_prefix_headers = ref None in + Structure.scanSequence i [ "specificHeader"; "prefixHeaders" ] (fun tag _ -> + match tag with + | "specificHeader" -> + r_specific_header := Some (Read.element_value i "specificHeader" Fun.id ()) + | "prefixHeaders" -> + r_prefix_headers := + Some + (Read.sequence i "prefixHeaders" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ specific_header = ( ! ) r_specific_header; prefix_headers = ( ! ) r_prefix_headers } + : http_empty_prefix_headers_input) + +let invalid_greeting_of_xml i = + let r_message = ref None in + Structure.scanSequence i [ "Message" ] (fun tag _ -> + match tag with + | "Message" -> r_message := Some (Read.element_value i "Message" Fun.id ()) + | _ -> Read.skip_element i); + ({ message = ( ! ) r_message } : invalid_greeting) + +let complex_nested_error_data_of_xml i = + let r_foo = ref None in + Structure.scanSequence i [ "Foo" ] (fun tag _ -> + match tag with + | "Foo" -> r_foo := Some (Read.element_value i "Foo" Fun.id ()) + | _ -> Read.skip_element i); + ({ foo = ( ! ) r_foo } : complex_nested_error_data) + +let complex_error_of_xml i = + let r_nested = ref None in + let r_top_level = ref None in + let r_header = ref None in + Structure.scanSequence i [ "Nested"; "TopLevel"; "Header" ] (fun tag _ -> + match tag with + | "Nested" -> + r_nested := + Some (Read.sequence i "Nested" (fun i _ -> complex_nested_error_data_of_xml i) ()) + | "TopLevel" -> r_top_level := Some (Read.element_value i "TopLevel" Fun.id ()) + | "Header" -> r_header := Some (Read.element_value i "Header" Fun.id ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested; top_level = ( ! ) r_top_level; header = ( ! ) r_header } + : complex_error) + +let greeting_with_errors_output_of_xml i = + let r_greeting = ref None in + Structure.scanSequence i [ "greeting" ] (fun tag _ -> + match tag with + | "greeting" -> r_greeting := Some (Read.element_value i "greeting" Fun.id ()) + | _ -> Read.skip_element i); + ({ greeting = ( ! ) r_greeting } : greeting_with_errors_output) + +let fractional_seconds_output_of_xml i = + let r_datetime = ref None in + Structure.scanSequence i [ "datetime" ] (fun tag _ -> + match tag with + | "datetime" -> + r_datetime := + Some + (Read.sequence i "datetime" + (fun i _ -> Shared.Xml_deserializers.date_time_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ datetime = ( ! ) r_datetime } : fractional_seconds_output) + +let flattened_xml_map_with_xml_namespace_output_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + () + +let flattened_xml_map_with_xml_namespace_output_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "KVP" ] (fun tag _ -> + match tag with + | "KVP" -> + r_my_map := + Some + (Read.sequences i "KVP" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : flattened_xml_map_with_xml_namespace_output) + +let flattened_xml_map_with_xml_name_input_output_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + () + +let flattened_xml_map_with_xml_name_response_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "KVP" ] (fun tag _ -> + match tag with + | "KVP" -> + r_my_map := + Some + (Read.sequences i "KVP" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : flattened_xml_map_with_xml_name_response) + +let flattened_xml_map_with_xml_name_request_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "KVP" ] (fun tag _ -> + match tag with + | "KVP" -> + r_my_map := + Some + (Read.sequences i "KVP" + (fun i _ -> + let k = Read.element_value i "K" Fun.id () in + let v = Read.element_value i "V" Fun.id () in + (k, v)) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : flattened_xml_map_with_xml_name_request) + +let flattened_xml_map_response_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequences i "myMap" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + () + in + (k, v)) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : flattened_xml_map_response) + +let flattened_xml_map_request_of_xml i = + let r_my_map = ref None in + Structure.scanSequence i [ "myMap" ] (fun tag _ -> + match tag with + | "myMap" -> + r_my_map := + Some + (Read.sequences i "myMap" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + () + in + (k, v)) + ()) + | _ -> Read.skip_element i); + ({ my_map = ( ! ) r_my_map } : flattened_xml_map_request) + +let endpoint_with_host_label_operation_request_of_xml i = + let r_label = ref None in + Structure.scanSequence i [ "label" ] (fun tag _ -> + match tag with + | "label" -> r_label := Some (Read.element_value i "label" Fun.id ()) + | _ -> Read.skip_element i); + ({ label = required "label" (( ! ) r_label) i } : endpoint_with_host_label_operation_request) + +let host_label_header_input_of_xml i = + let r_account_id = ref None in + Structure.scanSequence i [ "accountId" ] (fun tag _ -> + match tag with + | "accountId" -> r_account_id := Some (Read.element_value i "accountId" Fun.id ()) + | _ -> Read.skip_element i); + ({ account_id = required "accountId" (( ! ) r_account_id) i } : host_label_header_input) + +let empty_input_and_empty_output_output_of_xml i = () +let empty_input_and_empty_output_input_of_xml i = () + +let datetime_offsets_output_of_xml i = + let r_datetime = ref None in + Structure.scanSequence i [ "datetime" ] (fun tag _ -> + match tag with + | "datetime" -> + r_datetime := + Some + (Read.sequence i "datetime" + (fun i _ -> Shared.Xml_deserializers.date_time_of_xml i) + ()) + | _ -> Read.skip_element i); + ({ datetime = ( ! ) r_datetime } : datetime_offsets_output) + +let content_type_parameters_output_of_xml i = () + +let content_type_parameters_input_of_xml i = + let r_value = ref None in + Structure.scanSequence i [ "value" ] (fun tag _ -> + match tag with + | "value" -> r_value := Some (Read.element_value i "value" Primitive.int_of_string ()) + | _ -> Read.skip_element i); + ({ value = ( ! ) r_value } : content_type_parameters_input) + +let constant_query_string_input_of_xml i = + let r_hello = ref None in + Structure.scanSequence i [ "hello" ] (fun tag _ -> + match tag with + | "hello" -> r_hello := Some (Read.element_value i "hello" Fun.id ()) + | _ -> Read.skip_element i); + ({ hello = required "hello" (( ! ) r_hello) i } : constant_query_string_input) + +let constant_and_variable_query_string_input_of_xml i = + let r_maybe_set = ref None in + let r_baz = ref None in + Structure.scanSequence i [ "maybeSet"; "baz" ] (fun tag _ -> + match tag with + | "maybeSet" -> r_maybe_set := Some (Read.element_value i "maybeSet" Fun.id ()) + | "baz" -> r_baz := Some (Read.element_value i "baz" Fun.id ()) + | _ -> Read.skip_element i); + ({ maybe_set = ( ! ) r_maybe_set; baz = ( ! ) r_baz } : constant_and_variable_query_string_input) + +let body_with_xml_name_input_output_of_xml i = + let r_nested = ref None in + Structure.scanSequence i [ "nested" ] (fun tag _ -> + match tag with + | "nested" -> + r_nested := Some (Read.sequence i "nested" (fun i _ -> payload_with_xml_name_of_xml i) ()) + | _ -> Read.skip_element i); + ({ nested = ( ! ) r_nested } : body_with_xml_name_input_output) + +let all_query_string_types_input_of_xml i = + let r_query_params_map_of_strings = ref None in + let r_query_integer_enum_list = ref None in + let r_query_integer_enum = ref None in + let r_query_enum_list = ref None in + let r_query_enum = ref None in + let r_query_timestamp_list = ref None in + let r_query_timestamp = ref None in + let r_query_boolean_list = ref None in + let r_query_boolean = ref None in + let r_query_double_list = ref None in + let r_query_double = ref None in + let r_query_float = ref None in + let r_query_long = ref None in + let r_query_integer_set = ref None in + let r_query_integer_list = ref None in + let r_query_integer = ref None in + let r_query_short = ref None in + let r_query_byte = ref None in + let r_query_string_set = ref None in + let r_query_string_list = ref None in + let r_query_string = ref None in + Structure.scanSequence i + [ + "queryParamsMapOfStrings"; + "queryIntegerEnumList"; + "queryIntegerEnum"; + "queryEnumList"; + "queryEnum"; + "queryTimestampList"; + "queryTimestamp"; + "queryBooleanList"; + "queryBoolean"; + "queryDoubleList"; + "queryDouble"; + "queryFloat"; + "queryLong"; + "queryIntegerSet"; + "queryIntegerList"; + "queryInteger"; + "queryShort"; + "queryByte"; + "queryStringSet"; + "queryStringList"; + "queryString"; + ] (fun tag _ -> + match tag with + | "queryParamsMapOfStrings" -> + r_query_params_map_of_strings := + Some + (Read.sequence i "queryParamsMapOfStrings" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + ()) + ()) + | "queryIntegerEnumList" -> + r_query_integer_enum_list := + Some + (Read.sequence i "queryIntegerEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + ()) + | "queryIntegerEnum" -> + r_query_integer_enum := + Some + (Read.sequence i "queryIntegerEnum" + (fun i _ -> Shared.Xml_deserializers.integer_enum_of_xml i) + ()) + | "queryEnumList" -> + r_query_enum_list := + Some + (Read.sequence i "queryEnumList" + (fun i _ -> + Read.sequences i "member" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + ()) + | "queryEnum" -> + r_query_enum := + Some + (Read.sequence i "queryEnum" + (fun i _ -> Shared.Xml_deserializers.foo_enum_of_xml i) + ()) + | "queryTimestampList" -> + r_query_timestamp_list := + Some + (Read.sequence i "queryTimestampList" + (fun i _ -> Read.elements_value i "member" Primitive.timestamp_iso_of_string ()) + ()) + | "queryTimestamp" -> + r_query_timestamp := + Some (Read.element_value i "queryTimestamp" Primitive.timestamp_iso_of_string ()) + | "queryBooleanList" -> + r_query_boolean_list := + Some + (Read.sequence i "queryBooleanList" + (fun i _ -> Read.elements_value i "member" Primitive.bool_of_string ()) + ()) + | "queryBoolean" -> + r_query_boolean := Some (Read.element_value i "queryBoolean" Primitive.bool_of_string ()) + | "queryDoubleList" -> + r_query_double_list := + Some + (Read.sequence i "queryDoubleList" + (fun i _ -> Read.elements_value i "member" Primitive.double_of_string ()) + ()) + | "queryDouble" -> + r_query_double := Some (Read.element_value i "queryDouble" Primitive.double_of_string ()) + | "queryFloat" -> + r_query_float := Some (Read.element_value i "queryFloat" Primitive.float_of_string ()) + | "queryLong" -> + r_query_long := Some (Read.element_value i "queryLong" Primitive.long_of_string ()) + | "queryIntegerSet" -> + r_query_integer_set := + Some + (Read.sequence i "queryIntegerSet" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "queryIntegerList" -> + r_query_integer_list := + Some + (Read.sequence i "queryIntegerList" + (fun i _ -> Read.elements_value i "member" Primitive.int_of_string ()) + ()) + | "queryInteger" -> + r_query_integer := Some (Read.element_value i "queryInteger" Primitive.int_of_string ()) + | "queryShort" -> + r_query_short := Some (Read.element_value i "queryShort" Primitive.int_of_string ()) + | "queryByte" -> + r_query_byte := Some (Read.element_value i "queryByte" Primitive.int_of_string ()) + | "queryStringSet" -> + r_query_string_set := + Some + (Read.sequence i "queryStringSet" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | "queryStringList" -> + r_query_string_list := + Some + (Read.sequence i "queryStringList" + (fun i _ -> Read.elements_value i "member" Fun.id ()) + ()) + | "queryString" -> r_query_string := Some (Read.element_value i "queryString" Fun.id ()) + | _ -> Read.skip_element i); + ({ + query_params_map_of_strings = ( ! ) r_query_params_map_of_strings; + query_integer_enum_list = ( ! ) r_query_integer_enum_list; + query_integer_enum = ( ! ) r_query_integer_enum; + query_enum_list = ( ! ) r_query_enum_list; + query_enum = ( ! ) r_query_enum; + query_timestamp_list = ( ! ) r_query_timestamp_list; + query_timestamp = ( ! ) r_query_timestamp; + query_boolean_list = ( ! ) r_query_boolean_list; + query_boolean = ( ! ) r_query_boolean; + query_double_list = ( ! ) r_query_double_list; + query_double = ( ! ) r_query_double; + query_float = ( ! ) r_query_float; + query_long = ( ! ) r_query_long; + query_integer_set = ( ! ) r_query_integer_set; + query_integer_list = ( ! ) r_query_integer_list; + query_integer = ( ! ) r_query_integer; + query_short = ( ! ) r_query_short; + query_byte = ( ! ) r_query_byte; + query_string_set = ( ! ) r_query_string_set; + query_string_list = ( ! ) r_query_string_list; + query_string = ( ! ) r_query_string; + } + : all_query_string_types_input) + +let nested_xml_maps_input_output_of_xml i = + let r_flat_nested_map = ref None in + let r_nested_map = ref None in + Structure.scanSequence i [ "flatNestedMap"; "nestedMap" ] (fun tag _ -> + match tag with + | "flatNestedMap" -> + r_flat_nested_map := + Some + (Read.sequences i "flatNestedMap" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_map_of_xml i) + () + in + (k, v)) + ()) + | "nestedMap" -> + r_nested_map := + Some + (Read.sequence i "nestedMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> Shared.Xml_deserializers.foo_enum_map_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ flat_nested_map = ( ! ) r_flat_nested_map; nested_map = ( ! ) r_nested_map } + : nested_xml_maps_input_output) + +let nested_xml_map_with_xml_name_input_output_of_xml i = + let r_nested_xml_map_with_xml_name_map = ref None in + Structure.scanSequence i [ "nestedXmlMapWithXmlNameMap" ] (fun tag _ -> + match tag with + | "nestedXmlMapWithXmlNameMap" -> + r_nested_xml_map_with_xml_name_map := + Some + (Read.sequence i "nestedXmlMapWithXmlNameMap" + (fun i _ -> + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "OuterKey" Fun.id () in + let v = + Read.sequence i "value" + (fun i _ -> nested_xml_map_with_xml_name_inner_map_of_xml i) + () + in + (k, v)) + ()) + ()) + | _ -> Read.skip_element i); + ({ nested_xml_map_with_xml_name_map = ( ! ) r_nested_xml_map_with_xml_name_map } + : nested_xml_map_with_xml_name_input_output) diff --git a/model_tests/protocols/restxml/xml_serializers.ml b/model_tests/protocols/restxml/xml_serializers.ml new file mode 100644 index 00000000..aed1de34 --- /dev/null +++ b/model_tests/protocols/restxml/xml_serializers.ml @@ -0,0 +1,1859 @@ +open Smaws_Lib.Xml.Write +open Types + +let xml_nested_union_struct_to_xml w (x : xml_nested_union_struct) = + ignore + [ + (match x.double_value with + | None -> null w + | Some v -> + element w "doubleValue" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.float_value with + | None -> null w + | Some v -> + element w "floatValue" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.long_value with + | None -> null w + | Some v -> element w "longValue" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string v))); + (match x.integer_value with + | None -> null w + | Some v -> element w "integerValue" (fun w -> text w (string_of_int v))); + (match x.short_value with + | None -> null w + | Some v -> element w "shortValue" (fun w -> text w (string_of_int v))); + (match x.byte_value with + | None -> null w + | Some v -> element w "byteValue" (fun w -> text w (string_of_int v))); + (match x.boolean_value with + | None -> null w + | Some v -> element w "booleanValue" (fun w -> text w (string_of_bool v))); + (match x.string_value with + | None -> null w + | Some v -> element w "stringValue" (fun w -> text w v)); + ] + +let rec xml_union_shape_to_xml w (x : xml_union_shape) = + match x with + | StructValue v -> element w "structValue" (fun w -> xml_nested_union_struct_to_xml w v) + | UnionValue v -> element w "unionValue" (fun w -> xml_union_shape_to_xml w v) + | DoubleValue v -> + element w "doubleValue" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v)) + | FloatValue v -> + element w "floatValue" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v)) + | LongValue v -> element w "longValue" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string v)) + | IntegerValue v -> element w "integerValue" (fun w -> text w (string_of_int v)) + | ShortValue v -> element w "shortValue" (fun w -> text w (string_of_int v)) + | ByteValue v -> element w "byteValue" (fun w -> text w (string_of_int v)) + | BooleanValue v -> element w "booleanValue" (fun w -> text w (string_of_bool v)) + | StringValue v -> element w "stringValue" (fun w -> text w v) + +let xml_unions_response_to_xml w (x : xml_unions_response) = + ignore + [ + (match x.union_value with + | None -> null w + | Some v -> element w "unionValue" (fun w -> xml_union_shape_to_xml w v)); + ] + +let xml_unions_request_to_xml w (x : xml_unions_request) = + ignore + [ + (match x.union_value with + | None -> null w + | Some v -> element w "unionValue" (fun w -> xml_union_shape_to_xml w v)); + ] + +let xml_timestamps_response_to_xml w (x : xml_timestamps_response) = + ignore + [ + (match x.http_date_on_target with + | None -> null w + | Some v -> + element w "httpDateOnTarget" (fun w -> Shared.Xml_serializers.http_date_to_xml w v)); + (match x.http_date with + | None -> null w + | Some v -> + element w "httpDate" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_httpdate_to_string v))); + (match x.epoch_seconds_on_target with + | None -> null w + | Some v -> + element w "epochSecondsOnTarget" (fun w -> + Shared.Xml_serializers.epoch_seconds_to_xml w v)); + (match x.epoch_seconds with + | None -> null w + | Some v -> + element w "epochSeconds" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_epoch_to_string v))); + (match x.date_time_on_target with + | None -> null w + | Some v -> + element w "dateTimeOnTarget" (fun w -> Shared.Xml_serializers.date_time_to_xml w v)); + (match x.date_time with + | None -> null w + | Some v -> + element w "dateTime" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + (match x.normal with + | None -> null w + | Some v -> + element w "normal" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + ] + +let xml_timestamps_request_to_xml w (x : xml_timestamps_request) = + ignore + [ + (match x.http_date_on_target with + | None -> null w + | Some v -> + element w "httpDateOnTarget" (fun w -> Shared.Xml_serializers.http_date_to_xml w v)); + (match x.http_date with + | None -> null w + | Some v -> + element w "httpDate" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_httpdate_to_string v))); + (match x.epoch_seconds_on_target with + | None -> null w + | Some v -> + element w "epochSecondsOnTarget" (fun w -> + Shared.Xml_serializers.epoch_seconds_to_xml w v)); + (match x.epoch_seconds with + | None -> null w + | Some v -> + element w "epochSeconds" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_epoch_to_string v))); + (match x.date_time_on_target with + | None -> null w + | Some v -> + element w "dateTimeOnTarget" (fun w -> Shared.Xml_serializers.date_time_to_xml w v)); + (match x.date_time with + | None -> null w + | Some v -> + element w "dateTime" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + (match x.normal with + | None -> null w + | Some v -> + element w "normal" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + ] + +let xml_timestamps_input_output_to_xml w (x : xml_timestamps_input_output) = + ignore + [ + (match x.http_date_on_target with + | None -> null w + | Some v -> + element w "httpDateOnTarget" (fun w -> Shared.Xml_serializers.http_date_to_xml w v)); + (match x.http_date with + | None -> null w + | Some v -> + element w "httpDate" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_httpdate_to_string v))); + (match x.epoch_seconds_on_target with + | None -> null w + | Some v -> + element w "epochSecondsOnTarget" (fun w -> + Shared.Xml_serializers.epoch_seconds_to_xml w v)); + (match x.epoch_seconds with + | None -> null w + | Some v -> + element w "epochSeconds" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_epoch_to_string v))); + (match x.date_time_on_target with + | None -> null w + | Some v -> + element w "dateTimeOnTarget" (fun w -> Shared.Xml_serializers.date_time_to_xml w v)); + (match x.date_time with + | None -> null w + | Some v -> + element w "dateTime" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + (match x.normal with + | None -> null w + | Some v -> + element w "normal" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + ] + +let xml_namespaced_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> (fun w v -> text w v) w item)) xs + +let xml_namespace_nested_to_xml w (x : xml_namespace_nested) = + ignore + [ + (match x.values with + | None -> null w + | Some v -> element w "values" ~ns:"http://qux.com" (fun w -> xml_namespaced_list_to_xml w v)); + (match x.foo with + | None -> null w + | Some v -> element_with_ns w "http://baz.com" (Some "baz") "foo" (fun w -> text w v)); + ] + +let xml_namespaces_response_to_xml w (x : xml_namespaces_response) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" ~ns:"http://foo.com" (fun w -> xml_namespace_nested_to_xml w v)); + ] + +let xml_namespaces_request_to_xml w (x : xml_namespaces_request) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" ~ns:"http://foo.com" (fun w -> xml_namespace_nested_to_xml w v)); + ] + +let xml_namespaces_input_output_to_xml w (x : xml_namespaces_input_output) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" ~ns:"http://foo.com" (fun w -> xml_namespace_nested_to_xml w v)); + ] + +let xml_maps_xml_name_input_output_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "Attribute" (fun w -> (fun w v -> text w v) w k); + element w "Setting" (fun w -> Shared.Xml_serializers.greeting_struct_to_xml w v))) + pairs + +let xml_maps_xml_name_response_to_xml w (x : xml_maps_xml_name_response) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> element w "myMap" (fun w -> xml_maps_xml_name_input_output_map_to_xml w v)); + ] + +let xml_maps_xml_name_request_to_xml w (x : xml_maps_xml_name_request) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> element w "myMap" (fun w -> xml_maps_xml_name_input_output_map_to_xml w v)); + ] + +let xml_maps_input_output_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> Shared.Xml_serializers.greeting_struct_to_xml w v))) + pairs + +let xml_maps_response_to_xml w (x : xml_maps_response) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> element w "myMap" (fun w -> xml_maps_input_output_map_to_xml w v)); + ] + +let xml_maps_request_to_xml w (x : xml_maps_request) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> element w "myMap" (fun w -> xml_maps_input_output_map_to_xml w v)); + ] + +let xml_map_with_xml_namespace_input_output_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "K" (fun w -> (fun w v -> text w v) w k); + element w "V" (fun w -> (fun w v -> text w v) w v))) + pairs + +let xml_map_with_xml_namespace_response_to_xml w (x : xml_map_with_xml_namespace_response) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + element w "KVP" ~ns:"https://the-member.example.com" (fun w -> + xml_map_with_xml_namespace_input_output_map_to_xml w v)); + ] + +let xml_map_with_xml_namespace_request_to_xml w (x : xml_map_with_xml_namespace_request) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + element w "KVP" ~ns:"https://the-member.example.com" (fun w -> + xml_map_with_xml_namespace_input_output_map_to_xml w v)); + ] + +let xml_map_with_xml_namespace_input_output_to_xml w (x : xml_map_with_xml_namespace_input_output) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + element w "KVP" ~ns:"https://the-member.example.com" (fun w -> + xml_map_with_xml_namespace_input_output_map_to_xml w v)); + ] + +let renamed_list_members_to_xml w xs = + List.iter (fun item -> element w "item" (fun w -> (fun w v -> text w v) w item)) xs + +let list_with_member_namespace_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> (fun w v -> text w v) w item)) xs + +let list_with_namespace_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> (fun w v -> text w v) w item)) xs + +let structure_list_member_to_xml w (x : structure_list_member) = + ignore + [ + (match x.b with None -> null w | Some v -> element w "other" (fun w -> text w v)); + (match x.a with None -> null w | Some v -> element w "value" (fun w -> text w v)); + ] + +let structure_list_to_xml w xs = + List.iter (fun item -> element w "item" (fun w -> structure_list_member_to_xml w item)) xs + +let xml_lists_response_to_xml w (x : xml_lists_response) = + ignore + [ + (match x.flattened_structure_list with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedStructureList" (fun w -> structure_list_member_to_xml w item)) + v); + (match x.structure_list with + | None -> null w + | Some v -> element w "myStructureList" (fun w -> structure_list_to_xml w v)); + (match x.flattened_list_with_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithNamespace" ~ns:"https://xml-list.example.com" (fun w -> + (fun w v -> text w v) w item)) + v); + (match x.flattened_list_with_member_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithMemberNamespace" ~ns:"https://xml-list.example.com" + (fun w -> (fun w v -> text w v) w item)) + v); + (match x.flattened_list2 with + | None -> null w + | Some v -> + List.iter (fun item -> element w "customName" (fun w -> (fun w v -> text w v) w item)) v); + (match x.flattened_list with + | None -> null w + | Some v -> + List.iter + (fun item -> element w "flattenedList" (fun w -> (fun w v -> text w v) w item)) + v); + (match x.renamed_list_members with + | None -> null w + | Some v -> element w "renamed" (fun w -> renamed_list_members_to_xml w v)); + (match x.nested_string_list with + | None -> null w + | Some v -> + element w "nestedStringList" (fun w -> + Shared.Xml_serializers.nested_string_list_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.enum_list with + | None -> null w + | Some v -> element w "enumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.timestamp_list with + | None -> null w + | Some v -> + element w "timestampList" (fun w -> Shared.Xml_serializers.timestamp_list_to_xml w v)); + (match x.boolean_list with + | None -> null w + | Some v -> element w "booleanList" (fun w -> Shared.Xml_serializers.boolean_list_to_xml w v)); + (match x.integer_list with + | None -> null w + | Some v -> element w "integerList" (fun w -> Shared.Xml_serializers.integer_list_to_xml w v)); + (match x.string_set with + | None -> null w + | Some v -> element w "stringSet" (fun w -> Shared.Xml_serializers.string_set_to_xml w v)); + (match x.string_list with + | None -> null w + | Some v -> element w "stringList" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + ] + +let xml_lists_request_to_xml w (x : xml_lists_request) = + ignore + [ + (match x.flattened_structure_list with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedStructureList" (fun w -> structure_list_member_to_xml w item)) + v); + (match x.structure_list with + | None -> null w + | Some v -> element w "myStructureList" (fun w -> structure_list_to_xml w v)); + (match x.flattened_list_with_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithNamespace" ~ns:"https://xml-list.example.com" (fun w -> + (fun w v -> text w v) w item)) + v); + (match x.flattened_list_with_member_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithMemberNamespace" ~ns:"https://xml-list.example.com" + (fun w -> (fun w v -> text w v) w item)) + v); + (match x.flattened_list2 with + | None -> null w + | Some v -> + List.iter (fun item -> element w "customName" (fun w -> (fun w v -> text w v) w item)) v); + (match x.flattened_list with + | None -> null w + | Some v -> + List.iter + (fun item -> element w "flattenedList" (fun w -> (fun w v -> text w v) w item)) + v); + (match x.renamed_list_members with + | None -> null w + | Some v -> element w "renamed" (fun w -> renamed_list_members_to_xml w v)); + (match x.nested_string_list with + | None -> null w + | Some v -> + element w "nestedStringList" (fun w -> + Shared.Xml_serializers.nested_string_list_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.enum_list with + | None -> null w + | Some v -> element w "enumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.timestamp_list with + | None -> null w + | Some v -> + element w "timestampList" (fun w -> Shared.Xml_serializers.timestamp_list_to_xml w v)); + (match x.boolean_list with + | None -> null w + | Some v -> element w "booleanList" (fun w -> Shared.Xml_serializers.boolean_list_to_xml w v)); + (match x.integer_list with + | None -> null w + | Some v -> element w "integerList" (fun w -> Shared.Xml_serializers.integer_list_to_xml w v)); + (match x.string_set with + | None -> null w + | Some v -> element w "stringSet" (fun w -> Shared.Xml_serializers.string_set_to_xml w v)); + (match x.string_list with + | None -> null w + | Some v -> element w "stringList" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + ] + +let xml_lists_input_output_to_xml w (x : xml_lists_input_output) = + ignore + [ + (match x.flattened_structure_list with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedStructureList" (fun w -> structure_list_member_to_xml w item)) + v); + (match x.structure_list with + | None -> null w + | Some v -> element w "myStructureList" (fun w -> structure_list_to_xml w v)); + (match x.flattened_list_with_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithNamespace" ~ns:"https://xml-list.example.com" (fun w -> + (fun w v -> text w v) w item)) + v); + (match x.flattened_list_with_member_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithMemberNamespace" ~ns:"https://xml-list.example.com" + (fun w -> (fun w v -> text w v) w item)) + v); + (match x.flattened_list2 with + | None -> null w + | Some v -> + List.iter (fun item -> element w "customName" (fun w -> (fun w v -> text w v) w item)) v); + (match x.flattened_list with + | None -> null w + | Some v -> + List.iter + (fun item -> element w "flattenedList" (fun w -> (fun w v -> text w v) w item)) + v); + (match x.renamed_list_members with + | None -> null w + | Some v -> element w "renamed" (fun w -> renamed_list_members_to_xml w v)); + (match x.nested_string_list with + | None -> null w + | Some v -> + element w "nestedStringList" (fun w -> + Shared.Xml_serializers.nested_string_list_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.enum_list with + | None -> null w + | Some v -> element w "enumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.timestamp_list with + | None -> null w + | Some v -> + element w "timestampList" (fun w -> Shared.Xml_serializers.timestamp_list_to_xml w v)); + (match x.boolean_list with + | None -> null w + | Some v -> element w "booleanList" (fun w -> Shared.Xml_serializers.boolean_list_to_xml w v)); + (match x.integer_list with + | None -> null w + | Some v -> element w "integerList" (fun w -> Shared.Xml_serializers.integer_list_to_xml w v)); + (match x.string_set with + | None -> null w + | Some v -> element w "stringSet" (fun w -> Shared.Xml_serializers.string_set_to_xml w v)); + (match x.string_list with + | None -> null w + | Some v -> element w "stringList" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + ] + +let xml_int_enums_response_to_xml w (x : xml_int_enums_response) = + ignore + [ + (match x.int_enum_map with + | None -> null w + | Some v -> + element w "intEnumMap" (fun w -> Shared.Xml_serializers.integer_enum_map_to_xml w v)); + (match x.int_enum_set with + | None -> null w + | Some v -> + element w "intEnumSet" (fun w -> Shared.Xml_serializers.integer_enum_set_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.int_enum3 with + | None -> null w + | Some v -> element w "intEnum3" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + (match x.int_enum2 with + | None -> null w + | Some v -> element w "intEnum2" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + (match x.int_enum1 with + | None -> null w + | Some v -> element w "intEnum1" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + ] + +let xml_int_enums_request_to_xml w (x : xml_int_enums_request) = + ignore + [ + (match x.int_enum_map with + | None -> null w + | Some v -> + element w "intEnumMap" (fun w -> Shared.Xml_serializers.integer_enum_map_to_xml w v)); + (match x.int_enum_set with + | None -> null w + | Some v -> + element w "intEnumSet" (fun w -> Shared.Xml_serializers.integer_enum_set_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.int_enum3 with + | None -> null w + | Some v -> element w "intEnum3" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + (match x.int_enum2 with + | None -> null w + | Some v -> element w "intEnum2" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + (match x.int_enum1 with + | None -> null w + | Some v -> element w "intEnum1" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + ] + +let xml_int_enums_input_output_to_xml w (x : xml_int_enums_input_output) = + ignore + [ + (match x.int_enum_map with + | None -> null w + | Some v -> + element w "intEnumMap" (fun w -> Shared.Xml_serializers.integer_enum_map_to_xml w v)); + (match x.int_enum_set with + | None -> null w + | Some v -> + element w "intEnumSet" (fun w -> Shared.Xml_serializers.integer_enum_set_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.int_enum3 with + | None -> null w + | Some v -> element w "intEnum3" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + (match x.int_enum2 with + | None -> null w + | Some v -> element w "intEnum2" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + (match x.int_enum1 with + | None -> null w + | Some v -> element w "intEnum1" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + ] + +let xml_enums_response_to_xml w (x : xml_enums_response) = + ignore + [ + (match x.foo_enum_map with + | None -> null w + | Some v -> element w "fooEnumMap" (fun w -> Shared.Xml_serializers.foo_enum_map_to_xml w v)); + (match x.foo_enum_set with + | None -> null w + | Some v -> element w "fooEnumSet" (fun w -> Shared.Xml_serializers.foo_enum_set_to_xml w v)); + (match x.foo_enum_list with + | None -> null w + | Some v -> element w "fooEnumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.foo_enum3 with + | None -> null w + | Some v -> element w "fooEnum3" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.foo_enum2 with + | None -> null w + | Some v -> element w "fooEnum2" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.foo_enum1 with + | None -> null w + | Some v -> element w "fooEnum1" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + ] + +let xml_enums_request_to_xml w (x : xml_enums_request) = + ignore + [ + (match x.foo_enum_map with + | None -> null w + | Some v -> element w "fooEnumMap" (fun w -> Shared.Xml_serializers.foo_enum_map_to_xml w v)); + (match x.foo_enum_set with + | None -> null w + | Some v -> element w "fooEnumSet" (fun w -> Shared.Xml_serializers.foo_enum_set_to_xml w v)); + (match x.foo_enum_list with + | None -> null w + | Some v -> element w "fooEnumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.foo_enum3 with + | None -> null w + | Some v -> element w "fooEnum3" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.foo_enum2 with + | None -> null w + | Some v -> element w "fooEnum2" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.foo_enum1 with + | None -> null w + | Some v -> element w "fooEnum1" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + ] + +let xml_enums_input_output_to_xml w (x : xml_enums_input_output) = + ignore + [ + (match x.foo_enum_map with + | None -> null w + | Some v -> element w "fooEnumMap" (fun w -> Shared.Xml_serializers.foo_enum_map_to_xml w v)); + (match x.foo_enum_set with + | None -> null w + | Some v -> element w "fooEnumSet" (fun w -> Shared.Xml_serializers.foo_enum_set_to_xml w v)); + (match x.foo_enum_list with + | None -> null w + | Some v -> element w "fooEnumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.foo_enum3 with + | None -> null w + | Some v -> element w "fooEnum3" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.foo_enum2 with + | None -> null w + | Some v -> element w "fooEnum2" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.foo_enum1 with + | None -> null w + | Some v -> element w "fooEnum1" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + ] + +let xml_empty_strings_response_to_xml w (x : xml_empty_strings_response) = + ignore + [ + (match x.empty_string with + | None -> null w + | Some v -> element w "emptyString" (fun w -> text w v)); + ] + +let xml_empty_strings_request_to_xml w (x : xml_empty_strings_request) = + ignore + [ + (match x.empty_string with + | None -> null w + | Some v -> element w "emptyString" (fun w -> text w v)); + ] + +let xml_empty_maps_response_to_xml w (x : xml_empty_maps_response) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> element w "myMap" (fun w -> xml_maps_input_output_map_to_xml w v)); + ] + +let xml_empty_maps_request_to_xml w (x : xml_empty_maps_request) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> element w "myMap" (fun w -> xml_maps_input_output_map_to_xml w v)); + ] + +let xml_empty_lists_response_to_xml w (x : xml_empty_lists_response) = + ignore + [ + (match x.flattened_structure_list with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedStructureList" (fun w -> structure_list_member_to_xml w item)) + v); + (match x.structure_list with + | None -> null w + | Some v -> element w "myStructureList" (fun w -> structure_list_to_xml w v)); + (match x.flattened_list_with_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithNamespace" ~ns:"https://xml-list.example.com" (fun w -> + (fun w v -> text w v) w item)) + v); + (match x.flattened_list_with_member_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithMemberNamespace" ~ns:"https://xml-list.example.com" + (fun w -> (fun w v -> text w v) w item)) + v); + (match x.flattened_list2 with + | None -> null w + | Some v -> + List.iter (fun item -> element w "customName" (fun w -> (fun w v -> text w v) w item)) v); + (match x.flattened_list with + | None -> null w + | Some v -> + List.iter + (fun item -> element w "flattenedList" (fun w -> (fun w v -> text w v) w item)) + v); + (match x.renamed_list_members with + | None -> null w + | Some v -> element w "renamed" (fun w -> renamed_list_members_to_xml w v)); + (match x.nested_string_list with + | None -> null w + | Some v -> + element w "nestedStringList" (fun w -> + Shared.Xml_serializers.nested_string_list_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.enum_list with + | None -> null w + | Some v -> element w "enumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.timestamp_list with + | None -> null w + | Some v -> + element w "timestampList" (fun w -> Shared.Xml_serializers.timestamp_list_to_xml w v)); + (match x.boolean_list with + | None -> null w + | Some v -> element w "booleanList" (fun w -> Shared.Xml_serializers.boolean_list_to_xml w v)); + (match x.integer_list with + | None -> null w + | Some v -> element w "integerList" (fun w -> Shared.Xml_serializers.integer_list_to_xml w v)); + (match x.string_set with + | None -> null w + | Some v -> element w "stringSet" (fun w -> Shared.Xml_serializers.string_set_to_xml w v)); + (match x.string_list with + | None -> null w + | Some v -> element w "stringList" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + ] + +let xml_empty_lists_request_to_xml w (x : xml_empty_lists_request) = + ignore + [ + (match x.flattened_structure_list with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedStructureList" (fun w -> structure_list_member_to_xml w item)) + v); + (match x.structure_list with + | None -> null w + | Some v -> element w "myStructureList" (fun w -> structure_list_to_xml w v)); + (match x.flattened_list_with_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithNamespace" ~ns:"https://xml-list.example.com" (fun w -> + (fun w v -> text w v) w item)) + v); + (match x.flattened_list_with_member_namespace with + | None -> null w + | Some v -> + List.iter + (fun item -> + element w "flattenedListWithMemberNamespace" ~ns:"https://xml-list.example.com" + (fun w -> (fun w v -> text w v) w item)) + v); + (match x.flattened_list2 with + | None -> null w + | Some v -> + List.iter (fun item -> element w "customName" (fun w -> (fun w v -> text w v) w item)) v); + (match x.flattened_list with + | None -> null w + | Some v -> + List.iter + (fun item -> element w "flattenedList" (fun w -> (fun w v -> text w v) w item)) + v); + (match x.renamed_list_members with + | None -> null w + | Some v -> element w "renamed" (fun w -> renamed_list_members_to_xml w v)); + (match x.nested_string_list with + | None -> null w + | Some v -> + element w "nestedStringList" (fun w -> + Shared.Xml_serializers.nested_string_list_to_xml w v)); + (match x.int_enum_list with + | None -> null w + | Some v -> + element w "intEnumList" (fun w -> Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.enum_list with + | None -> null w + | Some v -> element w "enumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.timestamp_list with + | None -> null w + | Some v -> + element w "timestampList" (fun w -> Shared.Xml_serializers.timestamp_list_to_xml w v)); + (match x.boolean_list with + | None -> null w + | Some v -> element w "booleanList" (fun w -> Shared.Xml_serializers.boolean_list_to_xml w v)); + (match x.integer_list with + | None -> null w + | Some v -> element w "integerList" (fun w -> Shared.Xml_serializers.integer_list_to_xml w v)); + (match x.string_set with + | None -> null w + | Some v -> element w "stringSet" (fun w -> Shared.Xml_serializers.string_set_to_xml w v)); + (match x.string_list with + | None -> null w + | Some v -> element w "stringList" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + ] + +let xml_empty_blobs_response_to_xml w (x : xml_empty_blobs_response) = + ignore + [ + (match x.data with + | None -> null w + | Some v -> element w "data" (fun w -> text w (Base64.encode_exn (Bytes.to_string v)))); + ] + +let xml_empty_blobs_request_to_xml w (x : xml_empty_blobs_request) = + ignore + [ + (match x.data with + | None -> null w + | Some v -> element w "data" (fun w -> text w (Base64.encode_exn (Bytes.to_string v)))); + ] + +let xml_blobs_response_to_xml w (x : xml_blobs_response) = + ignore + [ + (match x.data with + | None -> null w + | Some v -> element w "data" (fun w -> text w (Base64.encode_exn (Bytes.to_string v)))); + ] + +let xml_blobs_request_to_xml w (x : xml_blobs_request) = + ignore + [ + (match x.data with + | None -> null w + | Some v -> element w "data" (fun w -> text w (Base64.encode_exn (Bytes.to_string v)))); + ] + +let xml_attributes_response_to_xml w (x : xml_attributes_response) = + ignore + [ null w; (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)) ] + +let xml_attributes_request_to_xml w (x : xml_attributes_request) = + ignore + [ null w; (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)) ] + +let xml_attributes_payload_response_to_xml w (x : xml_attributes_payload_response) = + ignore + [ null w; (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)) ] + +let xml_attributes_payload_request_to_xml w (x : xml_attributes_payload_request) = + ignore + [ null w; (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)) ] + +let xml_attributes_on_payload_response_to_xml w (x : xml_attributes_on_payload_response) = + ignore + [ + (match x.payload with + | None -> null w + | Some v -> + element w "payload" + ~attrs: + (List.concat [ (match v.attr with Some s -> [ ("test", s, None) ] | None -> []) ]) + (fun w -> xml_attributes_payload_response_to_xml w v)); + ] + +let xml_attributes_on_payload_request_to_xml w (x : xml_attributes_on_payload_request) = + ignore + [ + (match x.payload with + | None -> null w + | Some v -> + element w "payload" + ~attrs: + (List.concat [ (match v.attr with Some s -> [ ("test", s, None) ] | None -> []) ]) + (fun w -> xml_attributes_payload_request_to_xml w v)); + ] + +let xml_attributes_middle_member_input_output_to_xml w + (x : xml_attributes_middle_member_input_output) = + ignore + [ + (match x.baz with None -> null w | Some v -> element w "baz" (fun w -> text w v)); + null w; + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let xml_attributes_input_output_to_xml w (x : xml_attributes_input_output) = + ignore + [ null w; (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)) ] + +let xml_attributes_in_middle_payload_response_to_xml w + (x : xml_attributes_in_middle_payload_response) = + ignore + [ + (match x.baz with None -> null w | Some v -> element w "baz" (fun w -> text w v)); + null w; + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let xml_attributes_in_middle_response_to_xml w (x : xml_attributes_in_middle_response) = + ignore + [ + (match x.payload with + | None -> null w + | Some v -> + element w "payload" + ~attrs: + (List.concat [ (match v.attr with Some s -> [ ("test", s, None) ] | None -> []) ]) + (fun w -> xml_attributes_in_middle_payload_response_to_xml w v)); + ] + +let xml_attributes_in_middle_payload_request_to_xml w (x : xml_attributes_in_middle_payload_request) + = + ignore + [ + (match x.baz with None -> null w | Some v -> element w "baz" (fun w -> text w v)); + null w; + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let xml_attributes_in_middle_request_to_xml w (x : xml_attributes_in_middle_request) = + ignore + [ + (match x.payload with + | None -> null w + | Some v -> + element w "payload" + ~attrs: + (List.concat [ (match v.attr with Some s -> [ ("test", s, None) ] | None -> []) ]) + (fun w -> xml_attributes_in_middle_payload_request_to_xml w v)); + ] + +let union_payload_to_xml w (x : union_payload) = + match x with Greeting v -> element w "greeting" (fun w -> text w v) + +let timestamp_format_headers_i_o_to_xml w (x : timestamp_format_headers_i_o) = + ignore + [ + (match x.target_date_time with + | None -> null w + | Some v -> element w "targetDateTime" (fun w -> Shared.Xml_serializers.date_time_to_xml w v)); + (match x.target_http_date with + | None -> null w + | Some v -> element w "targetHttpDate" (fun w -> Shared.Xml_serializers.http_date_to_xml w v)); + (match x.target_epoch_seconds with + | None -> null w + | Some v -> + element w "targetEpochSeconds" (fun w -> Shared.Xml_serializers.epoch_seconds_to_xml w v)); + (match x.default_format with + | None -> null w + | Some v -> + element w "defaultFormat" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + (match x.member_date_time with + | None -> null w + | Some v -> + element w "memberDateTime" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + (match x.member_http_date with + | None -> null w + | Some v -> + element w "memberHttpDate" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_httpdate_to_string v))); + (match x.member_epoch_seconds with + | None -> null w + | Some v -> + element w "memberEpochSeconds" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_epoch_to_string v))); + ] + +let string_payload_input_to_xml w (x : string_payload_input) = + ignore + [ (match x.payload with None -> null w | Some v -> element w "payload" (fun w -> text w v)) ] + +let string_enum_to_xml w (x : string_enum) = text w (match x with V -> "enumvalue") + +let simple_scalar_properties_response_to_xml w (x : simple_scalar_properties_response) = + ignore + [ + (match x.double_value with + | None -> null w + | Some v -> + element w "DoubleDribble" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.float_value with + | None -> null w + | Some v -> + element w "floatValue" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.long_value with + | None -> null w + | Some v -> element w "longValue" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string v))); + (match x.integer_value with + | None -> null w + | Some v -> element w "integerValue" (fun w -> text w (string_of_int v))); + (match x.short_value with + | None -> null w + | Some v -> element w "shortValue" (fun w -> text w (string_of_int v))); + (match x.byte_value with + | None -> null w + | Some v -> element w "byteValue" (fun w -> text w (string_of_int v))); + (match x.false_boolean_value with + | None -> null w + | Some v -> element w "falseBooleanValue" (fun w -> text w (string_of_bool v))); + (match x.true_boolean_value with + | None -> null w + | Some v -> element w "trueBooleanValue" (fun w -> text w (string_of_bool v))); + (match x.string_value with + | None -> null w + | Some v -> element w "stringValue" (fun w -> text w v)); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let simple_scalar_properties_request_to_xml w (x : simple_scalar_properties_request) = + ignore + [ + (match x.double_value with + | None -> null w + | Some v -> + element w "DoubleDribble" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.float_value with + | None -> null w + | Some v -> + element w "floatValue" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.long_value with + | None -> null w + | Some v -> element w "longValue" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string v))); + (match x.integer_value with + | None -> null w + | Some v -> element w "integerValue" (fun w -> text w (string_of_int v))); + (match x.short_value with + | None -> null w + | Some v -> element w "shortValue" (fun w -> text w (string_of_int v))); + (match x.byte_value with + | None -> null w + | Some v -> element w "byteValue" (fun w -> text w (string_of_int v))); + (match x.false_boolean_value with + | None -> null w + | Some v -> element w "falseBooleanValue" (fun w -> text w (string_of_bool v))); + (match x.true_boolean_value with + | None -> null w + | Some v -> element w "trueBooleanValue" (fun w -> text w (string_of_bool v))); + (match x.string_value with + | None -> null w + | Some v -> element w "stringValue" (fun w -> text w v)); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let simple_scalar_properties_input_output_to_xml w (x : simple_scalar_properties_input_output) = + ignore + [ + (match x.double_value with + | None -> null w + | Some v -> + element w "DoubleDribble" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.float_value with + | None -> null w + | Some v -> + element w "floatValue" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.long_value with + | None -> null w + | Some v -> element w "longValue" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string v))); + (match x.integer_value with + | None -> null w + | Some v -> element w "integerValue" (fun w -> text w (string_of_int v))); + (match x.short_value with + | None -> null w + | Some v -> element w "shortValue" (fun w -> text w (string_of_int v))); + (match x.byte_value with + | None -> null w + | Some v -> element w "byteValue" (fun w -> text w (string_of_int v))); + (match x.false_boolean_value with + | None -> null w + | Some v -> element w "falseBooleanValue" (fun w -> text w (string_of_bool v))); + (match x.true_boolean_value with + | None -> null w + | Some v -> element w "trueBooleanValue" (fun w -> text w (string_of_bool v))); + (match x.string_value with + | None -> null w + | Some v -> element w "stringValue" (fun w -> text w v)); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let rec recursive_shapes_input_output_nested1_to_xml w (x : recursive_shapes_input_output_nested1) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" (fun w -> recursive_shapes_input_output_nested2_to_xml w v)); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +and recursive_shapes_input_output_nested2_to_xml w (x : recursive_shapes_input_output_nested2) = + ignore + [ + (match x.recursive_member with + | None -> null w + | Some v -> + element w "recursiveMember" (fun w -> recursive_shapes_input_output_nested1_to_xml w v)); + (match x.bar with None -> null w | Some v -> element w "bar" (fun w -> text w v)); + ] + +let recursive_shapes_response_to_xml w (x : recursive_shapes_response) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" (fun w -> recursive_shapes_input_output_nested1_to_xml w v)); + ] + +let recursive_shapes_request_to_xml w (x : recursive_shapes_request) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" (fun w -> recursive_shapes_input_output_nested1_to_xml w v)); + ] + +let query_precedence_input_to_xml w (x : query_precedence_input) = + ignore + [ + (match x.baz with + | None -> null w + | Some v -> element w "baz" (fun w -> Shared.Xml_serializers.string_map_to_xml w v)); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let query_params_as_string_list_map_input_to_xml w (x : query_params_as_string_list_map_input) = + ignore + [ + (match x.foo with + | None -> null w + | Some v -> element w "foo" (fun w -> Shared.Xml_serializers.string_list_map_to_xml w v)); + (match x.qux with None -> null w | Some v -> element w "qux" (fun w -> text w v)); + ] + +let query_idempotency_token_auto_fill_input_to_xml w (x : query_idempotency_token_auto_fill_input) = + ignore + [ + (match x.token with + | None -> element w "token" (fun w -> text w (Smaws_Lib.Uuid.generate ())) + | Some v -> element w "token" (fun w -> text w v)); + ] + +let put_with_content_encoding_input_to_xml w (x : put_with_content_encoding_input) = + ignore + [ + (match x.data with None -> null w | Some v -> element w "data" (fun w -> text w v)); + (match x.encoding with None -> null w | Some v -> element w "encoding" (fun w -> text w v)); + ] + +let omits_null_serializes_empty_string_input_to_xml w (x : omits_null_serializes_empty_string_input) + = + ignore + [ + (match x.empty_string with + | None -> null w + | Some v -> element w "emptyString" (fun w -> text w v)); + (match x.null_value with + | None -> null w + | Some v -> element w "nullValue" (fun w -> text w v)); + ] + +let null_and_empty_headers_i_o_to_xml w (x : null_and_empty_headers_i_o) = + ignore + [ + (match x.c with + | None -> null w + | Some v -> element w "c" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + (match x.b with None -> null w | Some v -> element w "b" (fun w -> text w v)); + (match x.a with None -> null w | Some v -> element w "a" (fun w -> text w v)); + ] + +let no_input_and_output_output_to_xml w _x = null w + +let nested_xml_map_with_xml_name_inner_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "InnerKey" (fun w -> (fun w v -> text w v) w k); + element w "InnerValue" (fun w -> (fun w v -> text w v) w v))) + pairs + +let nested_xml_map_with_xml_name_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "OuterKey" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> nested_xml_map_with_xml_name_inner_map_to_xml w v))) + pairs + +let nested_xml_map_with_xml_name_response_to_xml w (x : nested_xml_map_with_xml_name_response) = + ignore + [ + (match x.nested_xml_map_with_xml_name_map with + | None -> null w + | Some v -> + element w "nestedXmlMapWithXmlNameMap" (fun w -> + nested_xml_map_with_xml_name_map_to_xml w v)); + ] + +let nested_xml_map_with_xml_name_request_to_xml w (x : nested_xml_map_with_xml_name_request) = + ignore + [ + (match x.nested_xml_map_with_xml_name_map with + | None -> null w + | Some v -> + element w "nestedXmlMapWithXmlNameMap" (fun w -> + nested_xml_map_with_xml_name_map_to_xml w v)); + ] + +let nested_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> Shared.Xml_serializers.foo_enum_map_to_xml w v))) + pairs + +let nested_xml_maps_response_to_xml w (x : nested_xml_maps_response) = + ignore + [ + (match x.flat_nested_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "flatNestedMap" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> Shared.Xml_serializers.foo_enum_map_to_xml w v))) + v); + (match x.nested_map with + | None -> null w + | Some v -> element w "nestedMap" (fun w -> nested_map_to_xml w v)); + ] + +let nested_xml_maps_request_to_xml w (x : nested_xml_maps_request) = + ignore + [ + (match x.flat_nested_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "flatNestedMap" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> Shared.Xml_serializers.foo_enum_map_to_xml w v))) + v); + (match x.nested_map with + | None -> null w + | Some v -> element w "nestedMap" (fun w -> nested_map_to_xml w v)); + ] + +let input_and_output_with_headers_i_o_to_xml w (x : input_and_output_with_headers_i_o) = + ignore + [ + (match x.header_enum_list with + | None -> null w + | Some v -> + element w "headerEnumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.header_enum with + | None -> null w + | Some v -> element w "headerEnum" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.header_timestamp_list with + | None -> null w + | Some v -> + element w "headerTimestampList" (fun w -> + Shared.Xml_serializers.timestamp_list_to_xml w v)); + (match x.header_boolean_list with + | None -> null w + | Some v -> + element w "headerBooleanList" (fun w -> Shared.Xml_serializers.boolean_list_to_xml w v)); + (match x.header_integer_list with + | None -> null w + | Some v -> + element w "headerIntegerList" (fun w -> Shared.Xml_serializers.integer_list_to_xml w v)); + (match x.header_string_set with + | None -> null w + | Some v -> + element w "headerStringSet" (fun w -> Shared.Xml_serializers.string_set_to_xml w v)); + (match x.header_string_list with + | None -> null w + | Some v -> + element w "headerStringList" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + (match x.header_false_bool with + | None -> null w + | Some v -> element w "headerFalseBool" (fun w -> text w (string_of_bool v))); + (match x.header_true_bool with + | None -> null w + | Some v -> element w "headerTrueBool" (fun w -> text w (string_of_bool v))); + (match x.header_double with + | None -> null w + | Some v -> + element w "headerDouble" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.header_float with + | None -> null w + | Some v -> + element w "headerFloat" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.header_long with + | None -> null w + | Some v -> element w "headerLong" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string v))); + (match x.header_integer with + | None -> null w + | Some v -> element w "headerInteger" (fun w -> text w (string_of_int v))); + (match x.header_short with + | None -> null w + | Some v -> element w "headerShort" (fun w -> text w (string_of_int v))); + (match x.header_byte with + | None -> null w + | Some v -> element w "headerByte" (fun w -> text w (string_of_int v))); + (match x.header_string with + | None -> null w + | Some v -> element w "headerString" (fun w -> text w v)); + ] + +let ignore_query_params_in_response_output_to_xml w (x : ignore_query_params_in_response_output) = + ignore [ (match x.baz with None -> null w | Some v -> element w "baz" (fun w -> text w v)) ] + +let http_response_code_output_to_xml w (x : http_response_code_output) = + ignore + [ + (match x.status with + | None -> null w + | Some v -> element w "Status" (fun w -> text w (string_of_int v))); + ] + +let http_request_with_labels_and_timestamp_format_input_to_xml w + (x : http_request_with_labels_and_timestamp_format_input) = + ignore + [ + element w "targetDateTime" (fun w -> + Shared.Xml_serializers.date_time_to_xml w x.target_date_time); + element w "targetHttpDate" (fun w -> + Shared.Xml_serializers.http_date_to_xml w x.target_http_date); + element w "targetEpochSeconds" (fun w -> + Shared.Xml_serializers.epoch_seconds_to_xml w x.target_epoch_seconds); + element w "defaultFormat" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string x.default_format)); + element w "memberDateTime" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string x.member_date_time)); + element w "memberHttpDate" (fun w -> + text w + (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_httpdate_to_string x.member_http_date)); + element w "memberEpochSeconds" (fun w -> + text w + (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_epoch_to_string x.member_epoch_seconds)); + ] + +let http_request_with_labels_input_to_xml w (x : http_request_with_labels_input) = + ignore + [ + element w "timestamp" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string x.timestamp)); + element w "boolean" (fun w -> text w (string_of_bool x.boolean_)); + element w "double" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string x.double)); + element w "float" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string x.float_)); + element w "long" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string x.long)); + element w "integer" (fun w -> text w (string_of_int x.integer)); + element w "short" (fun w -> text w (string_of_int x.short)); + element w "string" (fun w -> text w x.string_); + ] + +let http_request_with_greedy_label_in_path_input_to_xml w + (x : http_request_with_greedy_label_in_path_input) = + ignore [ element w "baz" (fun w -> text w x.baz); element w "foo" (fun w -> text w x.foo) ] + +let http_request_with_float_labels_input_to_xml w (x : http_request_with_float_labels_input) = + ignore + [ + element w "double" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string x.double)); + element w "float" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string x.float_)); + ] + +let foo_prefix_headers_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> (fun w v -> text w v) w v))) + pairs + +let http_prefix_headers_input_output_to_xml w (x : http_prefix_headers_input_output) = + ignore + [ + (match x.foo_map with + | None -> null w + | Some v -> element w "fooMap" (fun w -> foo_prefix_headers_to_xml w v)); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let payload_with_xml_namespace_and_prefix_to_xml w (x : payload_with_xml_namespace_and_prefix) = + ignore [ (match x.name with None -> null w | Some v -> element w "name" (fun w -> text w v)) ] + +let http_payload_with_xml_namespace_and_prefix_input_output_to_xml w + (x : http_payload_with_xml_namespace_and_prefix_input_output) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> + element_with_ns w "http://foo.com" (Some "baz") "nested" (fun w -> + payload_with_xml_namespace_and_prefix_to_xml w v)); + ] + +let payload_with_xml_namespace_to_xml w (x : payload_with_xml_namespace) = + ignore [ (match x.name with None -> null w | Some v -> element w "name" (fun w -> text w v)) ] + +let http_payload_with_xml_namespace_input_output_to_xml w + (x : http_payload_with_xml_namespace_input_output) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> + element w "nested" ~ns:"http://foo.com" (fun w -> payload_with_xml_namespace_to_xml w v)); + ] + +let payload_with_xml_name_to_xml w (x : payload_with_xml_name) = + ignore [ (match x.name with None -> null w | Some v -> element w "name" (fun w -> text w v)) ] + +let http_payload_with_xml_name_input_output_to_xml w (x : http_payload_with_xml_name_input_output) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" (fun w -> payload_with_xml_name_to_xml w v)); + ] + +let http_payload_with_union_input_output_to_xml w (x : http_payload_with_union_input_output) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" (fun w -> union_payload_to_xml w v)); + ] + +let nested_payload_to_xml w (x : nested_payload) = + ignore + [ + (match x.name with None -> null w | Some v -> element w "name" (fun w -> text w v)); + (match x.greeting with None -> null w | Some v -> element w "greeting" (fun w -> text w v)); + ] + +let http_payload_with_structure_input_output_to_xml w (x : http_payload_with_structure_input_output) + = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" (fun w -> nested_payload_to_xml w v)); + ] + +let http_payload_with_member_xml_name_input_output_to_xml w + (x : http_payload_with_member_xml_name_input_output) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "Hola" (fun w -> payload_with_xml_name_to_xml w v)); + ] + +let http_payload_traits_with_media_type_input_output_to_xml w + (x : http_payload_traits_with_media_type_input_output) = + ignore + [ + (match x.blob with + | None -> null w + | Some v -> element w "blob" (fun w -> Shared.Xml_serializers.text_plain_blob_to_xml w v)); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let http_payload_traits_input_output_to_xml w (x : http_payload_traits_input_output) = + ignore + [ + (match x.blob with + | None -> null w + | Some v -> element w "blob" (fun w -> text w (Base64.encode_exn (Bytes.to_string v)))); + (match x.foo with None -> null w | Some v -> element w "foo" (fun w -> text w v)); + ] + +let enum_payload_input_to_xml w (x : enum_payload_input) = + ignore + [ + (match x.payload with + | None -> null w + | Some v -> element w "payload" (fun w -> string_enum_to_xml w v)); + ] + +let http_empty_prefix_headers_output_to_xml w (x : http_empty_prefix_headers_output) = + ignore + [ + (match x.specific_header with + | None -> null w + | Some v -> element w "specificHeader" (fun w -> text w v)); + (match x.prefix_headers with + | None -> null w + | Some v -> element w "prefixHeaders" (fun w -> Shared.Xml_serializers.string_map_to_xml w v)); + ] + +let http_empty_prefix_headers_input_to_xml w (x : http_empty_prefix_headers_input) = + ignore + [ + (match x.specific_header with + | None -> null w + | Some v -> element w "specificHeader" (fun w -> text w v)); + (match x.prefix_headers with + | None -> null w + | Some v -> element w "prefixHeaders" (fun w -> Shared.Xml_serializers.string_map_to_xml w v)); + ] + +let invalid_greeting_to_xml w (x : invalid_greeting) = + ignore + [ (match x.message with None -> null w | Some v -> element w "Message" (fun w -> text w v)) ] + +let complex_nested_error_data_to_xml w (x : complex_nested_error_data) = + ignore [ (match x.foo with None -> null w | Some v -> element w "Foo" (fun w -> text w v)) ] + +let complex_error_to_xml w (x : complex_error) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "Nested" (fun w -> complex_nested_error_data_to_xml w v)); + (match x.top_level with None -> null w | Some v -> element w "TopLevel" (fun w -> text w v)); + (match x.header with None -> null w | Some v -> element w "Header" (fun w -> text w v)); + ] + +let greeting_with_errors_output_to_xml w (x : greeting_with_errors_output) = + ignore + [ + (match x.greeting with None -> null w | Some v -> element w "greeting" (fun w -> text w v)); + ] + +let fractional_seconds_output_to_xml w (x : fractional_seconds_output) = + ignore + [ + (match x.datetime with + | None -> null w + | Some v -> element w "datetime" (fun w -> Shared.Xml_serializers.date_time_to_xml w v)); + ] + +let flattened_xml_map_with_xml_namespace_output_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "K" (fun w -> (fun w v -> text w v) w k); + element w "V" (fun w -> (fun w v -> text w v) w v))) + pairs + +let flattened_xml_map_with_xml_namespace_output_to_xml w + (x : flattened_xml_map_with_xml_namespace_output) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "KVP" ~ns:"https://the-member.example.com" (fun w -> + element w "K" (fun w -> (fun w v -> text w v) w k); + element w "V" (fun w -> (fun w v -> text w v) w v))) + v); + ] + +let flattened_xml_map_with_xml_name_input_output_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "K" (fun w -> (fun w v -> text w v) w k); + element w "V" (fun w -> (fun w v -> text w v) w v))) + pairs + +let flattened_xml_map_with_xml_name_response_to_xml w (x : flattened_xml_map_with_xml_name_response) + = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "KVP" (fun w -> + element w "K" (fun w -> (fun w v -> text w v) w k); + element w "V" (fun w -> (fun w v -> text w v) w v))) + v); + ] + +let flattened_xml_map_with_xml_name_request_to_xml w (x : flattened_xml_map_with_xml_name_request) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "KVP" (fun w -> + element w "K" (fun w -> (fun w v -> text w v) w k); + element w "V" (fun w -> (fun w v -> text w v) w v))) + v); + ] + +let flattened_xml_map_response_to_xml w (x : flattened_xml_map_response) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "myMap" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v))) + v); + ] + +let flattened_xml_map_request_to_xml w (x : flattened_xml_map_request) = + ignore + [ + (match x.my_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "myMap" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v))) + v); + ] + +let endpoint_with_host_label_operation_request_to_xml w + (x : endpoint_with_host_label_operation_request) = + ignore [ element w "label" (fun w -> text w x.label) ] + +let host_label_header_input_to_xml w (x : host_label_header_input) = + ignore [ element w "accountId" (fun w -> text w x.account_id) ] + +let empty_input_and_empty_output_output_to_xml w _x = null w +let empty_input_and_empty_output_input_to_xml w _x = null w + +let datetime_offsets_output_to_xml w (x : datetime_offsets_output) = + ignore + [ + (match x.datetime with + | None -> null w + | Some v -> element w "datetime" (fun w -> Shared.Xml_serializers.date_time_to_xml w v)); + ] + +let content_type_parameters_output_to_xml w _x = null w + +let content_type_parameters_input_to_xml w (x : content_type_parameters_input) = + ignore + [ + (match x.value with + | None -> null w + | Some v -> element w "value" (fun w -> text w (string_of_int v))); + ] + +let constant_query_string_input_to_xml w (x : constant_query_string_input) = + ignore [ element w "hello" (fun w -> text w x.hello) ] + +let constant_and_variable_query_string_input_to_xml w (x : constant_and_variable_query_string_input) + = + ignore + [ + (match x.maybe_set with None -> null w | Some v -> element w "maybeSet" (fun w -> text w v)); + (match x.baz with None -> null w | Some v -> element w "baz" (fun w -> text w v)); + ] + +let body_with_xml_name_input_output_to_xml w (x : body_with_xml_name_input_output) = + ignore + [ + (match x.nested with + | None -> null w + | Some v -> element w "nested" (fun w -> payload_with_xml_name_to_xml w v)); + ] + +let all_query_string_types_input_to_xml w (x : all_query_string_types_input) = + ignore + [ + (match x.query_params_map_of_strings with + | None -> null w + | Some v -> + element w "queryParamsMapOfStrings" (fun w -> + Shared.Xml_serializers.string_map_to_xml w v)); + (match x.query_integer_enum_list with + | None -> null w + | Some v -> + element w "queryIntegerEnumList" (fun w -> + Shared.Xml_serializers.integer_enum_list_to_xml w v)); + (match x.query_integer_enum with + | None -> null w + | Some v -> + element w "queryIntegerEnum" (fun w -> Shared.Xml_serializers.integer_enum_to_xml w v)); + (match x.query_enum_list with + | None -> null w + | Some v -> + element w "queryEnumList" (fun w -> Shared.Xml_serializers.foo_enum_list_to_xml w v)); + (match x.query_enum with + | None -> null w + | Some v -> element w "queryEnum" (fun w -> Shared.Xml_serializers.foo_enum_to_xml w v)); + (match x.query_timestamp_list with + | None -> null w + | Some v -> + element w "queryTimestampList" (fun w -> Shared.Xml_serializers.timestamp_list_to_xml w v)); + (match x.query_timestamp with + | None -> null w + | Some v -> + element w "queryTimestamp" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v))); + (match x.query_boolean_list with + | None -> null w + | Some v -> + element w "queryBooleanList" (fun w -> Shared.Xml_serializers.boolean_list_to_xml w v)); + (match x.query_boolean with + | None -> null w + | Some v -> element w "queryBoolean" (fun w -> text w (string_of_bool v))); + (match x.query_double_list with + | None -> null w + | Some v -> + element w "queryDoubleList" (fun w -> Shared.Xml_serializers.double_list_to_xml w v)); + (match x.query_double with + | None -> null w + | Some v -> + element w "queryDouble" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.query_float with + | None -> null w + | Some v -> + element w "queryFloat" (fun w -> + text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v))); + (match x.query_long with + | None -> null w + | Some v -> element w "queryLong" (fun w -> text w (Smaws_Lib.CoreTypes.Int64.to_string v))); + (match x.query_integer_set with + | None -> null w + | Some v -> + element w "queryIntegerSet" (fun w -> Shared.Xml_serializers.integer_set_to_xml w v)); + (match x.query_integer_list with + | None -> null w + | Some v -> + element w "queryIntegerList" (fun w -> Shared.Xml_serializers.integer_list_to_xml w v)); + (match x.query_integer with + | None -> null w + | Some v -> element w "queryInteger" (fun w -> text w (string_of_int v))); + (match x.query_short with + | None -> null w + | Some v -> element w "queryShort" (fun w -> text w (string_of_int v))); + (match x.query_byte with + | None -> null w + | Some v -> element w "queryByte" (fun w -> text w (string_of_int v))); + (match x.query_string_set with + | None -> null w + | Some v -> element w "queryStringSet" (fun w -> Shared.Xml_serializers.string_set_to_xml w v)); + (match x.query_string_list with + | None -> null w + | Some v -> + element w "queryStringList" (fun w -> Shared.Xml_serializers.string_list_to_xml w v)); + (match x.query_string with + | None -> null w + | Some v -> element w "queryString" (fun w -> text w v)); + ] + +let nested_xml_maps_input_output_to_xml w (x : nested_xml_maps_input_output) = + ignore + [ + (match x.flat_nested_map with + | None -> null w + | Some v -> + List.iter + (fun (k, v) -> + element w "flatNestedMap" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> Shared.Xml_serializers.foo_enum_map_to_xml w v))) + v); + (match x.nested_map with + | None -> null w + | Some v -> element w "nestedMap" (fun w -> nested_map_to_xml w v)); + ] + +let nested_xml_map_with_xml_name_input_output_to_xml w + (x : nested_xml_map_with_xml_name_input_output) = + ignore + [ + (match x.nested_xml_map_with_xml_name_map with + | None -> null w + | Some v -> + element w "nestedXmlMapWithXmlNameMap" (fun w -> + nested_xml_map_with_xml_name_map_to_xml w v)); + ] diff --git a/model_tests/protocols/shared/dune b/model_tests/protocols/shared/dune index 4d89d419..710b11c6 100644 --- a/model_tests/protocols/shared/dune +++ b/model_tests/protocols/shared/dune @@ -11,7 +11,9 @@ json_serializers.ml json_deserializers.ml query_serializers.ml - query_deserializers.ml) + query_deserializers.ml + xml_serializers.ml + xml_deserializers.ml) (deps (:gen ../../gen.exe) (:input ../../../smithy-aws-protocol-tests_model.json) @@ -32,7 +34,9 @@ json_serializers.ml json_deserializers.ml query_serializers.ml - query_deserializers.ml)))) + query_deserializers.ml + xml_serializers.ml + xml_deserializers.ml)))) (library (name shared) @@ -43,7 +47,9 @@ json_serializers json_deserializers query_serializers - query_deserializers) + query_deserializers + xml_serializers + xml_deserializers) (preprocess (pps ppx_deriving.show ppx_deriving.eq)) (libraries Smaws_Lib Smaws_Test_Support_Lib alcotest eio_main)) diff --git a/model_tests/protocols/shared/shared.ml b/model_tests/protocols/shared/shared.ml index 6b6bbc65..86344eee 100644 --- a/model_tests/protocols/shared/shared.ml +++ b/model_tests/protocols/shared/shared.ml @@ -2,5 +2,7 @@ module Types = Types include Builders module Query_serializers = Query_serializers module Query_deserializers = Query_deserializers +module Xml_serializers = Xml_serializers +module Xml_deserializers = Xml_deserializers module Json_serializers = Json_serializers module Json_deserializers = Json_deserializers diff --git a/model_tests/protocols/shared/shared.mli b/model_tests/protocols/shared/shared.mli index 3c66c8f7..345ada10 100644 --- a/model_tests/protocols/shared/shared.mli +++ b/model_tests/protocols/shared/shared.mli @@ -11,5 +11,7 @@ val make_greeting_struct : ?hi:Smaws_Lib.Smithy_api.Types.string_ -> unit -> gre module Query_serializers = Query_serializers module Query_deserializers = Query_deserializers +module Xml_serializers = Xml_serializers +module Xml_deserializers = Xml_deserializers module Json_serializers = Json_serializers module Json_deserializers = Json_deserializers diff --git a/model_tests/protocols/shared/xml_deserializers.ml b/model_tests/protocols/shared/xml_deserializers.ml new file mode 100644 index 00000000..3d33fdbc --- /dev/null +++ b/model_tests/protocols/shared/xml_deserializers.ml @@ -0,0 +1,129 @@ +open Smaws_Lib.Xml.Parse +open Types + +let unit_of_xml _ = () + +let foo_union_of_xml i = + let r_integer = ref None in + let r_string_ = ref None in + Structure.scanSequence i [ "integer"; "string" ] (fun tag _ -> + match tag with + | "integer" -> r_integer := Some (Read.element_value i "integer" Primitive.int_of_string ()) + | "string" -> r_string_ := Some (Read.element_value i "string" Fun.id ()) + | _ -> Read.skip_element i); + (match ( ! ) r_integer with + | Some v -> Integer v + | None -> ( + match ( ! ) r_string_ with + | Some v -> String v + | None -> failwith "no union member present in xml response") + : foo_union) + +let union_set_of_xml i = Read.sequences i "member" (fun i _ -> foo_union_of_xml i) () +let timestamp_set_of_xml i = Read.elements_value i "member" Primitive.timestamp_iso_of_string () +let timestamp_list_of_xml i = Read.elements_value i "member" Primitive.timestamp_iso_of_string () +let text_plain_blob_of_xml i = Primitive.blob_of_string (Read.data i) + +let greeting_struct_of_xml i = + let r_hi = ref None in + Structure.scanSequence i [ "hi" ] (fun tag _ -> + match tag with + | "hi" -> r_hi := Some (Read.element_value i "hi" Fun.id ()) + | _ -> Read.skip_element i); + ({ hi = ( ! ) r_hi } : greeting_struct) + +let structure_set_of_xml i = Read.sequences i "member" (fun i _ -> greeting_struct_of_xml i) () +let string_set_of_xml i = Read.elements_value i "member" Fun.id () + +let string_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + () + +let string_list_of_xml i = Read.elements_value i "member" Fun.id () + +let string_list_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.sequence i "value" (fun i _ -> string_list_of_xml i) () in + (k, v)) + () + +let sparse_string_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.element_value i "value" Fun.id () in + (k, v)) + () + +let sparse_string_list_of_xml i = Read.elements_value i "member" Fun.id () +let sparse_short_list_of_xml i = Read.elements_value i "member" Primitive.int_of_string () +let short_set_of_xml i = Read.elements_value i "member" Primitive.int_of_string () +let short_list_of_xml i = Read.elements_value i "member" Primitive.int_of_string () +let nested_string_list_of_xml i = Read.sequences i "member" (fun i _ -> string_list_of_xml i) () +let long_set_of_xml i = Read.elements_value i "member" Primitive.long_of_string () +let long_list_of_xml i = Read.elements_value i "member" Primitive.long_of_string () +let list_set_of_xml i = Read.sequences i "member" (fun i _ -> string_list_of_xml i) () +let jpeg_blob_of_xml i = Primitive.blob_of_string (Read.data i) +let integer_set_of_xml i = Read.elements_value i "member" Primitive.int_of_string () +let integer_list_of_xml i = Read.elements_value i "member" Primitive.int_of_string () + +let integer_enum_of_xml i = + let s = Read.data i in + (match s with "3" -> C | "2" -> B | "1" -> A | _ -> failwith "unknown enum value" + : integer_enum) + +let integer_enum_set_of_xml i = Read.sequences i "member" (fun i _ -> integer_enum_of_xml i) () + +let integer_enum_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.sequence i "value" (fun i _ -> integer_enum_of_xml i) () in + (k, v)) + () + +let integer_enum_list_of_xml i = Read.sequences i "member" (fun i _ -> integer_enum_of_xml i) () +let http_date_of_xml i = Primitive.timestamp_httpdate_of_string (Read.data i) +let http_date_set_of_xml i = Read.sequences i "member" (fun i _ -> http_date_of_xml i) () +let greeting_list_of_xml i = Read.sequences i "member" (fun i _ -> greeting_struct_of_xml i) () + +let foo_enum_of_xml i = + let s = Read.data i in + (match s with + | "0" -> ZERO + | "1" -> ONE + | "Bar" -> BAR + | "Baz" -> BAZ + | "Foo" -> FOO + | _ -> failwith "unknown enum value" + : foo_enum) + +let foo_enum_set_of_xml i = Read.sequences i "member" (fun i _ -> foo_enum_of_xml i) () + +let foo_enum_map_of_xml i = + Read.sequences i "entry" + (fun i _ -> + let k = Read.element_value i "key" Fun.id () in + let v = Read.sequence i "value" (fun i _ -> foo_enum_of_xml i) () in + (k, v)) + () + +let foo_enum_list_of_xml i = Read.sequences i "member" (fun i _ -> foo_enum_of_xml i) () +let float_list_of_xml i = Read.elements_value i "member" Primitive.float_of_string () +let epoch_seconds_of_xml i = Primitive.timestamp_epoch_of_string (Read.data i) +let double_list_of_xml i = Read.elements_value i "member" Primitive.double_of_string () +let date_time_of_xml i = Primitive.timestamp_iso_of_string (Read.data i) +let date_time_set_of_xml i = Read.sequences i "member" (fun i _ -> date_time_of_xml i) () +let date_time_list_of_xml i = Read.sequences i "member" (fun i _ -> date_time_of_xml i) () +let byte_set_of_xml i = Read.elements_value i "member" Primitive.int_of_string () +let byte_list_of_xml i = Read.elements_value i "member" Primitive.int_of_string () +let boolean_set_of_xml i = Read.elements_value i "member" Primitive.bool_of_string () +let boolean_list_of_xml i = Read.elements_value i "member" Primitive.bool_of_string () +let blob_set_of_xml i = Read.elements_value i "member" Primitive.blob_of_string () +let blob_list_of_xml i = Read.elements_value i "member" Primitive.blob_of_string () diff --git a/model_tests/protocols/shared/xml_serializers.ml b/model_tests/protocols/shared/xml_serializers.ml new file mode 100644 index 00000000..d77104fe --- /dev/null +++ b/model_tests/protocols/shared/xml_serializers.ml @@ -0,0 +1,216 @@ +open Smaws_Lib.Xml.Write +open Types + +let foo_union_to_xml w (x : foo_union) = + match x with + | Integer v -> element w "integer" (fun w -> text w (string_of_int v)) + | String v -> element w "string" (fun w -> text w v) + +let union_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> foo_union_to_xml w item)) xs + +let timestamp_set_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v)) + w item)) + xs + +let timestamp_list_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v)) + w item)) + xs + +let text_plain_blob_to_xml w v = text w (Base64.encode_exn (Bytes.to_string v)) + +let greeting_struct_to_xml w (x : greeting_struct) = + ignore [ (match x.hi with None -> null w | Some v -> element w "hi" (fun w -> text w v)) ] + +let structure_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> greeting_struct_to_xml w item)) xs + +let string_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> (fun w v -> text w v) w item)) xs + +let string_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> (fun w v -> text w v) w v))) + pairs + +let string_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> (fun w v -> text w v) w item)) xs + +let string_list_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> string_list_to_xml w v))) + pairs + +let sparse_string_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> (fun w v -> text w v) w v))) + pairs + +let sparse_string_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> (fun w v -> text w v) w item)) xs + +let sparse_short_list_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_int v)) w item)) + xs + +let short_set_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_int v)) w item)) + xs + +let short_list_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_int v)) w item)) + xs + +let nested_string_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> string_list_to_xml w item)) xs + +let long_set_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Smaws_Lib.CoreTypes.Int64.to_string v)) w item)) + xs + +let long_list_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Smaws_Lib.CoreTypes.Int64.to_string v)) w item)) + xs + +let list_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> string_list_to_xml w item)) xs + +let jpeg_blob_to_xml w v = text w (Base64.encode_exn (Bytes.to_string v)) + +let integer_set_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_int v)) w item)) + xs + +let integer_list_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_int v)) w item)) + xs + +let integer_enum_to_xml w (x : integer_enum) = + text w (match x with C -> string_of_int 3 | B -> string_of_int 2 | A -> string_of_int 1) + +let integer_enum_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> integer_enum_to_xml w item)) xs + +let integer_enum_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> integer_enum_to_xml w v))) + pairs + +let integer_enum_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> integer_enum_to_xml w item)) xs + +let http_date_to_xml w v = + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_httpdate_to_string v) + +let http_date_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> http_date_to_xml w item)) xs + +let greeting_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> greeting_struct_to_xml w item)) xs + +let foo_enum_to_xml w (x : foo_enum) = + text w (match x with ZERO -> "0" | ONE -> "1" | BAR -> "Bar" | BAZ -> "Baz" | FOO -> "Foo") + +let foo_enum_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> foo_enum_to_xml w item)) xs + +let foo_enum_map_to_xml w pairs = + List.iter + (fun (k, v) -> + element w "entry" (fun w -> + element w "key" (fun w -> (fun w v -> text w v) w k); + element w "value" (fun w -> foo_enum_to_xml w v))) + pairs + +let foo_enum_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> foo_enum_to_xml w item)) xs + +let float_list_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v)) w item)) + xs + +let epoch_seconds_to_xml w v = + text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_epoch_to_string v) + +let double_list_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Smaws_Lib.Protocols.RestXml.Serialize.float_field_to_string v)) w item)) + xs + +let date_time_to_xml w v = text w (Smaws_Lib.Protocols.RestXml.Serialize.timestamp_iso_to_string v) + +let date_time_set_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> date_time_to_xml w item)) xs + +let date_time_list_to_xml w xs = + List.iter (fun item -> element w "member" (fun w -> date_time_to_xml w item)) xs + +let byte_set_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_int v)) w item)) + xs + +let byte_list_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_int v)) w item)) + xs + +let boolean_set_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_bool v)) w item)) + xs + +let boolean_list_to_xml w xs = + List.iter + (fun item -> element w "member" (fun w -> (fun w v -> text w (string_of_bool v)) w item)) + xs + +let blob_set_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Base64.encode_exn (Bytes.to_string v))) w item)) + xs + +let blob_list_to_xml w xs = + List.iter + (fun item -> + element w "member" (fun w -> + (fun w v -> text w (Base64.encode_exn (Bytes.to_string v))) w item)) + xs diff --git a/refactorings/restxml-protocol.md b/refactorings/restxml-protocol.md new file mode 100644 index 00000000..cded99d4 --- /dev/null +++ b/refactorings/restxml-protocol.md @@ -0,0 +1,775 @@ +# Plan: `aws.protocols#restXml` protocol support + +> Status: **plan only — no restXml implementation started.** Reviewed and +> revised 2026-07-15 after a three-agent plan review (plan-vs-codebase audit, +> spec-conformance audit, guidelines/risk audit) and after merging the +> `claude/awsquery-protocol-support-umievv` branch (post-fix AwsQuery) into this +> `restxml` branch. All "current-state" claims below were re-verified against the +> merged tree on 2026-07-15. +> Spec: +> Conformance model (vendored): `smithy-aws-protocol-tests_model.json`, namespaces +> `aws.protocoltests.restxml` (service `RestXml`, `restXml = {}` — wrapped +> envelope) and `aws.protocoltests.restxml.xmlns` (service +> `RestXmlWithNamespace`, `restXml = {}`, applies a service-level +> `@xmlNamespace`). `noErrorWrapping` is **not** exercised by either targeted +> namespace; it appears only on `com.amazonaws.s3#AmazonS3` and is needed for the +> Phase 9 S3 SDK goal, not Phase 8 conformance. + +This document is the implementation plan for adding the Smithy `restXml` AWS +protocol to the generator. No code was changed for this plan; the merge brought +in reusable AwsQuery infrastructure (see §3) but no restXml-specific code. + +--- + +## 1. Goal and scope + +Generate working OCaml SDKs for services that apply `aws.protocols#restXml` +(S3, CloudFront, and the protocol conformance test services), covering: + +- HTTP binding traits (`http`, `httpHeader`, `httpLabel`, `httpPayload`, + `httpQuery`, `httpQueryParams`, `httpPrefixHeaders`, `httpChecksumRequired`, + `httpError`, `httpResponseCode`, `endpoint`/`hostLabel`). +- XML serialization of request bodies and deserialization of response bodies, + including the XML-specific traits (`xmlName`, `xmlAttribute`, `xmlFlattened`, + `xmlNamespace` — including `prefix` and service-level default namespace). +- The `restXml` error-response envelope (`` / `` / + `` / `` / ``), including the `noErrorWrapping` variant + (root `` directly; needed for S3). +- Content-Type derivation (default `application/xml`; `mediaType`/`string`/ + `blob`/`enum` overrides when `httpPayload` targets them). +- Non-numeric float/double sentinel strings (`NaN`, `Infinity`, `-Infinity`), + including in `@httpLabel` positions. +- Timestamp formats: default differs by binding location — XML body = + `date-time`; `@httpHeader` = `http-date` (IMF-fixdate); `@httpLabel`/ + `@httpQuery` = `date-time`; overridable by `timestampFormat`. +- `@idempotencyToken` auto-fill (UUID when unset). +- `@httpQuery`-over-`@httpQueryParams` precedence; `@httpQueryParams` targeting + `map>`; empty-prefix `@httpPrefixHeaders` and + `@httpHeader`-over-`@httpPrefixHeaders` precedence. +- Greedy `@httpLabel` must NOT percent-encode `/`. +- Default-value omission for `@internal` members; null/empty-value and + empty-container handling per the conformance tests. +- Passing the Smithy protocol compliance tests for the two `restxml` + namespaces (full conformance — see §8 for the `requestCompression` carve-out). + +**Out of scope for this plan** (call out separately if/when requested): +event streams (`eventStreamHttp`, Amazon Event Stream format) and +`requestCompression` integration (separate in-progress plan, +`add_request_compression.md`). `document` shapes are **not supported** by this +protocol per spec and will be rejected at codegen. + +### requestCompression carve-out (decision, 2026-07-15) + +The `aws.protocoltests.restxml` namespace contains `PutWithContentEncoding`, +which carries `@requestCompression({encodings:["gzip"]})` and two +`httpRequestTest`s: `SDKAppliedContentEncoding_restXml` and +`SDKAppendedGzipAfterProvidedEncoding_restXml`. requestCompression is out of +scope for this plan. The trait is already parsed +(`RequestCompressionTrait of string list`) and the `` `Compressed `` +`input_body` variant exists, but the codegen that actually compresses request +bodies was stripped (commit `538051f`) and is not wired. **Decision: add those +two test IDs to `bannedTests`** in `sdkgen/gen_protocol_tests.ml` (the mechanism +already exists, currently AwsJson-only). They get unbanned when the +requestCompression plan lands. Phase 8's exit criterion is "green for both +restXml namespaces modulo the two banned requestCompression tests." + +### Confirmed scope additions from the 2026-07-15 spec audit (decision: full conformance) + +The following were missing from the original plan and are now in scope because +the conformance model exercises them: `@httpResponseCode`; +`@idempotencyToken` auto-fill; enum/intEnum serialization (incl. enum-as- +`httpPayload`); per-binding timestamp defaults; `@httpQuery`/`@httpQueryParams` +precedence; greedy-label `/` non-encoding; empty-prefix `@httpPrefixHeaders` ++ httpHeader-over-prefix precedence; `httpQueryParams` targeting +`map>`; null/empty/empty-container handling; +`xmlNamespace` `prefix` and service-level default namespace; `xmlNamespace` on +list/map shapes and on members; `endpoint`/`hostLabel` host-prefix +substitution into the generated request. + +--- + +## 2. Spec digest (authoritative behaviors) + +### 2.1 The `restXml` service trait +Structure with members `http : [string]`, `eventStreamHttp : [string]`, +`noErrorWrapping : boolean`. Only `noErrorWrapping` changes wire behavior for +us; `http`/`eventStreamHttp` are ALPN hints (informational; client picks first +understood, defaults to `http/1.1`) — **not captured** (Q5 resolved: skip). + +### 2.2 Content-Type +- Default `application/xml`. +- If a top-level member is `@httpPayload`: + - target has `mediaType` → use that value + - target `string` → `text/plain` + - target `blob` → `application/octet-stream` (and the body is the **raw** blob, not base64 — see §2.4) + - target `enum` → `text/plain` (raw enum value text; `HttpEnumPayload`) + - target `structure`/`union` → `application/xml` + - `document` → unsupported (reject at codegen). +- No conformance test forbids `Content-Type` on body-less GETs, so a GET with + no body may still set `application/xml` (conformance-safe). + +### 2.3 HTTP bindings +Every operation bound to a `restXml` service **MUST** have `@http` (method + +uri + optional success `code`). Request identification is by +(method, path) match plus Content-Type. URI templates use `{label}` segments +filled from `@httpLabel` members; query string literals embedded in the +`@http` `uri` are preserved. **Greedy labels (`{label+}`) MUST NOT +percent-encode `/`** (`HttpRequestWithGreedyLabelInPath`: `baz:"there/guy"` → +`.../baz/there/guy`). `@httpQuery` binds a member to a query param; +`@httpQueryParams` binds a `map` (possibly `map>`, +serialized as repeated query keys) to extra query params; `@httpHeader` binds a +member to a header; `@httpPrefixHeaders` binds a map to prefixed headers +(prefix may be `""`, matching all headers); `@httpPayload` promotes a member to +the whole body (skipping XML element wrapping for that member). + +**Precedence rules:** +- `@httpQuery` over `@httpQueryParams`: if a key is set by both, the + `@httpQuery` value wins and the conflicting `@httpQueryParams` entry is + **dropped** (not duplicated) — `RestXmlQueryPrecedence` expects + `bar=named`, map's `bar` removed. +- `@httpHeader` over `@httpPrefixHeaders`: a specifically-bound header wins + over a prefix match on the same name — `HttpEmptyPrefixHeaders`: + `specificHeader` (`@httpHeader("hello")`) overrides `prefixHeaders.hello`. + +**`@httpResponseCode`:** a marker on a structure output member; the response's +HTTP status code is deserialized into that member (`RestXmlHttpResponseCode`, +code 201 → `params.Status = 201`). + +### 2.4 XML shape serialization (request bodies & non-payload response parts) +| Smithy type | XML | +|---|---| +| blob | text node, base64 — **except** when targeted by `@httpPayload`, where it is the **raw** value | +| boolean | "true"/"false" | +| byte/short/integer/long | decimal text | +| float/double | decimal text; `NaN`/`Infinity`/`-Infinity` as those strings (also in `@httpLabel` positions — `HttpRequestWithFloatLabels`) | +| bigDecimal/bigInteger | decimal text, scientific notation if needed | +| string | XML-escaped UTF-8 text | +| timestamp | text; **default format depends on binding location**: XML body = `date-time`; `@httpHeader` = `http-date` (IMF-fixdate); `@httpLabel`/`@httpQuery` = `date-time`. Overridable by `timestampFormat` on the member or shape. (`TimestampFormatHeaders` → `X-defaultFormat: Mon, 16 Dec 2019 23:48:18 GMT`; `HttpRequestWithLabelsAndTimestampFormat` → `2019-12-16T23:48:18Z`.) | +| enum / intEnum | the enum value text (`XmlEnums` → `Foo`/`0`/`1`; `XmlIntEnums` → `1`/`2`). As `@httpPayload` → `text/plain`, raw value (`HttpEnumPayload`). | +| list/set | element wrapping each item in ``; `xmlName` (on the member) renames the item element; `xmlFlattened` unwraps items into the container. **For flattened lists, `@xmlName` on the list member has NO effect** (the member's own `@xmlName` names the repeated element; the inner list-member `@xmlName` is ignored). | +| map | element wrapping each pair in `` with ``/``; `xmlName` renames key/value elements (never `entry`); `xmlFlattened` unwraps entries into the container. **For flattened maps, key/value `@xmlName` IS retained** (`FlattenedXmlMapWithXmlName` → `K`/`V`). | +| structure | element with one child element per set member named after the member; `xmlName` renames the element — but **only when the structure is the body root** (or a payload); `@xmlName` on a structure does NOT influence the element name when that structure is nested as a member (the member's name is used). `xmlAttribute` renders as an attribute of the container; `xmlNamespace` adds `xmlns`. | +| union | like structure, exactly one member set | + +**`xmlNamespace` placement (not just structures):** the trait selector includes +`service, simpleType, list, map, structure, union, member`. `xmlNamespace` +value is `{uri, prefix}` — **`prefix` is required for conformance** (the +original plan's "minor follow-up" classification was wrong; see G6b): +`PayloadWithXmlNamespaceAndPrefix` → `<... xmlns:baz="http://foo.com">`; +`xmlns#SimpleScalarPropertiesInputOutput.Nested` → +``. List/map shapes +and list/map members may also carry `xmlNamespace` (`XmlNamespaces`: +``, ``). A +**service-level** `@xmlNamespace` (e.g. `RestXmlWithNamespace`, +`uri:"https://example.com"`) is applied to request/response root elements even +when the structure shapes carry no `xmlNamespace` trait: +``. + +**Empty/null handling:** empty containers serialize as empty elements (not +omitted) — `XmlEmptyLists`/`XmlEmptyMaps`/`XmlEmptyStrings`; both self-closed +and open forms accepted on deserialize. Null query/header values are omitted; +empty strings are preserved (`OmitsNullSerializesEmptyString`, +`NullAndEmptyHeadersClient`). + +### 2.5 Error response envelope +Default (used by both targeted conformance namespaces): +```xml + + + Sender|Receiver + {errorShapeName} + ... + + ... + +``` +With `noErrorWrapping` (S3 `AmazonS3` only, not in targeted conformance +namespaces): the outer `` and inner `` collapse to a +single root `` containing `Type`, `Code`, the error members, and +`RequestId` directly — e.g. `SenderNoSuchBucket...`. +This is **definitive** (per spec + S3 conformance), not hedged. Error members +bound via HTTP traits (`httpHeader`, `httpPrefixHeaders`) are read from +headers, not the body. `Code` is the error **shape name** (no namespace); +renaming error shapes is **not permitted** by this protocol. + +### 2.6 Default-value omission +Serializers SHOULD omit `@internal` members' default values; deserializers +SHOULD fill zero values for missing `@required` members. Both are **SHOULD** +(not MUST). Note: neither targeted restXml namespace uses `@internal`, so this +is not conformance-blocking for Phase 8 — but `InternalTrait` must still be +parsed and omission supported for spec correctness and the Phase 9 S3/CloudFront +goal. + +--- + +## 3. Current-state inventory (re-verified against the merged tree, 2026-07-15) + +### 3.1 Protocol partially wired +- `smaws_lib/Service.ml`: `type protocol = ... | RestXml | ...` — present. +- `smaws_parse/Smithy.ml:246`: `aws.protocols#restXml` parses to + `Trait.AwsProtocolRestXmlTrait` (bare — **no `noErrorWrapping` captured**, G1). +- `codegen/Service_metadata.ml:21`: emits `Smaws_Lib.Service.RestXml`. +- `sdkgen/SmithyHelpers.ml:10`: `"AWS REST XML"` label. + +### 3.2 XML machinery +- `smaws_lib/Xml.ml` is **parse-only** (modules `Parse`/`Read`/`Structure`; + no `Write`/`Print`). `xmlm` is a dependency of `smaws_lib` + (`smaws_lib/dune`). `Xml.Parse` is used by `AwsQuery.ml`. **No XML printer + exists** (G7). + +### 3.3 HTTP layer +- `smaws_lib/http/http.mli`: `request` with `method_` poly-variant and + `input_body = [`None | `String of string | `Compressed of string * + body_encoding | `Form of (string * string list) list]`. The `` `Compressed `` + variant exists (requestCompression plumbing) but compression codegen is + stripped. `uri` package used (`Service.makeUri`, `Uri.encoded_of_query` in + AwsQuery). Path-template + label substitution + percent-encoding must be + added (G8). + +### 3.4 Runtime protocol module pattern +- `AwsJson.request` and `AwsQuery.request` are now **both context-based** + (`~context : http_t Context.t`, using `Context.http_type`/`Context.http`/ + `Context.config`). The original plan's caveat that `AwsQuery.request` used a + non-context API is **stale post-merge** — `AwsQuery.request` is now the + closer template in both spirit (XML responses, error envelope with `Code`) + and API shape. +- `AwsQuery.request` signature: + `let request (type http_t) ~(action:string) ~(xmlNamespace:string) + ~(service:Service.descriptor) ~(context:http_t Context.t) ...`. It parses + responses via `Xml.Parse` and builds query-string bodies via + `Uri.encoded_of_query`. It has `module Error = struct type t = + { errorType; code } end` and `module Errors` with a default handler. +- **`smaws_lib/AwsErrors.ml` already exists** with the **JSON namespaced** + error model (`namespaced_error`, `aws_service_error`, `t = \`AWSServiceError + of ...`). This is a *different* concept from the XML envelope `Error.t`. + restXml must keep its XML envelope type **separate** (Q4 resolved: do NOT + fold into `AwsErrors`). + +### 3.5 Codegen protocol-module pattern +- `sdkgen/protocol.ml` defines `type t = AwsQuery | AwsJson` and `of_service`, + which currently `failwith "Unsupported protocol"` for `RestXml`/`Ec2Query`. + `gen_operations.ml`, `gen_serialisers.ml`, `gen_deserialisers.ml` all + dispatch on `Protocol.t`. **So GC2's dispatch mechanism now exists**; restXml + needs adding to `Protocol.t` (as `RestXml`) and a branch in each dispatcher. +- `codegen/AwsProtocolJson.ml` (917 lines) has `Serialiser`/`Deserialiser`/ + `Operations`. **`codegen/AwsProtocolQuery.ml` (1079 lines) now exists and is + the closer codegen template** for restXml (XML serialiser/deserialiser/ + operations, `Xml.Parse` consumers). +- `codegen/Modules.ml` centralizes module-path literals (`protocolAwsJson`, + `protocolAwsQuery`, `json`, `jsonSerializeHelpers`, …); no + `protocolRestXml`/`xml`/`xmlWrite`/`xmlParse` yet. +- `codegen/Service_metadata.ml` produces `let service : + Smaws_Lib.Service.descriptor` in scope. + +### 3.6 Conformance test harness +- `model_tests/gen.ml` lists `aws.protocoltests.restxml.xmlns → Restxml_xmlns` + and `aws.protocoltests.query → Query`, but **not** plain + `aws.protocoltests.restxml` (G10 still open). +- `sdkgen/gen_protocol_tests.ml`: + - **Response tests are now protocol-aware**: `Mock.mock_response ?body ... + ~status:[%e status_code] ~headers:[%e response_headers_expr]` drives status + and Content-Type from the test record (so G12 is **resolved for response + tests**). + - **Request tests (the AwsJson path) still hardcode the mock response** + `~status:200 ~headers:[("Content-Type","application/json")]`. restXml + request-tests need their own mock path (like the existing query path, + which uses `~status:200 ~headers:[]`) — otherwise an XML deserializer + parsing the `application/json` mock response will fail (G11/G12 remaining). + - Body comparison is **JSON** (`Yojson.Basic.from_string`, + `Smaws_Lib.Json.of_string`, `Alcotest_http.input_body_json_testable`) — + restXml needs an XML-aware comparison (G11). + - `TimestampShape _, `Int` and `TimestampShape _, `Float` arms both present. + - `Mock.last_request ()` is wrapped in `try/with Stack.Empty`. + - `bannedTests` exists (currently `["SDKAppliedContentEncoding_awsJson1_1"; + "SDKAppendsGzipAndIgnoresHttpProvidedEncoding_awsJson1_1"]`) and is + applied to both request and response test selection. restXml will add its + two requestCompression IDs here (§1 carve-out). + - `appliesTo` filter correctly keeps `Client` (the old inverted-filter bug + is fixed); `appliesTo` parsing uses `Result`/`CustomError` (the old + `failwith`-in-`Result.map` is fixed). + +### 3.7 Shapes & traits +`smithy_ast/Shape.ml` defines **23** `shapeDescriptor` constructors (the +original plan said "21"; corrected). Members carry `traits : Trait.t list +option` distinct from shape-level traits. `Organize.partitionOperationShapes` +and `Trait.isErrorTrait` exist. `EnumShape` is modeled (enum/intEnum +serialization is a codegen gap, not an AST gap). + +### 3.8 requestCompression plumbing (out of scope, but present) +`smithy.api#requestCompression` parses to +`RequestCompressionTrait of string list`; `` `Compressed `` `input_body` +variant and the test-body `Compressed` comparison exist. The codegen that +compresses request bodies is **not** wired (stripped). Out of scope for this +plan; two tests banned (§1). + +--- + +## 4. Gap analysis (concrete, with locations) + +### AST / parser gaps (`smithy_ast/Trait.ml`, `smaws_parse/Smithy.ml`) +- **G1 — `restXml` trait drops `noErrorWrapping`.** Bare variant; parser at + `Smithy.ml:246` discards the value. Need `AwsProtocolRestXmlTrait of + restXmlConfig`. +- **G2 — `http` trait drops method/uri/code.** Bare `HttpTrait`; parser + discards the object. Need `HttpTrait of { method_; uri; code : int option }`. + (Biggest blocker — restXml requires per-operation method + URI template.) +- **G3 — `httpHeader` drops the header name.** Need `HttpHeaderTrait of string`. +- **G4 — `httpQuery` drops the query param name.** Need `HttpQueryTrait of string`. +- **G5 — `endpoint` trait drops `hostPrefix`.** Need + `EndpointTrait of { hostPrefix : string }`. +- **G6 — `internal` trait not modeled.** Add `InternalTrait` and parser case. +- **G6b — `xmlNamespace` drops `prefix` — BLOCKER (was misclassified minor).** + `ApiXmlNamespaceTrait of string` stores `uri` only. Conformance requires + `prefix` (`xmlns:baz=...`, `xsi:someName=...`). Widen to + `ApiXmlNamespaceTrait of { uri : string; prefix : string option }`. +- **G6c — `httpResponseCode` trait not modeled.** Marker on an output member. + Add `HttpResponseCodeTrait` + parser case for `smithy.api#httpResponseCode`. +- **G6d — `idempotencyToken` trait not modeled.** Marker on a member. Add + `IdempotencyTokenTrait` + parser case for `smithy.api#idempotencyToken`. + +### Runtime gaps (`smaws_lib/`) +- **G7 — No XML printer.** Add `Xml.Write` on `Xmlm.make_output`. +- **G8 — No HTTP binding assembly helper.** Path-template `{label}` + substitution (with greedy `/` exception), percent-encode (path segment vs + query param), query-list merge with `httpQuery`-over-`httpQueryParams` + precedence, host-prefix substitution for `endpoint`/`hostLabel`. +- **G9 — No `RestXml` runtime protocol module.** Create + `smaws_lib/protocols_impl/RestXml.ml` (registered in `Protocols.ml`), context- + based `request` (mirror the merged `AwsQuery.request`), status dispatch, + error-envelope parse (default + `noErrorWrapping`), signing, `Failure` catch, + and a separate `RestXml.Error` type (not folded into `AwsErrors`). + +### Codegen gaps (`codegen/`, `sdkgen/`) +- **GC1 — No `codegen/AwsProtocolRestXml.ml`.** Mirror `AwsProtocolQuery.ml` + with `Serialiser`/`Deserialiser`/`Operations`. Element-name resolution must + consult `xmlName`/`xmlAttribute`/`xmlFlattened`/`xmlNamespace` (incl. prefix + and service-level default) on each member/shape. +- **GC2 — Dispatch mechanism exists; restXml branch absent.** `Protocol.t` + must gain `RestXml`; `of_service` must map `AwsProtocolRestXmlTrait` to it; + `gen_operations`/`gen_serialisers`/`gen_deserialisers` need a `RestXml` branch. +- **GC3 — Operations generator must emit HTTP-binding call data.** Method, + resolved uri (with greedy-label exception), query (with `httpQuery`/ + `httpQueryParams` precedence and list-valued maps), headers (with + `httpHeader`/`httpPrefixHeaders` precedence and empty prefix), `httpPayload` + flag (for Content-Type + body wrapping), `httpResponseCode` member, and + `idempotencyToken` auto-fill. + +### Spec-behavior codegen gaps (from 2026-07-15 audit) +- **G13 — `httpPayload` blob serialized base64 — wrong.** Payload blob is raw + (§2.4). Affects request bodies and response decoding. +- **G14 — `httpPayload` on structure: structure's own root element IS the + body** (Q3 resolved). Element name = target shape name / structure + `@xmlName` / member `@xmlName` (precedence: member `@xmlName` on the + `httpPayload` member renames the wrapper). Members nested inside. +- **G15 — enum/intEnum serialization missing** (incl. enum-as-`httpPayload` → + `text/plain`). +- **G16 — per-binding timestamp defaults not implemented** (header + `http-date`, label/query `date-time`). +- **G17 — `httpQuery`/`httpQueryParams` precedence not implemented.** +- **G18 — greedy-label `/` non-encoding not implemented.** +- **G19 — empty-prefix `httpPrefixHeaders` + httpHeader-over-prefix precedence + not implemented.** +- **G20 — `httpQueryParams` targeting `map>` not + implemented.** +- **G21 — null/empty-value + empty-container handling not implemented.** +- **G22 — `xmlNamespace` on list/map + members + service-level default not + implemented.** +- **G23 — `endpoint`/`hostLabel` host-prefix substitution absent from the + generated `request` (captured in AST by G5 but not in codegen/runtime).** + +### Test gaps (`model_tests/`, `sdkgen/`) +- **G10 — Plain `aws.protocoltests.restxml` namespace not in `gen.ml`.** Add + `"aws.protocoltests.restxml" -> "Restxml"`. +- **G11 — Protocol-test generator assumes JSON bodies** for request-test body + comparison; needs an XML-aware comparison (parse/canonicalize both sides). +- **G12 — Response-test mock now protocol-aware (resolved); request-test mock + still hardcodes `application/json`** — restXml needs its own request-test + mock path (mirroring the query path) so the XML deserializer doesn't choke. + +--- + +## 5. Design: AST & parser changes + +In `smithy_ast/Trait.ml`: + +```ocaml +type httpTrait = { method_ : string; uri : string; code : int option } +[@@deriving show, equal] + +type endpointTrait = { hostPrefix : string } [@@deriving show, equal] + +type xmlNamespaceConfig = { uri : string; prefix : string option } +[@@deriving show, equal] + +type restXmlConfig = { http : string list; eventStreamHttp : string list; + noErrorWrapping : bool } [@@deriving show, equal] + +(* within type t: *) +| HttpTrait of httpTrait +| HttpHeaderTrait of string +| HttpQueryTrait of string +| EndpointTrait of endpointTrait +| AwsProtocolRestXmlTrait of restXmlConfig +| ApiXmlNamespaceTrait of xmlNamespaceConfig (* was `of string` *) +| InternalTrait +| HttpResponseCodeTrait +| IdempotencyTokenTrait +``` +(`http`/`eventStreamHttp` captured for completeness though unused wire-side.) + +In `smaws_parse/Smithy.ml`, update parser cases for `http`, `httpHeader`, +`httpQuery`, `endpoint`, `internal`, `restXml` (carrying `noErrorWrapping`), +`xmlNamespace` (capturing `uri` + optional `prefix`), `httpResponseCode`, +`idempotencyToken`. Use the existing Result-returning helpers (`parseString`, +`parseInteger`, `optional`, `mapOptional`, `>>|`, `let+`/`let*`) — no partial +functions on the happy path. + +**Checkpoint:** `dune build` green (the widened variants are non-exhaustive +across `match`es — grep every consumer: `Service_metadata.ml`, +`SmithyHelpers.ml`, `protocol.ml:of_service`, and any match on +`ApiXmlNamespaceTrait`/`HttpTrait`/`AwsProtocolRestXmlTrait`). + +--- + +## 6. Design: runtime `RestXml` module + +New file `smaws_lib/protocols_impl/RestXml.ml` (+ `.mli`), registered as +`module RestXml = Protocols_impl.RestXml` in `smaws_lib/Protocols.ml`. Model +the `request` on the **merged** `AwsQuery.request` (context-based). + +### 6.1 Types +- Serialize request bodies to a `string` in codegen via `Xml.Write` (the + runtime receives the final body string + content type). Deserialize responses + by handing an `Xmlm.input` (from `Xml.Parse`) to a generated + `output_deserializer : Xmlm.input -> Http.headers -> 'res` (headers passed so + `httpHeader`/`httpPrefixHeaders`/`httpResponseCode` members can be read). +- `RestXml.Error` = `{ errorType : Sender | Receiver; code : string }` — kept + **separate** from `smaws_lib/AwsErrors.ml` (which is the JSON namespaced + model, Q4 resolved). + +### 6.2 `request` signature (proposed, context-based — matches `AwsQuery.request`) +```ocaml +val request : + shape_name:string -> service:Service.descriptor -> context:'a Context.t -> + binding:http_binding -> (* method_, uri_template, success_code from @http *) + uri:Uri.t -> (* fully resolved by codegen (labels substituted, greedy-aware) *) + query:(string * string list) list -> (* pre-resolved by codegen; runtime encodes *) + headers:(string * string) list -> (* pre-resolved httpHeader/httpPrefixHeaders *) + body:(string * string) option -> (* (content_type, body_string); None for no body *) + output_deserializer:(Xmlm.input -> Http.headers -> 'res) -> + error_deserializer:(RestXml.Error.t -> Xmlm.input -> Http.headers -> 'error) -> + ('res, 'error) result +``` +Path-template substitution + percent-encoding lives in **codegen** (Q1 +resolved): the generator emits literal per-operation substitution code (it has +the `@httpLabel` member names and the greedy flag), calling a small runtime +helper for percent-encoding only. The runtime applies signing, sending, +status dispatch, and the error-envelope parse. + +### 6.3 Error envelope parse (runtime) +Reuse `Xml.Parse.Read.sequence`. Default envelope `ErrorResponse > { Error, +RequestId }`; `noErrorWrapping` collapses to `` root with members + +`RequestId` directly. The runtime: +1. detects the envelope shape, extracts `Type` (Sender/Receiver) and `Code`, +2. builds `RestXml.Error.t`, +3. **skips trailing sibling elements** (`RequestId`, etc.) before the outer + `Read.sequence` endTag — this is the exact AwsQuery-class bug (a hardcoded + `ResponseMetadata` read in `AwsQuery` does not generalize here); use an + explicit skip-siblings step so the endTag doesn't see `El_start` and raise + `XmlUnexpectedConstruct`, +4. repositions the `Xmlm.input` cursor at the error members and calls + `error_deserializer error input headers`. +5. wraps the success and error parse paths in `try/with Failure msg -> Error + (...)` so bad timestamps/numbers surface as `Error`, not uncaught + exceptions (AwsQuery-class fix). +The `code` string is matched by the generated `error_deserializer` against the +operation's error shape names (§7.3); unknown codes go to a default handler. + +### 6.4 Request-id recovery (follow-up, added 2026-07-18) + +Real AWS restXml responses carry the request id in **two** places: a response +header (`x-amzn-requestid` for most services; `x-amz-request-id` / +historically `x-amz-requestid` for S3) **and** the body (`` sibling +of `` in the wrapped envelope, or a direct child of root `` with +`noErrorWrapping`). Success (2xx) responses have **no** body `` — +there the id lives only in the header. + +The Phase 3 runtime parses the body `` (to drive skip-siblings) but +`request` discarded it, and never read response headers at all. This small +follow-up surfaces the id by mirroring `AwsQuery`: + +- Reuse the shared `Smaws_Lib.Response` module (`type metadata = { + request_id : string option }`, `'a t = { response; metadata }`, `map`). +- Add `request_id_of_headers : Http.headers -> string option` — + case-insensitive lookup over `["x-amzn-requestid"; "x-amz-request-id"; + "x-amz-requestid"]`, first non-empty value wins. +- Add `request_id_prefer_header ~header ~body` — header wins, fall back to the + body `` (parsed by `parse_error_envelope` / + `parse_error_envelope_nowrapping`). +- Add `request_with_metadata` returning `('out Response.t, 'err * + Response.metadata) result` (Ok = `{ response; metadata }` record, Error = + `('err * metadata)` tuple — exactly `AwsQuery.request_with_metadata`'s shape). + Success metadata = `{ request_id = header }`; error metadata = + `{ request_id = request_id_prefer_header ~header ~body }`. +- `request` keeps its existing `('out, 'err) result` signature (the Phase 4 + generated stubs call it) and becomes a metadata-stripping wrapper over + `request_with_metadata` (`Result.map (fun { Response.response; _ } -> + response) |> Result.map_error (fun (e, _) -> e)`). No codegen change needed; + Phase 7 may switch the generated `request` to call `request_with_metadata` to + surface the id to callers. +- Pure helpers (`request_id_of_headers`, `request_id_prefer_header`) are + unit-tested in `smaws_lib_test/restxml_response_test.ml`; body recovery stays + covered by the existing `parse_error_envelope` test. `request_with_metadata` + itself needs an HTTP context and is not runtime-mocked (same stance as + `AwsQuery.request_with_metadata`). + +--- + +## 7. Design: codegen `RestXml` module (`codegen/AwsProtocolRestXml.ml`) + +Mirror `codegen/AwsProtocolQuery.ml` with `Serialiser`/`Deserialiser`/ +`Operations`. + +### 7.1 `Serialiser` (input → XML string) +For each shape kind, generate `_to_xml : -> string` using +`Xml.Write`. Per member/shape: +- name = `xmlName` trait value if present, else member name (with the + root-only and flattened-list/map rules from §2.4). +- `xmlAttribute` → attribute on the container element. +- `xmlNamespace` (on shape, member, list/map, or service) → `xmlns`/`xmlns:prefix`. + Propagate the service-level default namespace to root elements. +- `xmlFlattened` on a list/set/map member → unwrap the wrapping element. +- timestamp format = binding-location default (§2.4) overridden by + `timestampFormat` on the member or shape. +- float/double: `NaN`/`Infinity`/`-Infinity` sentinel strings (incl. labels). +- `internal` members: omit when equal to default. +- empty containers: empty elements, not omitted (§2.4); null values omitted, + empty strings preserved. +- enum/intEnum: enum value text (incl. enum-as-`httpPayload` → `text/plain`, + raw value). + +Top-level input handling: +- `@httpPayload` member alone is the body, serialized per its target: + - structure/union → the structure's **own root element** is the body (name = + target shape name / structure `@xmlName` / member `@xmlName`), members + nested inside (Q3/G14 resolved); **not** bare members. + - string → text; `text/plain`. + - blob → **raw** bytes (not base64); `application/octet-stream` (G13). + - enum → raw value; `text/plain`. + - mediaType → raw with that content type. +- Otherwise: a structure element named after the input shape (or `xmlName`), + unless the operation has no body (e.g. GET with all params in query/headers). + +### 7.2 `Deserialiser` (response → typed value) +`_of_xml : Xmlm.input -> Http.headers -> 'res`, built on `Xml.Parse`. +Mirror `AwsProtocolQuery.Deserialiser` but consume XML and read headers. +- `httpHeader`/`httpPrefixHeaders` members (incl. empty prefix and + httpHeader-over-prefix precedence) deserialized from headers. +- `httpResponseCode` member ← HTTP status code (G6c/G13). +- `httpPayload` response member consumes the whole body. +- Numeric/timestamp parsing: **no partial functions on the happy path** — use + explicit `match` over `Result`/`Option` (not `Result.get_ok`/`Option.get`); + wrap `Scanf.sscanf` for `http-date` in `try/with`; use `%.6f`-style fixed-point + for epoch floats (not `%g`, which emits scientific notation) — these are the + AwsQuery review fixes to reproduce correctly. + +### 7.3 `Operations` (the generated `request`) +Per operation, emit: +```ocaml +let request context input = + let uri = in + let query = <@httpQuery members> merged with <@httpQueryParams map(s)> + with @httpQuery precedence (drop conflicting map keys), + supporting map> in + let headers = <@httpHeader members> merged with <@httpPrefixHeaders map> + with @httpHeader precedence (and empty-prefix match) in + let host = <@endpoint hostPrefix substituted with @hostLabel members> in + let input = in + let body, content_type = + match <@httpPayload member> with + | Some m -> (Some (_to_xml ...), ) + | None when -> (Some (_to_xml input), "application/xml") + | None -> (None, "application/xml") + in + Smaws_Lib.Protocols.RestXml.request ~shape_name:... ~service ~context + ~binding:{ method_; uri_template; success_code } ~uri ~query ~headers + ~body:(Option.map (fun b -> (content_type, b)) body) + ~output_deserializer:_of_xml + ~error_deserializer +``` +The generated `error_deserializer` matches the runtime-parsed `Error.code` +(string, via `String.equal` — not polymorphic `=`) against the operation's +error shape names, delegating to each `_of_xml` and reading +header-bound error members from headers. + +### 7.4 Dispatch wiring +- `sdkgen/protocol.ml`: add `RestXml` to `type t`; `of_service` maps + `AwsProtocolRestXmlTrait _` → `RestXml` (no more `failwith`). +- `gen_operations.ml`/`gen_serialisers.ml`/`gen_deserialisers.ml`: add a + `Protocol.RestXml` branch calling `Codegen.AwsProtocolRestXml.*`. +- `codegen/Modules.ml`: add `protocolRestXml`, `xml`, `xmlWrite`, `xmlParse`. +- `codegen/Service_metadata.ml`: update `AwsProtocolRestXmlTrait _` case (G1). + +--- + +## 8. Conformance test plan + +The vendored model has two restXml namespaces with `httpRequestTest`/ +`httpResponseTest` cases covering: query params (literal + variable + map + +precedence + list-valued map), headers, prefix headers (incl. empty prefix), +`httpPayload` (string/blob-raw/structure-with-root-element/enum), `xmlName`, +`xmlNamespace` (incl. `prefix`, service-level, on list/map/members), +`xmlAttribute`, `xmlFlattened`, timestamps (per-binding), non-numeric floats +(incl. labels), wrapped-error envelopes, `httpResponseCode`, `idempotencyToken` +auto-fill, `endpoint`/`hostLabel`, and greedy labels. + +Steps: +1. Add `"aws.protocoltests.restxml" -> "Restxml"` to `model_tests/gen.ml` (G10). +2. Make `gen_protocol_tests.ml` protocol-aware for restXml: + - add a restXml request-test path (mirroring the query path) with a mock + that doesn't hardcode `application/json` (G11/G12 remaining); + - body comparison: parse both expected and actual with `Xml` and compare a + canonical XML tree (G11) — add an `Alcotest.testable` for XML or compare + canonicalized strings; + - add the two requestCompression IDs (`SDKAppliedContentEncoding_restXml`, + `SDKAppendedGzipAfterProvidedEncoding_restXml`) to `bannedTests` (§1). +3. Correct the original plan's false claim: the two targeted namespaces use + the **wrapped** envelope (`restXml = {}`); `noErrorWrapping` is exercised + only by `com.amazonaws.s3#AmazonS3` and belongs to the Phase 9 S3 goal. +4. Generate the two test services and run `dune runtest model_tests`. Exit + criterion: green for both namespaces modulo the two banned + requestCompression tests. + +--- + +## 9. Phased implementation plan (with checkpoints) + +Each phase ends with `dune build` (and `dune fmt`). Do **not** start the next +phase until the developer reviews — per `AGENTS.md` "Stop after each phase". + +### Phase 0 — AST & parser (G1, G2, G3, G4, G5, G6, G6b, G6c, G6d) +- Widen `Trait.ml`: `HttpTrait of httpTrait`, `HttpHeaderTrait of string`, + `HttpQueryTrait of string`, `EndpointTrait of endpointTrait`, + `AwsProtocolRestXmlTrait of restXmlConfig`, + `ApiXmlNamespaceTrait of xmlNamespaceConfig` (uri + prefix), add + `InternalTrait`, `HttpResponseCodeTrait`, `IdempotencyTokenTrait`. +- Update `Smithy.ml` parser for all the above. +- Update all consumers (`Service_metadata.ml`, `SmithyHelpers.ml`, + `protocol.ml:of_service`, grep for `ApiXmlNamespaceTrait`/`HttpTrait`/…). +- **Checkpoint:** `dune build` green; existing AwsJson/AwsQuery tests pass. + +### Phase 1 — XML printer (G7) +- Add `Xml.Write` (+ `.mli`) to `smaws_lib/Xml.ml` on `Xmlm.make_output`: + element/attribute/text/namespaced (with prefix) elements, pretty/minimal. +- Round-trip unit test vs `Xml.Parse` (cover `xmlns:prefix`). +- **Checkpoint:** `dune build` + `dune runtest smaws_lib_test`. + +### Phase 2 — HTTP binding helpers (G8) +- Runtime helpers: percent-encode path segment (greedy keeps `/`) and query + param, `{label}` substitution, query-list merge with `httpQuery` precedence, + host-prefix substitution. +- Unit tests (incl. greedy-slash, precedence, list-valued query maps). +- **Checkpoint:** `dune build` + tests. + +### Phase 3 — Runtime `RestXml` module (G9) +- `smaws_lib/protocols_impl/RestXml.ml` (+ `.mli`); register in `Protocols.ml`. +- Context-based `request` (mirror merged `AwsQuery.request`); status dispatch; + error envelope (default + `noErrorWrapping`, with **skip-siblings** and + **`Failure` catch**); signing; separate `RestXml.Error` (not in `AwsErrors`). +- Mock smoke test: one success + one error path. **The error mock MUST include + a trailing `` sibling of ``** to exercise skip-siblings. +- **Follow-up (§6.4):** request-id recovery — `request_id_of_headers` + (case-insensitive `x-amzn-requestid`/`x-amz-request-id`/`x-amz-requestid`), + `request_id_prefer_header` (header over body), `request_with_metadata` + returning `('out Response.t, 'err * Response.metadata) result`; `request` + keeps its signature and strips metadata. Unit-test the pure helpers. +- **Checkpoint:** `dune build` + `dune runtest`. + +### Phase 4 — Codegen dispatch (GC2) +- Add `RestXml` to `Protocol.t`; `of_service` mapping; branches in + `gen_operations`/`gen_serialisers`/`gen_deserialisers`. `Modules.ml` literals. +- **Checkpoint:** `dune build`; restXml services generate *something* (stub + generators that fail clearly are acceptable; real generators land in 5–7). + +### Phase 5 — Codegen `RestXml.Serialiser` (§7.1, G13–G15, G16, G21, G22) +- `_to_xml` for all kinds with `xmlName`/`xmlAttribute`/`xmlFlattened`/ + `xmlNamespace` (prefix + service-level + on list/map/members)/per-binding + `timestampFormat`/NaN-Float/enum/raw-payload-blob/structure-root/empty+null + handling. +- **Checkpoint (strengthened):** `dune build` + a round-trip/parse-back test + (serialize then `Xml.Parse` and compare) so `%.6f`-vs-`%g`, NaN/Infinity, and + empty-container behavior are caught here, not in Phase 8. + +### Phase 6 — Codegen `RestXml.Deserialiser` (§7.2, G6c, G19) +- `_of_xml` (consumes `Xmlm.input` + headers); `httpHeader`/ + `httpPrefixHeaders` (empty prefix + precedence)/`httpResponseCode`/ + `httpPayload` response members. No partial functions on the happy path. +- **Checkpoint (strengthened):** `dune build` + a parse unit test covering + `http-date` (guarded `Scanf`), epoch float, and `Result`-explicit matching. + +### Phase 7 — Codegen `RestXml.Operations` (§7.3, G17, G18, G20, G23, G6d) +- Per-operation `request` with HTTP binding assembly (greedy labels, + `httpQuery`/`httpQueryParams` precedence, list-valued query maps, + `httpHeader`/`httpPrefixHeaders` precedence, `endpoint`/`hostLabel` + host-prefix), `idempotencyToken` auto-fill, and `Code` error dispatch. +- **Checkpoint:** `dune build`; a generated restXml SDK compiles end-to-end. + +### Phase 8 — Conformance tests (G10, G11, G12, §8) +- Wire `restxml` namespace; restXml request-test path; XML testable; mock + content-type from the record; add the two requestCompression IDs to + `bannedTests`. +- **Checkpoint:** `dune runtest model_tests` green for both namespaces modulo + the two banned tests. Iterate on failures (normative reference). + +### Phase 9 — Polish +- `dune fmt`; verify an S3 / CloudFront SDK generates and compiles (per + "Adding a new SDK") — **this is where `noErrorWrapping` gets exercised** + (S3 `AmazonS3`). +- Remove any temporary stubs. + +--- + +## 10. Open questions / decisions (resolved 2026-07-15) + +- **Q1 — Path-template substitution location:** **codegen** (decided). The + generator emits per-operation substitution code; the runtime only + percent-encodes. Affects the `request` signature (§6.2 takes a fully + resolved `uri`). +- **Q2 — Output filenames:** **`xml_serializers.ml`/`xml_deserializers.ml`** + (decided), following the AwsQuery precedent (`query_serializers.ml`/ + `query_deserializers.ml`). Update `sdkgen` writers and `sdks/` dune template. +- **Q3 — `httpPayload` on a structure:** **resolved** — the structure's own + root element IS the body (name = shape name / structure `@xmlName` / member + `@xmlName`), members nested inside. Not open. +- **Q4 — Shared `Error.t`:** **keep separate** (decided) — `smaws_lib/AwsErrors.ml` + holds the JSON namespaced model; the XML envelope `RestXml.Error` is a + distinct type. Do not fold them together. +- **Q5 — ALPN `http`/`eventStreamHttp`:** **skip** (decided) — informational + only; captured in `restXmlConfig` for completeness but unused. +- **Q6 — New dependencies:** **none** (confirmed) — xmlm, uri, base64 present. + +--- + +## 11. Files touched (summary) + +- `smithy_ast/Trait.ml` — widen variants, add `InternalTrait`/ + `HttpResponseCodeTrait`/`IdempotencyTokenTrait`, config records, + `xmlNamespaceConfig` (prefix). +- `smaws_parse/Smithy.ml` — parser cases for G1–G6, G6b–G6d. +- `smaws_lib/Xml.ml` (+ `.mli`) — add `Write` (G7). +- `smaws_lib/http/` or new `smaws_lib/Http_bindings.ml` — binding helpers (G8). +- `smaws_lib/protocols_impl/RestXml.ml` (+ `.mli`) — new (G9), separate + `Error`. +- `smaws_lib/Protocols.ml` — register `RestXml`. +- `sdkgen/protocol.ml` — add `RestXml` to `Protocol.t`, `of_service` mapping. +- `codegen/AwsProtocolRestXml.ml` — new (GC1), mirror `AwsProtocolQuery.ml`. +- `codegen/Modules.ml`, `codegen/Service_metadata.ml` — literals + protocol + case. +- `sdkgen/gen_operations.ml`, `gen_serialisers.ml`, `gen_deserialisers.ml` — + `RestXml` branch (GC2/GC3). +- `model_tests/gen.ml` — add `restxml` namespace (G10). +- `sdkgen/gen_protocol_tests.ml` — restXml request-test path, XML testable, + banned requestCompression IDs (G11/G12, §1). +- `sdks//dune` — generated via `service-dune-generate.sh`; xml filenames + (Q2). \ No newline at end of file diff --git a/refactorings/restxml-protocol.todo.md b/refactorings/restxml-protocol.todo.md new file mode 100644 index 00000000..85982eb8 --- /dev/null +++ b/refactorings/restxml-protocol.todo.md @@ -0,0 +1,194 @@ +# restXml protocol — implementation todo + +Tracking file for the work described in `restxml-protocol.md`. +**No restXml-specific implementation has started.** The +`claude/awsquery-protocol-support-umievv` (post-fix AwsQuery) branch has been +merged into `restxml`, providing reusable infra (context-based `AwsQuery.request`, +`Protocol.t` dispatch, `AwsProtocolQuery.ml` codegen template, `bannedTests`, +protocol-aware response-test codegen). Check off phases as they are reviewed and +landed. Run `dune build` + `dune fmt` at each checkpoint; `dune runtest` where +noted. Stop and wait for developer review between phases (per AGENTS.md). + +## Decisions (resolved 2026-07-15) +- [x] D1 requestCompression tests — **ban** the 2 restXml IDs (out of scope; + unbanned when `add_request_compression.md` lands). +- [x] D2 scope — **full conformance** for both namespaces (fold all spec-audit + gaps into the phased plan). + +## Phase 0 — AST & parser (G1–G6, G6b–G6d) — LANDED (commit f4fa179) +- [x] Widen `Trait.ml`: `HttpTrait of httpTrait`, `HttpHeaderTrait of string`, + `HttpQueryTrait of string`, `EndpointTrait of endpointTrait`, + `AwsProtocolRestXmlTrait of restXmlConfig`, + `ApiXmlNamespaceTrait of xmlNamespaceConfig` (uri + **prefix**), + add `InternalTrait`, `HttpResponseCodeTrait`, `IdempotencyTokenTrait`. +- [x] Update `Smithy.ml` parser for `http`/`httpHeader`/`httpQuery`/`endpoint`/ + `internal`/`restXml`/`xmlNamespace`(+prefix)/`httpResponseCode`/ + `idempotencyToken`. +- [x] Update all consumers (`Service_metadata.ml`, `SmithyHelpers.ml`, + `protocol.ml:of_service`, grep `ApiXmlNamespaceTrait`/`HttpTrait`/...). +- [x] `dune build` green; `dune runtest` (AwsJson/AwsQuery regressions). + +## Phase 1 — XML printer (G7) +- [x] Add `Xml.Write` (+ `.mli`, on `Xmlm.make_output`) to `smaws_lib/Xml.ml`; + support `xmlns:prefix`. +- [x] Round-trip unit test vs `Xml.Parse` (cover `xmlns:prefix`). +- [x] `dune build` + `dune runtest smaws_lib_test`. + +## Phase 2 — HTTP binding helpers (G8) +- [x] Percent-encode (path segment — greedy keeps `/`; query param), + `{label}` substitution, query-list merge with `httpQuery` precedence, + host-prefix substitution. +- [x] Unit tests (greedy-slash, precedence, list-valued query maps). +- [x] `dune build`. + +## Phase 3 — Runtime `RestXml` module (G9) +- [x] `smaws_lib/protocols_impl/RestXml.ml` (+ `.mli`) + register in + `Protocols.ml`. +- [x] Context-based `request` (mirror merged `AwsQuery.request`); status + dispatch; error envelope (default + `noErrorWrapping`) with + **skip-siblings** and **`Failure` catch**; signing. +- [x] Separate `RestXml.Error` (NOT folded into `AwsErrors`). +- [x] Mock smoke test (success + error); error mock MUST include a trailing + `` sibling of ``. `dune build` + `dune runtest`. +- [x] Follow-up (§6.4): request-id recovery — `request_id_of_headers` + (case-insensitive `x-amzn-requestid`/`x-amz-request-id`/ + `x-amz-requestid`), `request_id_prefer_header` (header over body), + `request_with_metadata` returning `('out Response.t, 'err * + Response.metadata) result`; `request` keeps its signature and strips + metadata. Unit-test the pure helpers. + +## Phase 4 — Codegen dispatch (GC2) +- [x] Add `RestXml` to `Protocol.t`; `of_service` mapping (no `failwith`). +- [x] Branch `gen_operations`/`gen_serialisers`/`gen_deserialisers`. +- [x] `codegen/Modules.ml` literals (`protocolRestXml`, `xml`, `xmlWrite`, + `xmlParse`). +- [x] `dune build`. + +## Phase 5 — Codegen `RestXml.Serialiser` (§7.1; G13–G16, G21, G22) — LANDED +- [x] `_to_xml` for all kinds with `xmlName`/`xmlAttribute`/ + `xmlFlattened`/`xmlNamespace` (prefix + on list/map/members)/per-binding + `timestampFormat`/NaN-Float/**enum**/empty+null handling — landed: + - **Mixin flattening (unplanned prerequisite):** `structureShapeDetails` + gained `mixins`, `parseStructureShape`/`parseUnionShape` parse it, + `Smithy.resolve_mixins` flattens mixin members + traits (own wins, the + `@mixin` marker dropped) at parse time. The restXml conformance model + uses `@mixin` for every *Request/*Response pair; without flattening + every request body serializer was a no-op. `Trait.type_key` added for + constructor-level mixin-trait dedup. + - **member wrapping fix:** all complex members (structure/union/non- + flattened list/map/set) are now wrapped in their `` element + (the previous catch-all emitted bare content with no member element, + and the flattened branches double-wrapped). + - **`xmlNamespace` (prefix + on list/map/member):** `member_value_expr` + emits `xmlns`/`xmlns:prefix` on the wrapping element from the member's + own `@xmlNamespace` or, falling back, the target shape's `@xmlNamespace` + (list/map shape namespace on its wrapping element). `Xml.Write.element` + /`element_with_ns` now emit namespaced elements as literal names + + `xmlns` attrs (no xmlm namespace tracking) so the generated + `Write.make ()` (no `ns_prefix`) works; the `xml_roundtrip_test` + `xmlns:prefix` case still passes. + - **`xmlAttribute`:** `generate_member_expr` skips attribute members as + child elements; `member_value_expr` collects the target + structure/union's attribute members into a runtime `attrs` list on the + wrapping element (option attrs omitted when `None`). Attribute names + embed any prefix via the member's `@xmlName` (e.g. `xsi:someName`). + - **NaN/Infinity floats:** `RestXml.Serialize.float_field_to_string` + emits `NaN`/`Infinity`/`-Infinity` sentinels (mirrors + `AwsQuery.Serialize.float_field`); `float_to_string` is the + round-trip-safe `%.6g`-then-`%.17g` form (no `%g` truncation). + - **enum/intEnum:** already handled by `enum_func_body` (`\`String`→value, + `\`Int`→`string_of_int`). + - **flattened list/map:** fixed to emit repeated `` siblings + (no container wrapper); flattened-map key/value `@xmlName` retained. + - **empty containers:** render as empty elements (`List.iter` over `[]` + writes nothing inside the wrapping element). Null `option` members + are omitted (the `None` branch is a no-op); empty strings preserved. +- [x] `dune build` + **round-trip/parse-back test** + (`smaws_lib_test/restxml_serialize_test.ml`) — covers `%.6g`-vs-round + double precision, `NaN`/`Infinity`/`-Infinity` sentinel strings, + namespaced + prefixed-namespace + attributed + empty-container element + emission and round-trip through `Xml.Parse`. +- [ ] **Deferred to Phase 7 (not blocking Phase 5):** body-root wrapping + + service-level `@xmlNamespace`; `@httpPayload` body construction (raw + blob / raw string / raw enum / structure-with-root-element / `mediaType` + content-type); top-level `@xmlAttribute` (body-root element's attrs). + +## Phase 6 — Codegen `RestXml.Deserialiser` (§7.2; G6c, G19) — LANDED +- [x] No partial functions on the happy path: the leaf parsers in + `Xml.Parse.Primitive` (`int_of_string`/`float_of_string`/ + `bool_of_string`/`*_of_string`) raise `XmlDeserializeError` (not bare + `Failure`), which `Xml.Parse.run` folds into `Error (XmlParseError _)`; + `Read.element_value`/`elements_value` decorate a parse failure with the + enclosing element's tag as the exception unwinds (the `path` field), so + the generated deserialiser may call these directly with no surrounding + try/with. `required` raises `XmlMissingElement` (caught by `run`). The + `enum_func_body`/`union_func_body` `failwith` and `List.find_map_exn` are + unhappy-path / codegen-time only (enum members are known at codegen). +- [x] **Runtime response-header readers** for `@httpHeader`/`@httpPrefixHeaders` + members landed in `smaws_lib/protocols_impl/RestXml.ml`: `header_value` + (case-insensitive single-header lookup) and `prefix_headers ~prefix` + (collect headers by case-insensitive prefix; empty prefix → every header + keyed by its full name, non-empty prefix → suffix as the key, original + casing preserved). G19's `@httpHeader`-over-`@httpPrefixHeaders` + precedence is a **serialise-side** rule (verified against the smithy + fixtures: `HttpEmptyPrefixHeadersResponseClient` deserialises headers + `{hello:There}` into BOTH `specificHeader=There` AND `prefixHeaders.hello= + There`; `HttpEmptyPrefixHeadersResponseServer` serialises + `specificHeader=There` overriding `prefixHeaders.hello=Hello` to the single + header `hello:There`), so these readers do NOT exclude specifically-bound + names — the generated deserialiser reads each binding independently. +- [x] `dune build` + **parse unit test** (`smaws_lib_test/restxml_deserialize_test.ml`) + — covers `timestamp_httpdate_of_string` (guarded `Scanf` success + failure + → `Error`), `timestamp_epoch_of_string` (integer + fractional epoch float), + the primitive parsers (int/bool success + failure via `run`), `Read. + element_value` path decoration, and the response-header readers (case + insensitivity, empty + non-empty prefix, suffix-as-key). All assertions use + explicit `Result` matching (no `Result.get_ok`). +- [ ] **Deferred to Phase 7 (coupled with the Operations output wrapper):** + the codegen WIRING of these readers into the generated output/error + deserialisers. Per Smithy, `@httpHeader`/`@httpPrefixHeaders`/ + `@httpResponseCode`/`@httpPayload` members only appear on operation + input/output/error shapes, and the top-level output deserialiser must + consume the response body's root element (named after the output shape / + its `@xmlName` / the service-level `@xmlNamespace`) — which the per-shape + `_of_xml` (positioned inside its wrapper by the parent's + `Read.sequence`) cannot do for the body-root case. `@httpPayload`-response + with a string/blob/enum target must read the raw body (not XML). The + natural home for the root-consuming + http-overlay + payload-raw wrapper + is the Phase 7 Operations generator (`generate_request_handler`'s + `output_deserializer` lambda), which knows the output shape name and + http-bound member set; it will call the Phase 6 `header_value`/ + `prefix_headers` readers and the existing per-shape `_of_xml` for + body members. The runtime `output_deserializer`/`error_deserializer` + signatures will gain `~headers`/`~status`/`~body` (or a `response_input` + record) at that point. Phase 6's checkpoint (build + parse unit test) is + met without this wiring. + +## Phase 7 — Codegen `RestXml.Operations` (§7.3; G17, G18, G20, G23, G6d) +- [ ] Per-operation `request` with greedy labels, `httpQuery`/`httpQueryParams` + precedence (+ list-valued maps), `httpHeader`/`httpPrefixHeaders` + precedence, `endpoint`/`hostLabel` host-prefix, `idempotencyToken` + auto-fill, `Code` error dispatch (`String.equal`). +- [ ] `dune build`; a generated restXml SDK compiles end-to-end. + +## Phase 8 — Conformance tests (§8; G10–G12) +- [ ] Add `aws.protocoltests.restxml -> Restxml` to `model_tests/gen.ml`. +- [ ] restXml request-test path (own mock; no hardcoded `application/json`). +- [ ] Protocol-aware body comparison (XML testable) in `gen_protocol_tests.ml`. +- [ ] Add `SDKAppliedContentEncoding_restXml` + + `SDKAppendedGzipAfterProvidedEncoding_restXml` to `bannedTests`. +- [ ] `dune runtest model_tests` green for both namespaces modulo the 2 banned + tests. + +## Phase 9 — Polish +- [ ] `dune fmt`. +- [ ] Generate + compile an S3 / CloudFront SDK (exercises `noErrorWrapping`). +- [ ] Remove temporary stubs. + +## Open decisions (resolved 2026-07-15 — see plan §10) +- [x] Q1 path-template substitution location — **codegen** +- [x] Q2 output filenames — **xml_serializers.ml / xml_deserializers.ml** +- [x] Q3 httpPayload-structure body-root — structure's own root element IS body +- [x] Q4 shared Error.t — **keep separate** from `AwsErrors` +- [x] Q5 ALPN http/eventStreamHttp — **skip** +- [x] Q6 new dependencies — **none** \ No newline at end of file diff --git a/sdkgen/SmithyHelpers.ml b/sdkgen/SmithyHelpers.ml index 791521f1..3f2ee589 100644 --- a/sdkgen/SmithyHelpers.ml +++ b/sdkgen/SmithyHelpers.ml @@ -4,7 +4,7 @@ open Smithy_ast (** The wire protocols the code generator knows how to emit code for. restJson1, restXml and ec2Query are recognised traits but generation for them is not implemented yet, so [protocol_of_traits] fails loudly on them rather than silently falling back to JSON. *) -type protocol = Query | Json +type protocol = Query | Json | RestXml let protocol_of_traits (traits : Trait.t list option) : protocol = traits |> Option.value ~default:[] @@ -13,8 +13,7 @@ let protocol_of_traits (traits : Trait.t list option) : protocol = | Trait.AwsProtocolAwsJson1_0Trait | Trait.AwsProtocolAwsJson1_1Trait -> Some Json | Trait.AwsProtocolRestJson1Trait -> failwith "code generation for the restJson1 protocol is not yet supported" - | Trait.AwsProtocolRestXmlTrait -> - failwith "code generation for the restXml protocol is not yet supported" + | Trait.AwsProtocolRestXmlTrait _ -> Some RestXml | Trait.AwsProtocolEc2QueryTrait -> failwith "code generation for the ec2Query protocol is not yet supported" | _ -> None) @@ -26,7 +25,7 @@ let printProtocol (traits : Trait.t list option) = | Trait.AwsProtocolAwsJson1_0Trait -> Some "AWS JSON 1.0" | Trait.AwsProtocolAwsJson1_1Trait -> Some "AWS JSON 1.1" | Trait.AwsProtocolRestJson1Trait -> Some "AWS REST JSON 1" - | Trait.AwsProtocolRestXmlTrait -> Some "AWS REST XML" + | Trait.AwsProtocolRestXmlTrait _ -> Some "AWS REST XML" | Trait.AwsProtocolAwsQueryTrait -> Some "AWS Query" | Trait.AwsProtocolEc2QueryTrait -> Some "EC2 Query" | _ -> None) diff --git a/sdkgen/gen_deserialisers.ml b/sdkgen/gen_deserialisers.ml index f3b66495..2996c47b 100644 --- a/sdkgen/gen_deserialisers.ml +++ b/sdkgen/gen_deserialisers.ml @@ -49,3 +49,32 @@ let generate ?protocol_override ~(service : Shape.serviceShapeDetails) ~operatio with _ as a -> Fmt.pf Fmt.stderr "Unable to generate deserialisers: %s" (Printexc.to_string a); raise (Generate_failure ("", a))) + | RestXml -> ( + let opens = + [ + Codegen.Ppx_util.stri_open [ "Smaws_Lib"; "Xml"; "Parse" ]; + Codegen.Ppx_util.stri_open [ "Types" ]; + ] + in + let unit_of_xml_stri = + let module B = Ppxlib.Ast_builder.Make (struct + let loc = Location.none + end) in + B.pstr_value Nonrecursive + [ + B.value_binding + ~pat:(B.ppat_var (Location.mknoloc "unit_of_xml")) + ~expr: + (B.pexp_fun Nolabel None B.ppat_any + (B.pexp_construct (Location.mknoloc (Ppxlib.Longident.Lident "()")) None)); + ] + in + try + let deserialisers = + Codegen.AwsProtocolRestXml.Deserialiser.generate ~structure_shapes ~namespace_resolver + ~shape_resolver () + in + Ppxlib.Pprintast.structure oc (opens @ [ unit_of_xml_stri ] @ deserialisers) + with _ as a -> + Fmt.pf Fmt.stderr "Unable to generate deserialisers: %s" (Printexc.to_string a); + raise (Generate_failure ("", a))) diff --git a/sdkgen/gen_module.ml b/sdkgen/gen_module.ml index 071e17a5..3d0cc3ae 100644 --- a/sdkgen/gen_module.ml +++ b/sdkgen/gen_module.ml @@ -10,14 +10,27 @@ let generate ~service_details ~(protocol : SmithyHelpers.protocol) output_fmt = Fmt.pf output_fmt "module Query_serializers = Query_serializers\n"; Fmt.pf output_fmt "module Query_deserializers = Query_deserializers\n" | Json -> - (* Non-service namespaces (e.g. shared) always get query_serializers/deserializers.ml generated *) + (* Non-service namespaces (e.g. shared) always get all serializers/deserializers *) (match service_details with | None -> Fmt.pf output_fmt "module Query_serializers = Query_serializers\n"; - Fmt.pf output_fmt "module Query_deserializers = Query_deserializers\n" + Fmt.pf output_fmt "module Query_deserializers = Query_deserializers\n"; + Fmt.pf output_fmt "module Xml_serializers = Xml_serializers\n"; + Fmt.pf output_fmt "module Xml_deserializers = Xml_deserializers\n" | Some _ -> ()); Fmt.pf output_fmt "module Json_serializers = Json_serializers\n"; Fmt.pf output_fmt "module Json_deserializers = Json_deserializers\n" + | RestXml -> + (* Non-service namespaces (e.g. shared) always get all serializers/deserializers *) + (match service_details with + | None -> + Fmt.pf output_fmt "module Query_serializers = Query_serializers\n"; + Fmt.pf output_fmt "module Query_deserializers = Query_deserializers\n"; + Fmt.pf output_fmt "module Json_serializers = Json_serializers\n"; + Fmt.pf output_fmt "module Json_deserializers = Json_deserializers\n" + | Some _ -> ()); + Fmt.pf output_fmt "module Xml_serializers = Xml_serializers\n"; + Fmt.pf output_fmt "module Xml_deserializers = Xml_deserializers\n" let generate_mli ~(service_details : (string * Ast.Shape.serviceShapeDetails * Ast.Trait.serviceDetails) option) @@ -39,8 +52,11 @@ let generate_mli service_details |> Option.iter ~f:(fun (name, service, _) -> Fmt.pf output_fmt "(** {1:operations Operations} *)@\n@\n"; - Gen_operations.generate_mli ~name ~service ~namespace_resolver ~operation_shapes - ~structure_shapes ~alias_context ~no_open:true output_fmt); + match protocol with + | RestXml -> () + | _ -> + Gen_operations.generate_mli ~name ~service ~namespace_resolver ~operation_shapes + ~structure_shapes ~alias_context ~no_open:true output_fmt); Fmt.pf output_fmt "(** {1:Serialization and Deserialization} *)@\n@\n"; match protocol with | Query -> @@ -50,7 +66,19 @@ let generate_mli (match service_details with | None -> Fmt.pf output_fmt "module Query_serializers = Query_serializers\n"; - Fmt.pf output_fmt "module Query_deserializers = Query_deserializers\n" + Fmt.pf output_fmt "module Query_deserializers = Query_deserializers\n"; + Fmt.pf output_fmt "module Xml_serializers = Xml_serializers\n"; + Fmt.pf output_fmt "module Xml_deserializers = Xml_deserializers\n" | Some _ -> ()); Fmt.pf output_fmt "module Json_serializers = Json_serializers\n"; Fmt.pf output_fmt "module Json_deserializers = Json_deserializers\n" + | RestXml -> + (match service_details with + | None -> + Fmt.pf output_fmt "module Query_serializers = Query_serializers\n"; + Fmt.pf output_fmt "module Query_deserializers = Query_deserializers\n"; + Fmt.pf output_fmt "module Json_serializers = Json_serializers\n"; + Fmt.pf output_fmt "module Json_deserializers = Json_deserializers\n" + | Some _ -> ()); + Fmt.pf output_fmt "module Xml_serializers = Xml_serializers\n"; + Fmt.pf output_fmt "module Xml_deserializers = Xml_deserializers\n" diff --git a/sdkgen/gen_operations.ml b/sdkgen/gen_operations.ml index 3f4a76a7..cf9ceec9 100644 --- a/sdkgen/gen_operations.ml +++ b/sdkgen/gen_operations.ml @@ -41,6 +41,27 @@ let generate ~name ~(service : Shape.serviceShapeDetails) ~operation_shapes ~str with _ as a -> Fmt.pf Fmt.stderr "Unable to generate operations for %s: %s" name (Printexc.to_string a); raise (Generate_failure (name, a))) + else if + Trait.hasTrait service.traits (function Trait.AwsProtocolRestXmlTrait _ -> true | _ -> false) + then ( + let opens = + [ + Codegen.Ppx_util.stri_open [ "Types" ]; + Codegen.Ppx_util.stri_open [ "Service_metadata" ]; + Codegen.Ppx_util.stri_open [ "Xml_deserializers" ]; + Codegen.Ppx_util.stri_open [ "Xml_serializers" ]; + Codegen.Ppx_util.stri_open [ "Smaws_Lib"; "Xml"; "Parse" ]; + ] + in + try + let structure = + Codegen.AwsProtocolRestXml.Operations.generate ~name ~service ~operation_shapes + ~alias_context ~namespace_resolver ~shape_resolver () + in + Ppxlib.Pprintast.structure oc (opens @ structure) + with _ as a -> + Fmt.pf Fmt.stderr "Unable to generate operations for %s: %s" name (Printexc.to_string a); + raise (Generate_failure (name, a))) let generate_mli ~name ~(service : Shape.serviceShapeDetails) ~operation_shapes ~structure_shapes ~alias_context ?(no_open = false) @@ -73,3 +94,18 @@ let generate_mli ~name ~(service : Shape.serviceShapeDetails) ~operation_shapes with _ as a -> Fmt.pf Fmt.stderr "Unable to generate operations for %s: %s" name (Printexc.to_string a); raise (Generate_failure (name, a))) + else if + Trait.hasTrait service.traits (function Trait.AwsProtocolRestXmlTrait _ -> true | _ -> false) + then ( + try + let sign = + Codegen.AwsProtocolRestXml.Operations.generate_mli ~name ~service ~operation_shapes + ~alias_context ~namespace_resolver () + in + let opens = + if no_open || List.is_empty sign then [] else [ Codegen.Ppx_util.sigi_open [ "Types" ] ] + in + Ppxlib.Pprintast.signature oc (opens @ sign) + with _ as a -> + Fmt.pf Fmt.stderr "Unable to generate operations for %s: %s" name (Printexc.to_string a); + raise (Generate_failure (name, a))) diff --git a/sdkgen/gen_serialisers.ml b/sdkgen/gen_serialisers.ml index e8722f75..8a911b11 100644 --- a/sdkgen/gen_serialisers.ml +++ b/sdkgen/gen_serialisers.ml @@ -36,3 +36,19 @@ let generate ?protocol_override ~(service : Shape.serviceShapeDetails) ~operatio with _ as a -> Fmt.pf Fmt.stderr "Unable to generate serialisers: %s" (Printexc.to_string a); raise (Generate_failure ("", a))) + | RestXml -> ( + let opens = + [ + Codegen.Ppx_util.stri_open [ "Smaws_Lib"; "Xml"; "Write" ]; + Codegen.Ppx_util.stri_open [ "Types" ]; + ] + in + try + let serialisers = + Codegen.AwsProtocolRestXml.Serialiser.generate ~structure_shapes ~namespace_resolver + ~shape_resolver () + in + Ppxlib.Pprintast.structure oc (opens @ serialisers) + with _ as a -> + Fmt.pf Fmt.stderr "Unable to generate serialisers: %s" (Printexc.to_string a); + raise (Generate_failure ("", a))) diff --git a/sdkgen/sdkgen.ml b/sdkgen/sdkgen.ml index 0305c393..c0f3f0cc 100644 --- a/sdkgen/sdkgen.ml +++ b/sdkgen/sdkgen.ml @@ -216,10 +216,15 @@ let write_operations ~output_dir t = write_output ~output_dir ~filename:(filename ^ ".ml") (fun output_fmt -> Gen_operations.generate ~name ~service ~operation_shapes ~structure_shapes ~alias_context ~namespace_resolver ~shape_resolver output_fmt) - and r2 = - write_output ~output_dir ~filename:(filename ^ ".mli") (fun output_fmt -> - Gen_operations.generate_mli ~name ~service ~operation_shapes ~structure_shapes - ~alias_context ~namespace_resolver output_fmt) + in + let r2 = + let protocol = SmithyHelpers.protocol_of_traits service.traits in + match protocol with + | RestXml -> Ok () + | _ -> + write_output ~output_dir ~filename:(filename ^ ".mli") (fun output_fmt -> + Gen_operations.generate_mli ~name ~service ~operation_shapes ~structure_shapes + ~alias_context ~namespace_resolver output_fmt) in Result.all_unit [ r1; r2 ] @@ -253,6 +258,7 @@ let write_serialisers ~output_dir t = match SmithyHelpers.protocol_of_traits service.traits with | Query -> "query_serializers" | Json -> "json_serializers" + | RestXml -> "xml_serializers" in write_output ~output_dir ~filename:(filename ^ ".ml") (fun output_fmt -> Gen_serialisers.generate ~service ~operation_shapes ~structure_shapes ~shape_resolver @@ -278,6 +284,26 @@ let write_query_deserialisers ~output_dir t = Gen_deserialisers.generate ~protocol_override:SmithyHelpers.Query ~service:empty_service ~operation_shapes:[] ~structure_shapes ~shape_resolver ~namespace_resolver output_fmt) +let write_xml_serialisers ~output_dir t = + let { namespace; structure_shapes; namespace_module_mapping; shape_resolver; _ } = t in + let namespace_resolver = + Codegen.Namespace_resolver.Namespace_resolver.create ~current_namespace:namespace + ~namespace_module_mapping + in + write_output ~output_dir ~filename:"xml_serializers.ml" (fun output_fmt -> + Gen_serialisers.generate ~protocol_override:SmithyHelpers.RestXml ~service:empty_service + ~operation_shapes:[] ~structure_shapes ~shape_resolver ~namespace_resolver output_fmt) + +let write_xml_deserialisers ~output_dir t = + let { namespace; structure_shapes; namespace_module_mapping; shape_resolver; _ } = t in + let namespace_resolver = + Codegen.Namespace_resolver.Namespace_resolver.create ~current_namespace:namespace + ~namespace_module_mapping + in + write_output ~output_dir ~filename:"xml_deserializers.ml" (fun output_fmt -> + Gen_deserialisers.generate ~protocol_override:SmithyHelpers.RestXml ~service:empty_service + ~operation_shapes:[] ~structure_shapes ~shape_resolver ~namespace_resolver output_fmt) + let write_deserialisers ~output_dir t = let { namespace; @@ -299,6 +325,7 @@ let write_deserialisers ~output_dir t = match SmithyHelpers.protocol_of_traits service.traits with | Query -> "query_deserializers" | Json -> "json_deserializers" + | RestXml -> "xml_deserializers" in write_output ~output_dir ~filename:(filename ^ ".ml") (fun output_fmt -> Gen_deserialisers.generate ~service ~operation_shapes ~structure_shapes ~shape_resolver diff --git a/smaws_lib/Http_bindings.ml b/smaws_lib/Http_bindings.ml new file mode 100644 index 00000000..9ff7a6a0 --- /dev/null +++ b/smaws_lib/Http_bindings.ml @@ -0,0 +1,113 @@ +(* HTTP binding helpers for restXml protocol. + Path-template substitution, percent-encoding, query merge, host-prefix substitution. *) + +(** Percent-encode a path segment value. + Greedy labels ({label+}) must NOT percent-encode '/'. Non-greedy labels + percent-encode per the URI Path component, which encodes '/' as %2F so a + single-segment label cannot inject a path separator. *) +let percent_encode_path_segment ~greedy s = if greedy then s else Uri.pct_encode ~component:`Path s + +(** Percent-encode a query parameter value. *) +let percent_encode_query_value s = Uri.pct_encode ~component:`Query s + +(** Index of the first occurrence of [sub] in [s] at or after [from], or [None] if absent. A plain + stdlib substring search — no [Str] global state, so it is safe to call concurrently with other + code that still uses [Str] (e.g. [Ini]). *) +let index_of_substring ~from ~sub s = + let n = String.length s and m = String.length sub in + if m = 0 then Some (min from n) + else if m > n || from > n - m then None + else ( + let last = n - m in + let rec loop i = + if i > last then None + else ( + let rec check j = + if j >= m then true + else if String.get s (i + j) <> String.get sub j then false + else check (j + 1) + in + if check 0 then Some i else loop (i + 1)) + in + loop from) + +(** Check if [s] contains [sub]. *) +let contains_substring s sub = Option.is_some (index_of_substring ~from:0 ~sub s) + +(** Replace the first occurrence of [pattern] in [s] with [with_], or return [s] unchanged. *) +let replace_first ~pattern ~with_ s = + match index_of_substring ~from:0 ~sub:pattern s with + | None -> s + | Some pos -> + let len = String.length pattern in + String.sub s 0 pos ^ with_ ^ String.sub s (pos + len) (String.length s - pos - len) + +(** Substitute {label} and {label+} placeholders in a URI template. + [labels] is a list of (name, value, is_greedy) tuples. + Returns the resolved URI string. *) +let substitute_labels ~template ~labels = + List.fold_left + (fun uri (name, value, greedy) -> + let placeholder = "{" ^ name ^ "+}" in + if contains_substring uri placeholder then + replace_first ~pattern:placeholder ~with_:(percent_encode_path_segment ~greedy value) uri + else ( + let placeholder = "{" ^ name ^ "}" in + replace_first ~pattern:placeholder + ~with_:(percent_encode_path_segment ~greedy:false value) + uri)) + template labels + +(** Merge query parameters from @httpQuery members with @httpQueryParams map. + @httpQuery takes precedence: if a key appears in both, the @httpQuery value wins + and the conflicting @httpQueryParams entry is dropped. + [named_params] is (name, value) list from @httpQuery members. + [map_params] is (key, value_list) list from @httpQueryParams map. + Returns (string * string list) list suitable for Uri encoding. *) +let merge_query_params ~named_params ~map_params = + let named_keys = List.map (fun (k, _) -> k) named_params in + let filtered_map = + List.filter_map + (fun (key, values) -> if List.mem key named_keys then None else Some (key, values)) + map_params + in + named_params @ filtered_map + +(** Merge headers from @httpHeader members with @httpPrefixHeaders map. + @httpHeader takes precedence: if a header name appears in both, the @httpHeader value wins. + [named_headers] is (name, value) list from @httpHeader members. + [prefix_headers] is (prefix, (key, value) list) list from @httpPrefixHeaders map. + Returns (string * string) list. *) +let merge_headers ~named_headers ~prefix_headers = + let named_keys = List.map (fun (k, _) -> k) named_headers in + let filtered_prefix = + List.concat_map + (fun (prefix, entries) -> + List.filter_map + (fun (key, value) -> + let header_name = if prefix = "" then key else prefix ^ "-" ^ key in + if List.mem header_name named_keys then None else Some (header_name, value)) + entries) + prefix_headers + in + named_headers @ filtered_prefix + +(** Substitute host prefix from @endpoint trait into the URI host. + [host_prefix] is the prefix string (e.g. "foo."). + [labels] is (name, value) list from @hostLabel members. + + @hostLabel values are DNS labels (RFC 952: ASCII letters/digits/'-'/'.'), + so they are substituted raw — no encoding. Do NOT pct-encode a host: + percent-escaping produces an invalid hostname (e.g. "caf%C3%A9"), and the + correct encoding for an internationalized label would be Punycode + ("xn--..."), which the [uri] library does not perform and which is out of + scope (no IDNA dependency; no conformance coverage). A non-ASCII label is + therefore passed through and will fail at the HTTP layer. *) +let substitute_host_prefix ~host_prefix ~labels uri = + let resolved_prefix = + List.fold_left + (fun prefix (name, value) -> replace_first ~pattern:("{" ^ name ^ "}") ~with_:value prefix) + host_prefix labels + in + let host = Uri.host_with_default ~default:"" uri in + Uri.with_host uri (Some (resolved_prefix ^ host)) diff --git a/smaws_lib/Protocols.ml b/smaws_lib/Protocols.ml index 685d1426..d3ce1668 100644 --- a/smaws_lib/Protocols.ml +++ b/smaws_lib/Protocols.ml @@ -9,3 +9,6 @@ module AwsJson = Protocols_impl.AwsJson module AwsQuery = Protocols_impl.AwsQuery (** AwsQuery protocol support (over eio-based httpun client) *) + +module RestXml = Protocols_impl.RestXml +(** RestXml protocol support (over eio-based httpun client) *) diff --git a/smaws_lib/Smaws_Lib.ml b/smaws_lib/Smaws_Lib.ml index 01a0e6cb..6952e34a 100644 --- a/smaws_lib/Smaws_Lib.ml +++ b/smaws_lib/Smaws_Lib.ml @@ -3,6 +3,7 @@ module Context = Context module Config = Config module CoreTypes = CoreTypes module AwsErrors = AwsErrors +module Http_bindings = Http_bindings module Ini = Ini module Http = Http module Json = Json diff --git a/smaws_lib/Xml.ml b/smaws_lib/Xml.ml index f5223000..d85578f7 100644 --- a/smaws_lib/Xml.ml +++ b/smaws_lib/Xml.ml @@ -1,5 +1,70 @@ open Xmlm +module Write = struct + type t = { output : output; buf : Buffer.t; mutable started : bool } + + let make ?(decl = false) ?(indent = None) ?ns_prefix () = + let buf = Buffer.create 1024 in + let ns_prefix = match ns_prefix with Some f -> f | None -> fun _ -> None in + let output = make_output ~decl ~indent ~nl:false ~ns_prefix (`Buffer buf) in + { output; buf; started = false } + + let to_string t = Buffer.contents t.buf + let emit t signal = Xmlm.output t.output signal + + let ensure_started t = + if not t.started then ( + emit t (`Dtd None); + t.started <- true) + + let element ?(ns = "") ?(attrs : (string * string * string option) list = []) t name body = + ensure_started t; + let xml_attrs = + List.filter_map + (fun (local, value, prefix_opt) -> + match prefix_opt with + | Some prefix -> Some (("", prefix ^ ":" ^ local), value) + | None -> Some (("", local), value)) + attrs + in + (* Emit the element name as a literal ["", name] (no xmlm namespace + tracking) and declare the namespace via an [xmlns] attribute. This keeps + [element] usable without a pre-registered [ns_prefix] (the generated + serializers call [Write.make ()] with no [ns_prefix] and still emit + correct default-namespace XML like []). *) + let xml_ns_attrs = if ns <> "" then [ (("", "xmlns"), ns) ] else [] in + emit t (`El_start (("", name), xml_ns_attrs @ xml_attrs)); + body t; + emit t `El_end + + let element_with_ns ?(attrs : (string * string * string option) list = []) t ns_uri prefix name + body = + ensure_started t; + let xml_attrs = + List.filter_map + (fun (local, value, prefix_opt) -> + match prefix_opt with + | Some p -> Some (("", p ^ ":" ^ local), value) + | None -> Some (("", local), value)) + attrs + in + (* Literal prefixed name ["", "prefix:name"] (no xmlm namespace tracking) + plus an [xmlns:prefix] declaration - robust to a missing [ns_prefix] on + [make]. Produces e.g. []. *) + let ns_decl = + match prefix with + | Some p -> [ (("", "xmlns:" ^ p), ns_uri) ] + | None -> [ (("", "xmlns"), ns_uri) ] + in + let xml_name = match prefix with Some p -> ("", p ^ ":" ^ name) | None -> ("", name) in + emit t (`El_start (xml_name, ns_decl @ xml_attrs)); + body t; + emit t `El_end + + let text t s = emit t (`Data s) + let null t = () +end + module Parse = struct let source_with_encoding ~src ~encoding = let enc = @@ -24,6 +89,19 @@ module Parse = struct exception XmlUnexpectedConstruct of expected * signal * pos exception XmlMissingElement of string * pos + (* Raised by the [Primitive] leaf parsers when a value cannot be parsed. [path] + is the chain of enclosing element names, outermost first; it starts empty + and is prepended by [Read.sequence]/[Read.sequences]/[Read.element_value]/ + [Read.elements_value] as the exception unwinds, so the [run] boundary can + report the full element chain. This is the allocation-free analogue of + [Json.DeserializeHelpers] threading a [path] list: no per-descent consing + on the happy path, the path is reconstructed only on failure. *) + type deserialize_error = { path : string list; kind : string; value : string } + + exception XmlDeserializeError of deserialize_error + + let path_to_string p = String.concat "/" p + (* Unified error for the public, result-returning interface. The internal [Read]/[Structure] functions raise [XmlParse]/[XmlUnexpectedConstruct]/ [XmlMissingElement] (and primitive parsers raise [Failure]/ @@ -79,7 +157,13 @@ module Parse = struct let sequence i tag (reader : 'a reader) ?ns () = let _, _, attributes = Accept.startTag i tag ~ns ~expected:(XmlStartSequence (tag, ns)) in - let res = reader i attributes in + (* Decorate any [XmlDeserializeError] raised by the reader with this + element's tag as it unwinds. Other exceptions (which already carry a + position) propagate unchanged. *) + let res = + try reader i attributes + with XmlDeserializeError e -> raise (XmlDeserializeError { e with path = tag :: e.path }) + in let _ = Accept.endTag i ~expected:(XmlEndSequence (tag, ns)) in res @@ -95,6 +179,14 @@ module Parse = struct let _ = Accept.endTag i ~expected:(XmlEndElement (tag, ns)) in data + (** [element_value i tag conv] reads the text of [] and runs [conv] on it, decorating a + parse failure with [tag]. [conv] is a function value (e.g. [Primitive.float_of_string]), so + no closure is allocated per call. *) + let element_value i tag conv ?ns () = + let s = element i tag ?ns () in + try conv s + with XmlDeserializeError e -> raise (XmlDeserializeError { e with path = tag :: e.path }) + let elements i tag ?ns () = let rec readList ~items = match Xmlm.peek i with @@ -105,6 +197,18 @@ module Parse = struct in readList ~items:[] |> List.rev + (** [elements_value i tag conv] reads every [] child's text and maps [conv] across them, + decorating each parse failure with [tag]. The per-element closure is allocated once for the + whole list, not per item. *) + let elements_value i tag conv ?ns () = + let xs = elements i tag ?ns () in + List.map + (fun s -> + try conv s + with XmlDeserializeError e -> + raise (XmlDeserializeError { e with path = tag :: e.path })) + xs + let sequences i tag reader ?ns () = let rec readList ~items = match Xmlm.peek i with @@ -332,6 +436,78 @@ module Parse = struct let required tag value i = match value with Some value -> value | None -> raise (XmlMissingElement (tag, Xmlm.pos i)) + (** Leaf-value parsers used by generated restXml deserialisers. Each parses a primitive from its + XML text and raises [XmlDeserializeError] (with an empty path) on failure; the enclosing + [Read.sequence]/[Read.element_value] /etc. prepend their element tags as the exception + unwinds, so [run] can report the full element chain. These replace bare + [Stdlib.int_of_string]/ [float_of_string]/etc., which raised [Failure] with no element + context. *) + module Primitive = struct + let fail ~kind ~value = raise (XmlDeserializeError { path = []; kind; value }) + + let int_of_string s = + try Stdlib.int_of_string s with Failure _ -> fail ~kind:"integer" ~value:s + + let long_of_string s = try CoreTypes.Int64.of_string s with _ -> fail ~kind:"long" ~value:s + + let big_int_of_string s = + try CoreTypes.BigInt.of_string s with _ -> fail ~kind:"bigint" ~value:s + + let big_decimal_of_string s = + try CoreTypes.BigDecimal.of_string s with _ -> fail ~kind:"bigdecimal" ~value:s + + let bool_of_string s = + try Stdlib.bool_of_string s with Failure _ -> fail ~kind:"boolean" ~value:s + + let float_of_string s = + try Stdlib.float_of_string s with Failure _ -> fail ~kind:"float" ~value:s + + let double_of_string s = + try Stdlib.float_of_string s with Failure _ -> fail ~kind:"double" ~value:s + + let blob_of_string s = + try Bytes.of_string (Base64.decode_exn s) with _ -> fail ~kind:"blob" ~value:s + + let timestamp_iso_of_string s = + match Ptime.of_rfc3339 s with + | Ok (ts, _, _) -> ts + | Error _ -> fail ~kind:"timestamp(rfc3339)" ~value:s + + let timestamp_epoch_of_string s = + let f = + try Stdlib.float_of_string s + with Failure _ -> fail ~kind:"timestamp(epoch-seconds)" ~value:s + in + match Ptime.of_float_s f with + | Some t -> t + | None -> fail ~kind:"timestamp(epoch-seconds)" ~value:s + + let timestamp_httpdate_of_string s = + let parse () = + Scanf.sscanf s "%s@, %d %s %d %d:%d:%d GMT" + (fun _weekday day month_str year hour minute second -> + let month = + match month_str with + | "Jan" -> 1 + | "Feb" -> 2 + | "Mar" -> 3 + | "Apr" -> 4 + | "May" -> 5 + | "Jun" -> 6 + | "Jul" -> 7 + | "Aug" -> 8 + | "Sep" -> 9 + | "Oct" -> 10 + | "Nov" -> 11 + | _ -> 12 + in + match Ptime.of_date_time ((year, month, day), ((hour, minute, second), 0)) with + | Some t -> t + | None -> fail ~kind:"timestamp(http-date)" ~value:s) + in + try parse () with _ -> fail ~kind:"timestamp(http-date)" ~value:s + end + (* Run a direct-style parser [f] (which may raise any of the internal XML exceptions or a primitive-parser [Failure]/[Invalid_argument]) and catch every failure into [error]. This is the result-returning boundary that @@ -349,6 +525,9 @@ module Parse = struct | Structure.MissingElement (tag, pos) -> Error (XmlParseError (Fmt.str "missing element %S at %s" tag (pos_to_string pos))) | Structure.InputUnordered msg -> Error (XmlParseError msg) + | XmlDeserializeError e -> + Error + (XmlParseError (Fmt.str "invalid %s at %s: %S" e.kind (path_to_string e.path) e.value)) | Failure msg | Invalid_argument msg -> Error (XmlParseError msg) | exn -> Error (XmlParseError (Printexc.to_string exn)) end diff --git a/smaws_lib/protocols_impl/RestXml.ml b/smaws_lib/protocols_impl/RestXml.ml new file mode 100644 index 00000000..1c8ae126 --- /dev/null +++ b/smaws_lib/protocols_impl/RestXml.ml @@ -0,0 +1,336 @@ +module Log = + (val Logs.src_log (Logs.Src.create "Smaws_Lib.RestXml" ~doc:"AWS REST XML Protocol") : Logs.LOG) + +module Error = struct + type errorType = Sender | Receiver + type t = { errorType : errorType; code : string; message : string option } +end + +type error = + [ `HttpError of Http.http_failure + | `XmlParseError of string + | `AWSServiceError of AwsErrors.aws_service_error ] + +let error_to_string = function + | `HttpError e -> Fmt.str "%a" Http.pp_http_failure e + | `XmlParseError s -> Fmt.str "XmlParseError: %s" s + | `AWSServiceError e -> Fmt.str "%a" AwsErrors.pp_aws_service_error e + +let pp_error fmt e = Fmt.pf fmt "%s" (error_to_string e) + +module Errors = struct + let default_handler (error : Error.t) = + `AWSServiceError + AwsErrors.{ message = error.message; _type = { namespace = ""; name = error.code } } +end + +module Serialize = struct + (* Shortest round-trip-safe decimal representation of a float, mirroring + [Smaws_Lib.Protocols.AwsQuery.Serialize.float_to_string]. Starts at the + 6-sig-fig default of %g (so common values like 5.5 emit "5.5", matching the + smithy fixtures) and increases precision until [Float.of_string] of the + output equals the input, capping at %.17g (the round-trip bound for IEEE + doubles). %g's lossy 6-sig-fig truncation would silently corrupt + high-precision doubles. *) + let float_to_string v = + let rec loop p = + if p > 17 then Printf.sprintf "%.17g" v + else ( + let s = Printf.sprintf "%.*g" p v in + if Float.equal (Float.of_string s) v then s else loop (p + 1)) + in + loop 6 + + (* restXml serializes NaN / Infinity / -Infinity as those literal strings + (SimpleScalarProperties conformance). Mirrors + [Smaws_Lib.Protocols.AwsQuery.Serialize.float_field]'s sentinel handling. *) + let float_field_to_string v = + if Float.is_nan v then "NaN" + else if Float.is_infinite v then if v > 0.0 then "Infinity" else "-Infinity" + else float_to_string v + + let timestamp_iso_to_string (v : Ptime.t) = + let s = Ptime.to_rfc3339 ~tz_offset_s:0 v in + let len = String.length s in + if len >= 6 && String.sub s (len - 6) 6 = "+00:00" then String.sub s 0 (len - 6) ^ "Z" else s + + let timestamp_epoch_to_string (v : Ptime.t) = + let posix = Ptime.to_float_s v in + if Float.is_integer posix then string_of_int (int_of_float posix) else string_of_float posix + + let timestamp_httpdate_to_string (v : Ptime.t) = + let weekday_of_int = function + | 0 -> "Sun" + | 1 -> "Mon" + | 2 -> "Tue" + | 3 -> "Wed" + | 4 -> "Thu" + | 5 -> "Fri" + | _ -> "Sat" + in + let month_of_int = function + | 1 -> "Jan" + | 2 -> "Feb" + | 3 -> "Mar" + | 4 -> "Apr" + | 5 -> "May" + | 6 -> "Jun" + | 7 -> "Jul" + | 8 -> "Aug" + | 9 -> "Sep" + | 10 -> "Oct" + | 11 -> "Nov" + | _ -> "Dec" + in + let (year, month, day), ((hour, min, sec), _) = Ptime.to_date_time v in + let dow = + Ptime.weekday ~tz_offset_s:0 v |> function + | `Sun -> 0 + | `Mon -> 1 + | `Tue -> 2 + | `Wed -> 3 + | `Thu -> 4 + | `Fri -> 5 + | `Sat -> 6 + in + Printf.sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT" (weekday_of_int dow) day + (month_of_int month) year hour min sec +end + +(** Parse the default restXml error envelope: + ............ + ... Returns (Error.t, request_id option). *) +let parse_error_envelope ~body = + let open Xml.Parse in + run (fun () -> + let xmlSource = source_with_encoding ~src:body ~encoding:None in + Read.dtd xmlSource; + Read.sequence xmlSource "ErrorResponse" + (fun _ _ -> + let error = + Read.sequence xmlSource "Error" + (fun i _ -> + let r_type = ref None in + let r_code = ref None in + let r_message = ref None in + Structure.scanSequence i [ "Type"; "Code"; "Message" ] (fun tag _ -> + match tag with + | "Type" -> r_type := Some (Read.element i "Type" ()) + | "Code" -> r_code := Some (Read.element i "Code" ()) + | "Message" -> r_message := Some (Read.element i "Message" ()) + | _ -> Read.skip_element i); + let errorType = + match !r_type with + | Some "Sender" -> Error.Sender + | Some "Receiver" -> Error.Receiver + | _ -> raise (Failure "missing or unknown Error/Type") + in + let code = + match !r_code with Some c -> c | None -> raise (Failure "missing Error/Code") + in + Error.{ errorType; code; message = !r_message }) + () + in + let request_id = + match Xmlm.peek xmlSource with + | `El_start el when tag_equal "RequestId" None el -> + Some (Read.element xmlSource "RequestId" ()) + | _ -> None + in + Read.skip_to_end xmlSource; + (error, request_id)) + ()) + +(** Parse the noErrorWrapping error envelope (S3 style): + ............ The root element is + directly, with Type, Code, Message, and RequestId as direct children. *) +let parse_error_envelope_nowrapping ~body = + let open Xml.Parse in + run (fun () -> + let xmlSource = source_with_encoding ~src:body ~encoding:None in + Read.dtd xmlSource; + Read.sequence xmlSource "Error" + (fun i _ -> + let r_type = ref None in + let r_code = ref None in + let r_message = ref None in + let r_request_id = ref None in + Structure.scanSequence i [ "Type"; "Code"; "Message"; "RequestId" ] (fun tag _ -> + match tag with + | "Type" -> r_type := Some (Read.element i "Type" ()) + | "Code" -> r_code := Some (Read.element i "Code" ()) + | "Message" -> r_message := Some (Read.element i "Message" ()) + | "RequestId" -> r_request_id := Some (Read.element i "RequestId" ()) + | _ -> Read.skip_element i); + let errorType = + match !r_type with + | Some "Sender" -> Error.Sender + | Some "Receiver" -> Error.Receiver + | _ -> raise (Failure "missing or unknown Error/Type") + in + let code = + match !r_code with Some c -> c | None -> raise (Failure "missing Error/Code") + in + (Error.{ errorType; code; message = !r_message }, !r_request_id)) + ()) + +(** Re-parse a restXml error response body and run [structParser] positioned inside , so + generated error deserialisers can recover the error-shape members that carries alongside + //. *) +let parse_error_struct ~body ~structParser = + let open Xml.Parse in + run (fun () -> + let xmlSource = source_with_encoding ~src:body ~encoding:None in + Read.dtd xmlSource; + Read.sequence xmlSource "ErrorResponse" + (fun _ _ -> + let result = Read.sequence xmlSource "Error" (fun i _ -> structParser i) () in + Read.skip_to_end xmlSource; + result) + ()) + +(** Parse a restXml success (2xx) response body. The [output_deserializer] consumes the response's + root element directly from the [Xmlm.input] (it is the generated [_of_xml], which calls + its own [Read.sequence] on the root). Trailing whitespace/comments after the root are not read — + calling [Read.skip_to_end] here would peek past the document's single root and hit end-of-input, + which [Xmlm.peek] reports as [Xmlm.Error] (caught by [run]'s catch-all as a spurious + [XmlParseError]). The deserializer owns consumption of the root and any siblings inside it. *) +let parse_response ~(body : string) ~(output_deserializer : Xmlm.input -> 'out) : + ('out, Xml.Parse.error) result = + let open Xml.Parse in + run (fun () -> + let xmlSource = source_with_encoding ~src:body ~encoding:None in + Read.dtd xmlSource; + output_deserializer xmlSource) + +(** AWS REST XML services put the request id in a response header. The header name varies: most + services use [x-amzn-requestid], S3 uses [x-amz-request-id] (and historically + [x-amz-requestid]). HTTP header names are case-insensitive, so compare lowercased; the first + non-empty value wins. *) +let request_id_header_names = [ "x-amzn-requestid"; "x-amz-request-id"; "x-amz-requestid" ] + +let request_id_of_headers (headers : Http.headers) : string option = + let normalized = List.map (fun (k, v) -> (String.lowercase_ascii k, v)) headers in + List.find_map + (fun name -> + List.find_map + (fun (k, v) -> if String.equal k name && v <> "" then Some v else None) + normalized) + request_id_header_names + +(** For error responses the id is in both the response header and the body []. Prefer the + header (always present, even with [noErrorWrapping]); fall back to the body when the header is + absent. *) +let request_id_prefer_header ~header ~body = match header with Some _ -> header | None -> body + +(** Response-header readers used by generated restXml deserialisers for [@httpHeader]- and + [@httpPrefixHeaders]-bound output/error members (plan §7.2). HTTP header names are + case-insensitive, so all matching is on lowercased names; the returned keys preserve the + original casing the server sent. + + On the deserialise (client) side the smithy fixtures populate BOTH a specifically-bound + [@httpHeader] member AND the matching [@httpPrefixHeaders] entry from the same header — see + [aws.protocoltests.restxml#HttpEmptyPrefixHeaders] ([HttpEmptyPrefixHeadersResponseClient]: + headers [hello:There] deserialise to [specificHeader = There] AND + [prefixHeaders.hello = There]). The [@httpHeader]-over-[@httpPrefixHeaders] precedence is a + serialise (server) -side rule, so these readers do NOT exclude specifically-bound names; the + generated deserialiser simply reads each binding independently. *) + +(** Case-insensitive lookup of a single response header by name. Returns the first matching value or + [None]. Used by generated deserialisers for [@httpHeader "name"] members. *) +let header_value (headers : Http.headers) (name : string) : string option = + let target = String.lowercase_ascii name in + List.find_map + (fun (k, v) -> if String.equal (String.lowercase_ascii k) target then Some v else None) + headers + +(** Collect response headers whose name starts with [prefix] (case-insensitive), returning + [(key, value)] pairs suitable for a deserialised map member: + - empty [prefix] matches every header and the key is the full header name (the + [HttpEmptyPrefixHeaders] case: [prefixHeaders] is a map of every response header); + - non-empty [prefix] matches only headers with that prefix and the key is the suffix (the header + name with [prefix] removed) — e.g. prefix ["x-foo-"] on header ["x-foo-abc"] yields key + ["abc"] (the [HttpPrefixHeadersArePresent] case). The original header-name casing is preserved + in the returned keys. *) +let prefix_headers ~(prefix : string) (headers : Http.headers) : (string * string) list = + let prefix_lc = String.lowercase_ascii prefix in + let plen = String.length prefix in + List.filter_map + (fun (k, v) -> + let k_lc = String.lowercase_ascii k in + if plen = 0 then Some (k, v) + else if String.length k_lc >= plen && String.equal (String.sub k_lc 0 plen) prefix_lc then + Some (String.sub k plen (String.length k - plen), v) + else None) + headers + +(** Like [request] but also returns response metadata (the request id). Mirrors + [AwsQuery.request_with_metadata]: Ok is an ['out Response.t] record, Error is an + ['err * Response.metadata] tuple. On success the id comes from the response header only (restXml + success bodies have no []); on error it comes from the header with the body + [] (parsed by [parse_error_envelope]) as a fallback. *) +let request_with_metadata (type http_t) ~(shape_name : string) ~(service : Service.descriptor) + ~(context : http_t Context.t) ~(method_ : Http.method_) ~(uri : Uri.t) + ~(query : (string * string list) list) ~(headers : (string * string) list) + ~(body : (string * string) option) ~(output_deserializer : Xmlm.input -> 'out) + ~(error_deserializer : Error.t -> body:string -> 'err) : + ('out Response.t, 'err * Response.metadata) result = + let config = Context.config context in + (* Build the full URI with query parameters *) + let uri = + if query = [] then uri + else ( + let existing_query = Uri.query uri in + Uri.with_query uri (existing_query @ query)) + in + (* Build the body and content type *) + let input_body, content_type = + match body with + | Some (ct, body_str) -> (`String body_str, ct) + | None -> (`None, "application/xml") + in + let all_headers = ("Content-Type", content_type) :: headers in + let all_headers = + Sign.sign_request_v4 ~config ~service ~uri ~method_ ~headers:all_headers + ~body:(match input_body with `String s -> s | _ -> "") + in + let module Http = (val Context.http_type context : Http.Client with type t = http_t) in + let http = Context.http context in + Logs.debug (fun m -> m "Sending request to %s\n" (Uri.to_string uri)); + (match input_body with `String s -> Logs.debug (fun m -> m "Sending body %s\n" s) | _ -> ()); + match Http.request ~method_ ~headers:all_headers ~body:input_body ~uri http with + | Ok (response, response_body) -> begin + let status = Http.Response.status response in + let header_request_id = request_id_of_headers (Http.Response.headers response) in + let body_str = match Http.Body.to_string response_body with Some b -> b | None -> "" in + match status with + | x when x >= 200 && x < 300 -> ( + match parse_response ~body:body_str ~output_deserializer with + | Ok r -> Ok Response.{ response = r; metadata = { request_id = header_request_id } } + | Error (Xml.Parse.XmlParseError msg) -> + Error (`XmlParseError msg, Response.{ request_id = header_request_id })) + | _ -> + begin match parse_error_envelope ~body:body_str with + | Ok (error, body_request_id) -> + let request_id = + request_id_prefer_header ~header:header_request_id ~body:body_request_id + in + Error (error_deserializer error ~body:body_str, Response.{ request_id }) + | Error (Xml.Parse.XmlParseError msg) -> + Error (`XmlParseError msg, Response.{ request_id = header_request_id }) + end + end + | Error http_failure -> Error (`HttpError http_failure, Response.{ request_id = None }) + +(** The metadata-stripping wrapper used by the generated stubs: delegates to [request_with_metadata] + and discards the response metadata, preserving the [('out, 'err) result] signature expected by + generated operation code. *) +let request (type http_t) ~(shape_name : string) ~(service : Service.descriptor) + ~(context : http_t Context.t) ~(method_ : Http.method_) ~(uri : Uri.t) + ~(query : (string * string list) list) ~(headers : (string * string) list) + ~(body : (string * string) option) ~(output_deserializer : Xmlm.input -> 'out) + ~(error_deserializer : Error.t -> body:string -> 'err) : ('out, 'err) result = + request_with_metadata ~shape_name ~service ~context ~method_ ~uri ~query ~headers ~body + ~output_deserializer ~error_deserializer + |> Result.map (fun { Response.response; _ } -> response) + |> Result.map_error (fun (error, _) -> error) diff --git a/smaws_lib_test/dune b/smaws_lib_test/dune index 89161769..ecb8f480 100644 --- a/smaws_lib_test/dune +++ b/smaws_lib_test/dune @@ -32,7 +32,37 @@ (modules aws_query_serialize_test) (libraries Smaws_Lib alcotest)) +(test + (name xml_roundtrip_test) + (modules xml_roundtrip_test) + (libraries Smaws_Lib alcotest)) + (test (name uint64_test) (modules uint64_test) (libraries Smaws_Lib alcotest)) + +(test + (name http_bindings_test) + (modules http_bindings_test) + (libraries Smaws_Lib alcotest)) + +(test + (name restxml_response_test) + (modules restxml_response_test) + (libraries Smaws_Lib alcotest)) + +(test + (name restxml_serialize_test) + (modules restxml_serialize_test) + (libraries Smaws_Lib alcotest)) + +(test + (name restxml_deserialize_test) + (modules restxml_deserialize_test) + (libraries Smaws_Lib alcotest)) + +(test + (name xml_parse_error_test) + (modules xml_parse_error_test) + (libraries Smaws_Lib alcotest)) diff --git a/smaws_lib_test/http_bindings_test.ml b/smaws_lib_test/http_bindings_test.ml new file mode 100644 index 00000000..af740ece --- /dev/null +++ b/smaws_lib_test/http_bindings_test.ml @@ -0,0 +1,157 @@ +(* Tests for [Smaws_Lib.Http_bindings]: restXml HTTP binding helpers. + Covers percent-encoding (greedy vs non-greedy), URI template label + substitution, @httpQuery-over-@httpQueryParams precedence (incl. list-valued + maps), @httpHeader-over-@httpPrefixHeaders precedence (incl. empty prefix), + and @endpoint host-prefix substitution. *) + +module H = Smaws_Lib.Http_bindings +module U = Uri + +(* ---- percent_encode_path_segment ---- *) + +let encode_path () = + (* greedy labels ({label+}) must NOT percent-encode '/' (or anything else) *) + Alcotest.(check string) + "greedy keeps slash" "there/guy" + (H.percent_encode_path_segment ~greedy:true "there/guy"); + (* non-greedy labels percent-encode per the Path component, including '/' *) + Alcotest.(check string) + "non-greedy encodes slash" "a%2Fb" + (H.percent_encode_path_segment ~greedy:false "a/b"); + Alcotest.(check string) + "non-greedy encodes space" "a%20b" + (H.percent_encode_path_segment ~greedy:false "a b"); + Alcotest.(check string) + "non-greedy plain" "abc" + (H.percent_encode_path_segment ~greedy:false "abc") + +(* ---- percent_encode_query_value ---- *) + +let encode_query () = + Alcotest.(check string) "query encodes space" "a%20b" (H.percent_encode_query_value "a b"); + (* '&' must be encoded so it is not interpreted as a param separator *) + Alcotest.(check string) "query encodes amp" "a%26b" (H.percent_encode_query_value "a&b"); + Alcotest.(check string) "query plain" "abc" (H.percent_encode_query_value "abc") + +(* ---- substitute_labels ---- *) + +let subst_labels () = + Alcotest.(check string) + "simple label" "/foo/a%20b" + (H.substitute_labels ~template:"/foo/{bar}" ~labels:[ ("bar", "a b", false) ]); + (* greedy label keeps '/' unencoded *) + Alcotest.(check string) + "greedy label keeps slash" "/foo/there/guy" + (H.substitute_labels ~template:"/foo/{bar+}" ~labels:[ ("bar", "there/guy", true) ]); + (* non-greedy label encodes '/' so it cannot inject a path separator *) + Alcotest.(check string) + "non-greedy label encodes slash" "/foo/a%2Fb" + (H.substitute_labels ~template:"/foo/{bar}" ~labels:[ ("bar", "a/b", false) ]); + (* literal query string embedded in @http uri is preserved *) + Alcotest.(check string) + "literal query preserved" "/foo/a%20b?baz=qux" + (H.substitute_labels ~template:"/foo/{bar}?baz=qux" ~labels:[ ("bar", "a b", false) ]); + (* multiple labels substituted, each once *) + Alcotest.(check string) + "two labels" "/foo/1/bar/2" + (H.substitute_labels ~template:"/foo/{a}/bar/{b}" + ~labels:[ ("a", "1", false); ("b", "2", false) ]); + (* a label absent from the template leaves the template unchanged *) + Alcotest.(check string) + "absent label noop" "/foo" + (H.substitute_labels ~template:"/foo" ~labels:[ ("a", "1", false) ]) + +(* ---- merge_query_params ---- *) + +let merge_query () = + (* @httpQuery value wins and the conflicting @httpQueryParams entry is + dropped (not duplicated). *) + Alcotest.(check int) + "named wins, map entry dropped" 2 + (List.length + (H.merge_query_params + ~named_params:[ ("bar", [ "named" ]) ] + ~map_params:[ ("bar", [ "map1"; "map2" ]); ("foo", [ "x" ]) ])); + Alcotest.(check (list (pair string (list string)))) + "named wins, map entry dropped (values)" + [ ("bar", [ "named" ]); ("foo", [ "x" ]) ] + (H.merge_query_params + ~named_params:[ ("bar", [ "named" ]) ] + ~map_params:[ ("bar", [ "map1"; "map2" ]); ("foo", [ "x" ]) ]); + (* list-valued map entries are preserved as repeated query keys *) + Alcotest.(check (list (pair string (list string)))) + "list-valued map preserved" + [ ("k", [ "a"; "b" ]) ] + (H.merge_query_params ~named_params:[] ~map_params:[ ("k", [ "a"; "b" ]) ]); + (* named-only passes through *) + Alcotest.(check (list (pair string (list string)))) + "named only" + [ ("a", [ "1" ]) ] + (H.merge_query_params ~named_params:[ ("a", [ "1" ]) ] ~map_params:[]) + +(* ---- merge_headers ---- *) + +let merge_hdrs () = + (* @httpHeader wins over @httpPrefixHeaders on the same name; prefix entry + dropped. Empty prefix ("") matches bare header names. *) + Alcotest.(check (list (pair string string))) + "named header wins over empty-prefix" + [ ("hello", "specific") ] + (H.merge_headers + ~named_headers:[ ("hello", "specific") ] + ~prefix_headers:[ ("", [ ("hello", "prefix-val") ]) ]); + (* empty prefix with no named conflict passes all entries through bare *) + Alcotest.(check (list (pair string string))) + "empty prefix passthrough" + [ ("x", "1"); ("y", "2") ] + (H.merge_headers ~named_headers:[] ~prefix_headers:[ ("", [ ("x", "1"); ("y", "2") ]) ]); + (* non-empty prefix prepends "prefix-" to each entry name *) + Alcotest.(check (list (pair string string))) + "prefix prepends name" + [ ("foo-a", "1") ] + (H.merge_headers ~named_headers:[] ~prefix_headers:[ ("foo", [ ("a", "1") ]) ]); + (* named header wins over a prefixed entry that resolves to the same name *) + Alcotest.(check (list (pair string string))) + "named wins over nonempty prefix" + [ ("foo-a", "specific") ] + (H.merge_headers + ~named_headers:[ ("foo-a", "specific") ] + ~prefix_headers:[ ("foo", [ ("a", "prefix-val") ]) ]) + +(* ---- substitute_host_prefix ---- *) + +let subst_host () = + let base = U.of_string "https://example.com/foo" in + (* static host prefix prepended to host *) + Alcotest.(check string) + "static host prefix" "foo.example.com" + (U.host_with_default ~default:"" (H.substitute_host_prefix ~host_prefix:"foo." ~labels:[] base)); + (* {label} in host prefix substituted from @hostLabel members *) + Alcotest.(check string) + "host label substituted" "123.example.com" + (U.host_with_default ~default:"" + (H.substitute_host_prefix ~host_prefix:"{account}." ~labels:[ ("account", "123") ] base)); + (* a label embedded in a prefix with a static suffix is substituted in place *) + Alcotest.(check string) + "host label mid-prefix" "prod-us.example.com" + (U.host_with_default ~default:"" + (H.substitute_host_prefix ~host_prefix:"{env}-us." ~labels:[ ("env", "prod") ] base)); + (* path is untouched *) + Alcotest.(check string) + "path preserved" "/foo" + (U.path (H.substitute_host_prefix ~host_prefix:"foo." ~labels:[] base)) + +let () = + Alcotest.run "Http_bindings" + [ + ( "encode_path", + [ + ("greedy/non-greedy/slash", `Quick, encode_path); + ("query value encoding", `Quick, encode_query); + ] ); + ("subst_labels", [ ("label substitution + greedy slash", `Quick, subst_labels) ]); + ( "merge_query", + [ ("httpQuery over httpQueryParams precedence + list values", `Quick, merge_query) ] ); + ("merge_headers", [ ("httpHeader over httpPrefixHeaders + empty prefix", `Quick, merge_hdrs) ]); + ("subst_host", [ ("endpoint host-prefix substitution", `Quick, subst_host) ]); + ] diff --git a/smaws_lib_test/restxml_deserialize_test.ml b/smaws_lib_test/restxml_deserialize_test.ml new file mode 100644 index 00000000..55baeb4f --- /dev/null +++ b/smaws_lib_test/restxml_deserialize_test.ml @@ -0,0 +1,195 @@ +(** Phase 6 parse checkpoint for the restXml deserialiser. + + The generated [_of_xml] functions are exercised end-to-end by the Phase 8 conformance + suite, but the runtime leaf parsers they build on ([Smaws_Lib.Xml.Parse.Primitive.*] for + primitive text, [Smaws_Lib.Xml.Parse.Read.element_value] for path-decorated failure reporting, + and [Smaws_Lib.Xml.Parse.run] for the result-returning boundary) are pure and are unit-tested + here. This is the Phase 6 checkpoint: it locks in the three behaviours the plan calls out — + [http-date] parsed via a guarded [Scanf] (success and failure), [epoch-seconds] floats, and + explicit [Result] matching at the [run] boundary (no partial functions on the happy path: a bad + value surfaces as [Error], not an uncaught exception). + + The response-header readers ([RestXml.header_value]/[RestXml.prefix_headers]) used by the + generated deserialisers for [@httpHeader]/[@httpPrefixHeaders] members are also pure and are + covered here, including the empty-prefix [httpPrefixHeaders] case (G19). *) + +module RestXml = Smaws_Lib.Protocols.RestXml +module Xml = Smaws_Lib.Xml +module Primitive = Xml.Parse.Primitive + +(** The Phase 6 fixtures: [Mon, 16 Dec 2019 23:48:18 GMT] is the IMF-fixdate the smithy + [TimestampFormatHeaders] case uses; its epoch-seconds form is [1576540098] + (2019-12-16T23:48:18Z). [http-date] and [epoch-seconds] must round-trip to the same [Ptime.t]. +*) +let http_date_fixture = "Mon, 16 Dec 2019 23:48:18 GMT" + +let epoch_fixture = "1576540098" +let expected_date_time = ((2019, 12, 16), ((23, 48, 18), 0)) + +(** [Ptime.of_date_time] of a known-valid date is always [Some]; fail the test loudly if not. *) +let pt_of_date_time d = + match Ptime.of_date_time d with + | Some t -> t + | None -> Alcotest.fail "Ptime.of_date_time returned None for a known-valid date" + +let pt_of_float_s f = + match Ptime.of_float_s f with + | Some t -> t + | None -> Alcotest.fail "Ptime.of_float_s returned None for a known-valid epoch" + +(** [run] returns [Ok] for a well-formed [http-date]; the guarded [Scanf] in + [timestamp_httpdate_of_string] accepts the IMF-fixdate. Explicit [Result] matching (no + [Result.get_ok]) keeps the happy path partial-function-free. *) +let httpdate_parses_imf_fixdate () = + match Xml.Parse.run (fun () -> Primitive.timestamp_httpdate_of_string http_date_fixture) with + | Ok t -> + Alcotest.(check bool) + "http-date parses to the expected instant" true + (Ptime.equal t (pt_of_date_time expected_date_time)); + Alcotest.(check bool) + "http-date and epoch-seconds agree" true + (Ptime.equal t (Primitive.timestamp_epoch_of_string epoch_fixture)) + | Error (Xml.Parse.XmlParseError msg) -> Alcotest.fail ("expected Ok, got Error: " ^ msg) + +(** A malformed [http-date] must surface as [Error] at the [run] boundary, not as an uncaught + [Scanf.Scan_failure]/[Failure]. The guarded [Scanf] (try/with) in [timestamp_httpdate_of_string] + converts any parse error into [XmlDeserializeError], which [run] folds into [XmlParseError]. *) +let httpdate_rejects_garbage_as_error () = + match Xml.Parse.run (fun () -> Primitive.timestamp_httpdate_of_string "not a date") with + | Ok _ -> Alcotest.fail "expected Error for a malformed http-date, got Ok" + | Error (Xml.Parse.XmlParseError msg) -> + (* The error message names the kind (timestamp(http-date)) so a deserialiser failure is + self-describing. *) + Alcotest.(check bool) "error message names the kind" true (String.length msg > 0) + +(** [epoch-seconds] accepts both integer and fractional seconds. *) +let epoch_parses_integer_and_fractional () = + let parse s = Xml.Parse.run (fun () -> Primitive.timestamp_epoch_of_string s) in + match (parse "1576540098", parse "1576540098.5") with + | Ok t_int, Ok t_frac -> + Alcotest.(check bool) + "integer epoch matches the http-date instant" true + (Ptime.equal t_int (pt_of_date_time expected_date_time)); + Alcotest.(check bool) + "fractional epoch is half a second later" true + (Ptime.equal t_frac (pt_of_float_s 1576540098.5)) + | _ -> Alcotest.fail "expected both epoch parses to succeed" + +let epoch_rejects_garbage_as_error () = + match Xml.Parse.run (fun () -> Primitive.timestamp_epoch_of_string "not-a-number") with + | Ok _ -> Alcotest.fail "expected Error for a malformed epoch, got Ok" + | Error (Xml.Parse.XmlParseError _) -> () + +(** Primitive leaf parsers (int/float/bool) succeed on valid text and surface [Error] on invalid + text — no [Failure] escapes [run]. This is the "no partial functions on the happy path" + guarantee: the generated deserialiser may call these directly without a surrounding try/with. *) +let primitive_parsers_succeed_and_fail_via_run () = + (match Xml.Parse.run (fun () -> Primitive.int_of_string "42") with + | Ok v -> Alcotest.(check int) "int_of_string ok" 42 v + | Error (Xml.Parse.XmlParseError msg) -> Alcotest.fail ("expected Ok: " ^ msg)); + (match Xml.Parse.run (fun () -> Primitive.bool_of_string "true") with + | Ok v -> Alcotest.(check bool) "bool_of_string ok" true v + | Error (Xml.Parse.XmlParseError msg) -> Alcotest.fail ("expected Ok: " ^ msg)); + (match Xml.Parse.run (fun () -> Primitive.int_of_string "notanint") with + | Ok _ -> Alcotest.fail "expected Error for malformed int" + | Error (Xml.Parse.XmlParseError _) -> ()); + match Xml.Parse.run (fun () -> Primitive.bool_of_string "notabool") with + | Ok _ -> Alcotest.fail "expected Error for malformed bool" + | Error (Xml.Parse.XmlParseError _) -> () + +(** A primitive parse failure inside [Read.element_value] is decorated with the enclosing element's + tag as the exception unwinds, so [run]'s [XmlParseError] message reports the full element path + (the [XmlDeserializeError.path] mechanism). This is what makes a deserialiser failure + self-locating without per-call exception handling. *) +let element_value_failure_decorates_path () = + let body = "notanint" in + let parse () = + let open Xml.Parse in + run (fun () -> + let i = source_with_encoding ~src:body ~encoding:None in + Read.dtd i; + Read.element_value i "Foo" Primitive.int_of_string ()) + in + match parse () with + | Ok _ -> Alcotest.fail "expected Error for notanint" + | Error (Xml.Parse.XmlParseError msg) -> + Alcotest.(check bool) "error message names the failing element" true (String.length msg > 0) + +(** [@httpHeader] lookup is case-insensitive (HTTP header names are). *) +let header_value_is_case_insensitive () = + Alcotest.(check (option string)) + "exact name recovered" (Some "Header") + (RestXml.header_value [ ("X-Header", "Header") ] "X-Header"); + Alcotest.(check (option string)) + "lowercased query finds mixed-case header" (Some "Header") + (RestXml.header_value [ ("X-Header", "Header") ] "x-header"); + Alcotest.(check (option string)) + "mixed-case query finds lowercased header" (Some "v") + (RestXml.header_value [ ("x-foo", "v") ] "X-Foo"); + Alcotest.(check (option string)) + "absent header is None" None + (RestXml.header_value [ ("content-type", "application/xml") ] "X-Header") + +(** [@httpPrefixHeaders] with an empty prefix collects every response header under its full name + (the [HttpEmptyPrefixHeaders] case); a non-empty prefix collects only matching headers under the + suffix (the [HttpPrefixHeadersArePresent] case). Prefix matching is case-insensitive and the + returned keys preserve the server's casing. *) +let prefix_headers_empty_and_prefixed () = + let headers = + [ ("x-foo", "Foo"); ("x-foo-abc", "Abc"); ("x-foo-def", "Def"); ("hello", "There") ] + in + (* Empty prefix: every header, keyed by its full name. *) + let empty = RestXml.prefix_headers ~prefix:"" headers in + Alcotest.(check (list (pair string string))) + "empty prefix collects all headers under full names" + [ ("hello", "There"); ("x-foo", "Foo"); ("x-foo-abc", "Abc"); ("x-foo-def", "Def") ] + (List.sort compare empty); + (* Non-empty prefix: only matching headers, keyed by the suffix. *) + let prefixed = RestXml.prefix_headers ~prefix:"x-foo-" headers in + Alcotest.(check (list (pair string string))) + "prefixed collects suffixes only" + [ ("abc", "Abc"); ("def", "Def") ] + (List.sort compare prefixed); + (* The specific [@httpHeader "x-foo"] member is NOT removed from the empty-prefix map on the + deserialise side — both bindings are populated independently (the precedence rule is a + serialise-side concern; see [RestXml.prefix_headers] doc). *) + Alcotest.(check (list (pair string string))) + "x-foo is present in the empty-prefix map (no deserialise-side exclusion)" + [ ("x-foo", "Foo") ] + (List.filter (fun (k, _) -> String.equal k "x-foo") empty); + (* Case-insensitive prefix match. *) + Alcotest.(check (list (pair string string))) + "prefix match is case-insensitive" + [ ("abc", "Abc"); ("def", "Def") ] + (List.sort compare (RestXml.prefix_headers ~prefix:"X-FOO-" headers)) + +let () = + Alcotest.run "RestXml deserialise" + [ + ( "timestamp_httpdate", + [ + ("parses an IMF-fixdate via guarded Scanf", `Quick, httpdate_parses_imf_fixdate); + ("rejects a malformed http-date as Error", `Quick, httpdate_rejects_garbage_as_error); + ] ); + ( "timestamp_epoch", + [ + ( "parses integer and fractional epoch-seconds", + `Quick, + epoch_parses_integer_and_fractional ); + ("rejects a malformed epoch as Error", `Quick, epoch_rejects_garbage_as_error); + ] ); + ( "primitive_parsers", + [ + ( "succeed and fail via run (no partial functions on happy path)", + `Quick, + primitive_parsers_succeed_and_fail_via_run ); + ( "element_value failure decorates the element path", + `Quick, + element_value_failure_decorates_path ); + ] ); + ( "response_headers", + [ + ("header_value is case-insensitive", `Quick, header_value_is_case_insensitive); + ("prefix_headers empty and prefixed", `Quick, prefix_headers_empty_and_prefixed); + ] ); + ] diff --git a/smaws_lib_test/restxml_response_test.ml b/smaws_lib_test/restxml_response_test.ml new file mode 100644 index 00000000..f34a6e85 --- /dev/null +++ b/smaws_lib_test/restxml_response_test.ml @@ -0,0 +1,212 @@ +(** Smoke tests for the restXml runtime protocol module. + + These lock in the two core response paths independently of the smithy compliance fixtures: + + - [parse_response] (the 2xx success path) must hand the [Xmlm.input] to the generated output + deserializer and return its value. The success fixture below has a trailing newline (as real + HTTP bodies do) to exercise the boundary at the end of the document's single root element. + - [parse_error_envelope] (the error path) must recover // from inside + **and skip the trailing sibling of ** before . The + error fixture keeps that trailing . + + Two additional cases cover the restXml-specific [noErrorWrapping] envelope (S3 style, root + directly) and [parse_error_struct] (positions a generated error-shape deserializer + inside and skips the trailing sibling), mirroring the + aws_query_response_test coverage. *) + +(** A realistic restXml success response: a root element named after the operation output, two + member children, and a trailing newline. *) +let success_body_with_trailing_newline = + {| + bar + qux + +|} + +(** Error envelope fixture with a trailing sibling of : [parse_error_envelope] + must skip it before , otherwise the outer [Read.sequence]'s endTag would see + and raise [XmlUnexpectedConstruct]. *) +let error_body_with_message_and_trailing_request_id = + {| + + Sender + SomeError + boom + + req-2 + +|} + +(** S3-style [noErrorWrapping] envelope: is the root and is a direct child. *) +let no_wrapping_error_body = + {| + Receiver + NoSuchBucket + nope + req-s3 + +|} + +let complex_error_body = + {| + + Sender + ComplexError + Top level + + bar + + + foo-id + +|} + +module RestXml = Smaws_Lib.Protocols.RestXml +module Xml = Smaws_Lib.Xml + +let success_path_parses_root_and_returns_value () = + (* The deserializer consumes the single root element; the runtime must not + peek past it once consumed, or [Xmlm.peek] raises [Xmlm.Error] at + end-of-input. *) + let deserializer i = + let open Xml.Parse in + Read.sequence i "GetXResponse" ~ns:"https://example.com/" + (fun i _ -> + let r_foo = ref None in + let r_baz = ref None in + Structure.scanSequence i [ "Foo"; "Baz" ] (fun tag _ -> + match tag with + | "Foo" -> r_foo := Some (Read.element i "Foo" ()) + | "Baz" -> r_baz := Some (Read.element i "Baz" ()) + | _ -> Read.skip_element i); + (!r_foo, !r_baz)) + () + in + let result = + RestXml.parse_response ~body:success_body_with_trailing_newline + ~output_deserializer:deserializer + |> Result.get_ok + in + Alcotest.(check (option string)) "Foo recovered" (Some "bar") (fst result); + Alcotest.(check (option string)) "Baz recovered" (Some "qux") (snd result) + +let error_path_recovers_message_and_skips_trailing_request_id () = + (* The outer [Read.sequence "ErrorResponse"] must skip the trailing + sibling of ; scanSequence tolerates it while + is recovered. *) + let error, request_id = + Result.get_ok + (RestXml.parse_error_envelope ~body:error_body_with_message_and_trailing_request_id) + in + let module E = RestXml.Error in + Alcotest.(check bool) "errorType is Sender" true (error.E.errorType = E.Sender); + Alcotest.(check string) "code" "SomeError" error.E.code; + Alcotest.(check (option string)) "message recovered" (Some "boom") error.E.message; + Alcotest.(check (option string)) "request_id recovered" (Some "req-2") request_id + +let no_wrapping_envelope_recovers_direct_children () = + (* The S3 [noErrorWrapping] path: is the root and is a + direct child read by the same scanSequence. *) + let error, request_id = + Result.get_ok (RestXml.parse_error_envelope_nowrapping ~body:no_wrapping_error_body) + in + let module E = RestXml.Error in + Alcotest.(check bool) "errorType is Receiver" true (error.E.errorType = E.Receiver); + Alcotest.(check string) "code" "NoSuchBucket" error.E.code; + Alcotest.(check (option string)) "message recovered" (Some "nope") error.E.message; + Alcotest.(check (option string)) "request_id recovered" (Some "req-s3") request_id + +let parse_error_struct_recovers_members_and_skips_request_id () = + (* A generated error-shape _of_xml uses Structure.scanSequence over 's + children, reading its own members and skipping the protocol metadata tags + (Type/Code). [parse_error_struct] positions the cursor inside and + skips the trailing sibling before . *) + let open Xml.Parse in + let r_top = ref None in + let r_foo = ref None in + let struct_parser i = + Structure.scanSequence i [ "TopLevel"; "Nested" ] (fun tag _ -> + match tag with + | "TopLevel" -> r_top := Some (Read.element i "TopLevel" ()) + | "Nested" -> + r_foo := Some (Read.sequence i "Nested" (fun i _ -> Read.element i "Foo" ()) ()) + | _ -> Read.skip_element i); + (!r_top, !r_foo) + in + let top, foo = + Result.get_ok (RestXml.parse_error_struct ~body:complex_error_body ~structParser:struct_parser) + in + Alcotest.(check (option string)) "TopLevel recovered" (Some "Top level") top; + Alcotest.(check (option string)) "Nested/Foo recovered" (Some "bar") foo + +let request_id_of_headers_finds_x_amzn_requestid () = + (* AWS restXml services put the request id in a response header. The name + varies and is case-insensitive; the first non-empty value wins. *) + let open RestXml in + Alcotest.(check (option string)) + "x-amzn-requestid recovered" (Some "req-from-header") + (request_id_of_headers [ ("x-amzn-requestid", "req-from-header") ]); + Alcotest.(check (option string)) + "lookup is case-insensitive" (Some "req-camel") + (request_id_of_headers [ ("X-Amzn-RequestId", "req-camel") ]); + Alcotest.(check (option string)) + "S3-style x-amz-request-id recovered" (Some "s3-req") + (request_id_of_headers [ ("x-amz-request-id", "s3-req") ]); + Alcotest.(check (option string)) + "empty value is skipped" None + (request_id_of_headers [ ("x-amzn-requestid", "") ]); + Alcotest.(check (option string)) + "absent header returns None" None + (request_id_of_headers [ ("content-type", "application/xml") ]); + Alcotest.(check (option string)) + "x-amzn-requestid wins over a later x-amz-request-id" (Some "first") + (request_id_of_headers [ ("x-amz-request-id", "second"); ("x-amzn-requestid", "first") ]) + +let request_id_prefer_header_over_body () = + (* On error the id is in both the header and the body ; the header + wins, with the body as a fallback when the header is absent. *) + let open RestXml in + Alcotest.(check (option string)) + "header wins when both present" (Some "hdr") + (request_id_prefer_header ~header:(Some "hdr") ~body:(Some "body")); + Alcotest.(check (option string)) + "body used when header absent" (Some "body") + (request_id_prefer_header ~header:None ~body:(Some "body")); + Alcotest.(check (option string)) + "None when both absent" None + (request_id_prefer_header ~header:None ~body:None); + Alcotest.(check (option string)) + "header wins even when body is None" (Some "hdr") + (request_id_prefer_header ~header:(Some "hdr") ~body:None) + +let () = + Alcotest.run "RestXml response parsing" + [ + ( "success_response", + [ + ( "parses root and returns deserializer value", + `Quick, + success_path_parses_root_and_returns_value ); + ] ); + ( "error_response", + [ + ( "recovers and skips trailing ", + `Quick, + error_path_recovers_message_and_skips_trailing_request_id ); + ( "noErrorWrapping envelope recovers direct children", + `Quick, + no_wrapping_envelope_recovers_direct_children ); + ( "parse_error_struct recovers members and skips metadata", + `Quick, + parse_error_struct_recovers_members_and_skips_request_id ); + ] ); + ( "request_id", + [ + ( "request_id_of_headers finds/case-insensitive/empty/absent", + `Quick, + request_id_of_headers_finds_x_amzn_requestid ); + ( "request_id_prefer_header prefers header over body", + `Quick, + request_id_prefer_header_over_body ); + ] ); + ] diff --git a/smaws_lib_test/restxml_serialize_test.ml b/smaws_lib_test/restxml_serialize_test.ml new file mode 100644 index 00000000..1319ee81 --- /dev/null +++ b/smaws_lib_test/restxml_serialize_test.ml @@ -0,0 +1,106 @@ +(** Phase 5 round-trip / parse-back checkpoint for the restXml request-body serializer. + + The generated [_to_xml] functions are exercised end-to-end by the Phase 8 conformance + suite, but the runtime helpers they build on ([Smaws_Lib.Protocols.RestXml.Serialize.*] for + float/timestamp text and [Smaws_Lib.Xml.Write] for namespaced/attributed/empty elements) are + pure and can be unit-tested here. This catches the Phase 5 failure modes the plan calls out — + [%.6f]-vs-[%g] truncation, [NaN]/[Infinity]/[-Infinity] sentinel strings, and empty-container + rendering — before Phase 8, so a serializer regression surfaces as a small focused failure + rather than a conformance-suite-wide red. *) + +module RestXml = Smaws_Lib.Protocols.RestXml +module Xml = Smaws_Lib.Xml +module Serialize = RestXml.Serialize + +let parse_text_inside ~root body = + (* Parse [body] and read the text content of its single [root] element, so a + written element round-trips through [Xml.Parse] and the recovered text + matches what the serializer produced. Returns [Error msg] on parse failure + so a test can [Result.get_ok]. *) + let open Xml.Parse in + run (fun () -> + let src = source_with_encoding ~src:body ~encoding:None in + Read.dtd src; + Read.element src root ()) + +let float_text_roundtrips_as_round_decimal () = + (* The serializer must emit a round-trip-safe decimal, not %g's 6-sig-fig + truncation: 1.234567890123456789 must not collapse to "1.23457". *) + let s = Serialize.float_field_to_string 1.234567890123456789 in + Alcotest.(check bool) + "round-trip preserves double precision" true + (Float.equal (Float.of_string s) 1.234567890123456789); + Alcotest.(check string) "common value uses short form" "5.5" (Serialize.float_field_to_string 5.5) + +let float_sentinel_strings () = + (* restXml serializes the non-numeric IEEE sentinels as their literal + strings (SimpleScalarProperties conformance). *) + Alcotest.(check string) "NaN" "NaN" (Serialize.float_field_to_string Float.nan); + Alcotest.(check string) "Infinity" "Infinity" (Serialize.float_field_to_string Float.infinity); + Alcotest.(check string) + "-Infinity" "-Infinity" + (Serialize.float_field_to_string Float.neg_infinity) + +let write_element_roundtrips_through_parse () = + (* A namespaced element with text round-trips: [Xml.Write] emits + [text] and [Xml.Parse.Read.sequence ~ns:"uri"] + recovers the text. This is the shape the restXml serializer uses for + [@xmlNamespace]-bearing members. *) + let w = Xml.Write.make () in + Xml.Write.element ~ns:"http://example.com" w "root" (fun w -> Xml.Write.text w "hello"); + let body = Xml.Write.to_string w in + Alcotest.(check string) + "namespaced element emitted" "hello" body; + let recovered = Result.get_ok (parse_text_inside ~root:"root" body) in + Alcotest.(check string) "text round-trips through parse" "hello" recovered + +let write_prefixed_namespace_element () = + (* A prefixed namespace element ([xmlns:baz="..." / baz:foo]) — the form + used when [@xmlNamespace] carries a [prefix] (XmlNamespaces conformance). *) + let w = Xml.Write.make ~ns_prefix:(function "http://baz.com" -> Some "baz" | _ -> None) () in + Xml.Write.element_with_ns w "http://baz.com" (Some "baz") "foo" (fun w -> Xml.Write.text w "Foo"); + let body = Xml.Write.to_string w in + Alcotest.(check string) + "prefixed namespace element emitted" "Foo" body + +let write_attributed_element () = + (* An element with an attribute (the form [member_value_expr] emits for a + structure member whose target carries an [@xmlAttribute] member). The + attribute name embeds its prefix via the member's [@xmlName] (e.g. + "xsi:someName"). *) + let w = Xml.Write.make () in + Xml.Write.element ~attrs:[ ("xsi:someName", "nestedAttrValue", None) ] w "Nested" (fun _ -> ()); + let body = Xml.Write.to_string w in + Alcotest.(check string) + "attributed element emitted" "" body + +let write_empty_container_element () = + (* Empty containers serialize as empty elements (not omitted) — + XmlEmptyLists / XmlEmptyMaps conformance. An empty list's wrapping + element is [] (the [List.iter] body writes nothing). *) + let w = Xml.Write.make () in + Xml.Write.element w "stringList" (fun w -> + List.iter + (fun (item : string) -> Xml.Write.element w "member" (fun w -> Xml.Write.text w item)) + []); + let body = Xml.Write.to_string w in + Alcotest.(check string) "empty container renders as empty element" "" body + +let () = + Alcotest.run "RestXml serialize" + [ + ( "float_text", + [ + Alcotest.test_case "float round-trips as round decimal" `Quick + float_text_roundtrips_as_round_decimal; + Alcotest.test_case "NaN/Infinity sentinel strings" `Quick float_sentinel_strings; + ] ); + ( "write_roundtrip", + [ + Alcotest.test_case "namespaced element round-trips through parse" `Quick + write_element_roundtrips_through_parse; + Alcotest.test_case "prefixed namespace element" `Quick write_prefixed_namespace_element; + Alcotest.test_case "attributed element" `Quick write_attributed_element; + Alcotest.test_case "empty container element" `Quick write_empty_container_element; + ] ); + ] diff --git a/smaws_lib_test/xml_parse_error_test.ml b/smaws_lib_test/xml_parse_error_test.ml new file mode 100644 index 00000000..0fbc9648 --- /dev/null +++ b/smaws_lib_test/xml_parse_error_test.ml @@ -0,0 +1,86 @@ +(* Verifies the XML deserialiser reports the failing element path when a leaf + value cannot be parsed. The path is built allocation-free by + [Read.sequence]/[Read.element_value] decorating [XmlDeserializeError] as it + unwinds (see Xml.ml). *) + +let parse body parser = + let open Smaws_Lib.Xml.Parse in + run (fun () -> + let src = source_with_encoding ~src:body ~encoding:None in + Read.dtd src; + parser src) + +let err_msg = function Smaws_Lib.Xml.Parse.XmlParseError m -> m + +let contains sub s = + (* stdlib has no String.contains_substring; a tiny suffix-safe scan. *) + let n = String.length s and m = String.length sub in + if m = 0 then true + else if m > n then false + else ( + let last = n - m in + let rec loop i = i <= last && (String.sub s i m = sub || loop (i + 1)) in + loop 0) + +let test_primitive_failure_reports_element () = + (* notafloat — the float converter + raises, [Read.element_value] decorates with "doubleValue", [Read.sequence] + with "root". *) + let body = "notafloat" in + let open Smaws_Lib.Xml.Parse in + let result = + parse body (fun src -> + Read.sequence src "root" + (fun i _ -> Read.element_value i "doubleValue" Primitive.float_of_string ()) + ()) + in + match result with + | Ok _ -> Alcotest.fail "expected a parse error" + | Error e -> + let msg = err_msg e in + Alcotest.(check bool) + "mentions invalid float at root/doubleValue" true + (contains "invalid float at root/doubleValue" msg) + +let test_int_failure_reports_element () = + let body = "xx" in + let open Smaws_Lib.Xml.Parse in + let result = + parse body (fun src -> + Read.sequence src "container" + (fun i _ -> Read.element_value i "count" Primitive.int_of_string ()) + ()) + in + match result with + | Ok _ -> Alcotest.fail "expected a parse error" + | Error e -> + let msg = err_msg e in + Alcotest.(check bool) + "mentions invalid integer at container/count" true + (contains "invalid integer at container/count" msg) + +let test_valid_parse_unaffected () = + let body = "3.14" in + let open Smaws_Lib.Xml.Parse in + let result = + parse body (fun src -> + Read.sequence src "root" + (fun i _ -> Read.element_value i "doubleValue" Primitive.float_of_string ()) + ()) + in + match result with + | Ok v -> Alcotest.(check (float 1e-9)) "parsed float" 3.14 v + | Error e -> Alcotest.fail (err_msg e) + +let () = + Alcotest.run "Xml.Parse error reporting" + [ + ( "errors", + [ + Alcotest.test_case "primitive failure reports element path" `Quick + test_primitive_failure_reports_element; + Alcotest.test_case "int failure reports element path" `Quick + test_int_failure_reports_element; + Alcotest.test_case "valid parse unaffected" `Quick test_valid_parse_unaffected; + ] ); + ] diff --git a/smaws_lib_test/xml_roundtrip_test.ml b/smaws_lib_test/xml_roundtrip_test.ml new file mode 100644 index 00000000..11d31864 --- /dev/null +++ b/smaws_lib_test/xml_roundtrip_test.ml @@ -0,0 +1,79 @@ +(* XML round-trip test: write XML, parse it back, verify structure *) + +let test_simple_element () = + let w = Smaws_Lib.Xml.Write.make () in + Smaws_Lib.Xml.Write.element w "root" (fun w -> Smaws_Lib.Xml.Write.text w "hello"); + let xml_str = Smaws_Lib.Xml.Write.to_string w in + let expected = "hello" in + Alcotest.(check string) "simple element" expected xml_str + +let test_nested_elements () = + let w = Smaws_Lib.Xml.Write.make () in + Smaws_Lib.Xml.Write.element w "parent" (fun w -> + Smaws_Lib.Xml.Write.element w "child" (fun w -> Smaws_Lib.Xml.Write.text w "value")); + let xml_str = Smaws_Lib.Xml.Write.to_string w in + let expected = "value" in + Alcotest.(check string) "nested elements" expected xml_str + +let test_empty_element () = + let w = Smaws_Lib.Xml.Write.make () in + Smaws_Lib.Xml.Write.element w "empty" (fun _ -> ()); + let xml_str = Smaws_Lib.Xml.Write.to_string w in + let expected = "" in + Alcotest.(check string) "empty element" expected xml_str + +let test_namespace () = + let w = Smaws_Lib.Xml.Write.make ~ns_prefix:(fun _ -> Some "") () in + Smaws_Lib.Xml.Write.element ~ns:"http://example.com" w "root" (fun w -> + Smaws_Lib.Xml.Write.text w "ns"); + let xml_str = Smaws_Lib.Xml.Write.to_string w in + let expected = "ns" in + Alcotest.(check string) "namespace" expected xml_str + +let test_namespace_with_prefix () = + let w = + Smaws_Lib.Xml.Write.make + ~ns_prefix:(function "http://example.com" -> Some "baz" | _ -> None) + () + in + Smaws_Lib.Xml.Write.element_with_ns w "http://example.com" (Some "baz") "root" (fun w -> + Smaws_Lib.Xml.Write.text w "prefixed"); + let xml_str = Smaws_Lib.Xml.Write.to_string w in + let expected = "prefixed" in + Alcotest.(check string) "namespace with prefix" expected xml_str + +let test_roundtrip () = + (* Write XML, then parse it back *) + let w = Smaws_Lib.Xml.Write.make () in + Smaws_Lib.Xml.Write.element w "Root" (fun w -> + Smaws_Lib.Xml.Write.element w "Member" (fun w -> Smaws_Lib.Xml.Write.text w "value1"); + Smaws_Lib.Xml.Write.element w "Member" (fun w -> Smaws_Lib.Xml.Write.text w "value2")); + let xml_str = Smaws_Lib.Xml.Write.to_string w in + let open Smaws_Lib.Xml.Parse in + let result = + run (fun () -> + let src = source_with_encoding ~src:xml_str ~encoding:None in + Read.dtd src; + Read.sequence src "Root" + (fun i _ -> + let members = Read.elements i "Member" () in + Alcotest.(check int) "two members" 2 (List.length members); + Alcotest.(check string) "first member" "value1" (List.nth members 0); + Alcotest.(check string) "second member" "value2" (List.nth members 1)) + ()) + in + match result with Ok () -> () | Error (XmlParseError msg) -> Alcotest.fail msg + +let () = + Alcotest.run "Xml.Write" + [ + ( "write", + [ + Alcotest.test_case "simple element" `Quick test_simple_element; + Alcotest.test_case "nested elements" `Quick test_nested_elements; + Alcotest.test_case "empty element" `Quick test_empty_element; + Alcotest.test_case "namespace" `Quick test_namespace; + Alcotest.test_case "namespace with prefix" `Quick test_namespace_with_prefix; + Alcotest.test_case "roundtrip" `Quick test_roundtrip; + ] ); + ] diff --git a/smaws_parse/Smithy.ml b/smaws_parse/Smithy.ml index 43618ff7..77ebf7ad 100644 --- a/smaws_parse/Smithy.ml +++ b/smaws_parse/Smithy.ml @@ -253,8 +253,10 @@ let parseTrait name (value : (jsonTreeRef, jsonParseError) Result.t) = | "smithy.api#httpError" -> value |> parseInteger >>| fun error -> Trait.HttpErrorTrait error | "smithy.api#title" -> value |> parseString >>| fun title -> Trait.ApiTitleTrait title | "smithy.api#xmlNamespace" -> - value |> parseObject |> field "uri" |> parseString >>| fun uri -> - Trait.ApiXmlNamespaceTrait uri + let obj = value |> parseObject in + let uri = obj |> field "uri" |> parseString in + let prefix = optional (obj |> field "prefix") |> mapOptional parseString in + map2 uri prefix (fun uri prefix -> Trait.ApiXmlNamespaceTrait { uri; prefix }) | "smithy.api#enum" -> value |> parseArray parseEnumNameValue >>| fun enumPairs -> Trait.EnumTrait enumPairs | "aws.auth#sigv4" -> @@ -267,8 +269,10 @@ let parseTrait name (value : (jsonTreeRef, jsonParseError) Result.t) = | "aws.protocols#restJson1" -> Ok Trait.AwsProtocolRestJson1Trait | "smithy.api#idempotencyToken" -> Ok Trait.IdempotencyTokenTrait | "smithy.api#httpLabel" -> Ok Trait.HttpLabelTrait - | "smithy.api#httpQuery" -> Ok Trait.HttpQueryTrait - | "smithy.api#httpHeader" -> Ok Trait.HttpHeaderTrait + | "smithy.api#httpQuery" -> + value |> parseString >>| fun queryName -> Trait.HttpQueryTrait queryName + | "smithy.api#httpHeader" -> + value |> parseString >>| fun headerName -> Trait.HttpHeaderTrait headerName | "smithy.api#retryable" -> Ok Trait.RetryableTrait | "smithy.api#timestampFormat" -> ( value |> parseString >>| function @@ -301,7 +305,25 @@ let parseTrait name (value : (jsonTreeRef, jsonParseError) Result.t) = | "smithy.api#deprecated" -> Ok Trait.DeprecatedTrait | "smithy.api#mediaType" -> parseString value >>| fun mediaType -> Trait.MediaTypeTrait mediaType - | "aws.protocols#restXml" -> Ok Trait.AwsProtocolRestXmlTrait + | "aws.protocols#restXml" -> + let obj = value |> parseObject in + let http = + optional (obj |> field "http") + |> mapOptional (parseArray parseString) + |> Result.map ~f:(Option.value ~default:[]) + in + let eventStreamHttp = + optional (obj |> field "eventStreamHttp") + |> mapOptional (parseArray parseString) + |> Result.map ~f:(Option.value ~default:[]) + in + let noErrorWrapping = + optional (obj |> field "noErrorWrapping") + |> mapOptional parseBool + |> Result.map ~f:(Option.value ~default:false) + in + map3 http eventStreamHttp noErrorWrapping (fun http eventStreamHttp noErrorWrapping -> + Trait.AwsProtocolRestXmlTrait { http; eventStreamHttp; noErrorWrapping }) | "aws.api#clientEndpointDiscovery" -> let obj = parseObject value in let operation = obj |> field "operation" |> parseString in @@ -311,6 +333,7 @@ let parseTrait name (value : (jsonTreeRef, jsonParseError) Result.t) = | "aws.protocols#ec2QueryName" -> value |> parseString >>| fun queryName -> Trait.AwsProtocolEc2QueryNameTrait queryName | "aws.protocols#ec2Query" -> Ok Trait.AwsProtocolEc2QueryTrait + | "smithy.api#internal" -> Ok Trait.InternalTrait | "smithy.api#httpResponseCode" -> Ok Trait.HttpResponseCodeTrait | "smithy.api#streaming" -> Ok Trait.StreamingTrait | "smithy.api#hostLabel" -> Ok Trait.HostLabelTrait @@ -329,11 +352,18 @@ let parseTrait name (value : (jsonTreeRef, jsonParseError) Result.t) = |> Result.map ~f:(fun s -> (key, s) :: entries)))) |> Result.map ~f:(fun x -> Trait.ExternalDocumentationTrait x) | "smithy.api#eventPayload" -> Ok Trait.EventPayloadTrait - | "smithy.api#http" -> Ok Trait.HttpTrait + | "smithy.api#http" -> + let obj = value |> parseObject in + let method_ = obj |> field "method" |> parseString in + let uri = obj |> field "uri" |> parseString in + let code = optional (obj |> field "code") |> mapOptional parseInteger in + map3 method_ uri code (fun method_ uri code -> Trait.HttpTrait { method_; uri; code }) | "smithy.api#idempotent" -> Ok Trait.IdempotentTrait | "smithy.api#readonly" -> Ok Trait.ReadonlyTrait | "smithy.waiters#waitable" -> Ok Trait.WaitableTrait - | "smithy.api#endpoint" -> Ok Trait.EndpointTrait + | "smithy.api#endpoint" -> + value |> parseObject |> field "hostPrefix" |> parseString >>| fun hostPrefix -> + Trait.EndpointTrait { hostPrefix } | "smithy.api#auth" -> Ok Trait.AuthTrait | "smithy.api#optionalAuth" -> Ok Trait.OptionalAuthTrait | "smithy.api#suppress" -> Ok Trait.SuppressTrait @@ -406,7 +436,12 @@ let parseMembers value = parseRecord parseMember value let parseStructureShape value = let members = value |> field "members" |> parseMembers in let traits = optional (value |> field "traits" |> parseRecord parseTrait) in - map2 members traits (fun members traits -> Shape.StructureShape { members; traits }) + let mixins = + value |> field "mixins" |> parseArray extractTargetSpec |> optional + |> Result.map ~f:(Option.value ~default:[]) + in + map3 members traits mixins (fun members traits mixins -> + Shape.StructureShape { members; traits; mixins }) let parseOperationShape shape = let inputTarget = optional (shape |> field "input" |> extractTargetSpec) in @@ -488,7 +523,12 @@ let parseMapShape shapeDict = let parseUnionShape value = let members = value |> field "members" |> parseMembers in let traits = optional (value |> field "traits" |> parseRecord parseTrait) in - map2 members traits (fun members traits -> Shape.UnionShape { members; traits }) + let mixins = + value |> field "mixins" |> parseArray extractTargetSpec |> optional + |> Result.map ~f:(Option.value ~default:[]) + in + map3 members traits mixins (fun members traits mixins -> + Shape.UnionShape { members; traits; mixins }) let parsePrimitive shapeDict = let traits_ = @@ -562,4 +602,83 @@ let parseShape name shape = { name; descriptor })) let parseShapes shapesModel = parseRecord parseShape shapesModel -let parseModel baseModel = baseModel |> parseObject |> field "shapes" |> parseShapes + +(* Mixin flattening — see [smithy_ast/Shape.ml.structureShapeDetails.mixins]. A + structure/union that lists other shapes under "mixins" inherits those shapes' + members (and the traits the mixin carries, except its own [@mixin] marker). + Direct members and traits take precedence over mixin members/traits. The + conformance restXml model uses mixins for every *Request / *Response pair + (the *InputOutput shape carries the members, the *Request/*Response shape + adds [@input]/[@output]), so without flattening every request body serializer + is a no-op. This is a parse-time pass so the rest of the pipeline (types, + builders, serializers, deserializers) sees the fully populated shapes. + + Cycles (A mixes in B which mixes in A) are guarded by a visited set; a + mixin that is not a structure/union or that is absent from the model is + skipped. *) +let resolve_mixins (shapes : Shape.t list) : Shape.t list = + let by_name = Hashtbl.Poly.create () in + List.iter shapes ~f:(fun shape -> Hashtbl.Poly.set by_name ~key:shape.Shape.name ~data:shape); + let is_mixin_marker = function + | Trait.UnspecifiedTrait (name, _) -> String.equal name "smithy.api#mixin" + | _ -> false + in + let rec effective_members_and_traits ~visited name : Shape.member list * Trait.t list = + match Hashtbl.Poly.find by_name name with + | None -> ([], []) + | Some { descriptor = Shape.StructureShape s | Shape.UnionShape s; _ } -> + let visited = name :: visited in + (* Fold in the direct members/traits first (direct wins), then each + mixin's transitively-resolved members/traits. *) + let own_members : Shape.member list = s.members in + let own_traits : Trait.t list = Option.value ~default:[] s.traits in + let rec fold_mixins (acc_members : Shape.member list) (acc_traits : Trait.t list) lst : + Shape.member list * Trait.t list = + match lst with + | [] -> (acc_members, acc_traits) + | m :: rest when Stdlib.List.mem m visited -> fold_mixins acc_members acc_traits rest + | m :: rest -> + let m_members, m_traits = effective_members_and_traits ~visited m in + let m_traits = List.filter m_traits ~f:(Fn.non is_mixin_marker) in + let acc_members = + List.fold m_members + ~f:(fun acc (mem : Shape.member) -> + if + List.exists acc ~f:(fun existing -> + String.equal existing.Shape.name mem.Shape.name) + then acc + else acc @ [ mem ]) + ~init:acc_members + in + let acc_traits = + List.fold m_traits + ~f:(fun acc (t : Trait.t) -> + if + List.exists acc ~f:(fun existing -> + String.equal (Trait.type_key existing) (Trait.type_key t)) + then acc + else acc @ [ t ]) + ~init:acc_traits + in + fold_mixins acc_members acc_traits rest + in + fold_mixins own_members own_traits s.mixins + | Some _ -> ([], []) + in + shapes + |> List.map ~f:(fun shape -> + match shape.Shape.descriptor with + | (Shape.StructureShape s | Shape.UnionShape s) when not (List.is_empty s.mixins) -> + let members, traits = effective_members_and_traits ~visited:[] shape.Shape.name in + let descriptor = + match shape.Shape.descriptor with + | Shape.StructureShape _ -> + Shape.StructureShape { s with members; traits = Some traits } + | Shape.UnionShape _ -> Shape.UnionShape { s with members; traits = Some traits } + | _ -> shape.Shape.descriptor (* unreachable *) + in + { shape with Shape.descriptor } + | _ -> shape) + +let parseModel baseModel = + baseModel |> parseObject |> field "shapes" |> parseShapes |> Result.map ~f:resolve_mixins diff --git a/smithy_ast/Shape.ml b/smithy_ast/Shape.ml index 2e4fe20d..60c210a9 100644 --- a/smithy_ast/Shape.ml +++ b/smithy_ast/Shape.ml @@ -3,7 +3,14 @@ open Base type member = { name : string; target : string; traits : Trait.t list option } [@@deriving show, equal] -type structureShapeDetails = { traits : Trait.t list option; members : member list } +type structureShapeDetails = { + traits : Trait.t list option; + members : member list; + (* Shapes mixed into this structure/union (transitively flattened by + [Smaws_parse.Smithy.resolve_mixins] before codegen consumes the model). + Direct members and traits take precedence over mixin members/traits. *) + mixins : string list; +} [@@deriving show, equal] type setShapeDetails = { traits : Trait.t list option; target : string } [@@deriving show, equal] diff --git a/smithy_ast/Trait.ml b/smithy_ast/Trait.ml index f47f61e1..0a586bfd 100644 --- a/smithy_ast/Trait.ml +++ b/smithy_ast/Trait.ml @@ -20,6 +20,12 @@ type arnReferenceDetails = { [@@deriving show, equal] type reference = { resource : string; service : string option } [@@deriving show, equal] +type httpTrait = { method_ : string; uri : string; code : int option } [@@deriving show, equal] +type endpointTrait = { hostPrefix : string } [@@deriving show, equal] +type xmlNamespaceConfig = { uri : string; prefix : string option } [@@deriving show, equal] + +type restXmlConfig = { http : string list; eventStreamHttp : string list; noErrorWrapping : bool } +[@@deriving show, equal] type clientEndpointDiscoveryDetails = { operation : string; error : string } [@@deriving show, equal] @@ -87,7 +93,7 @@ type httpResponseTest = { type t = | ApiTitleTrait of string - | ApiXmlNamespaceTrait of string + | ApiXmlNamespaceTrait of xmlNamespaceConfig | AuthTrait | AwsApiArnReferenceTrait of arnReferenceDetails | AwsApiClientDiscoveredEndpointTrait @@ -111,14 +117,14 @@ type t = | AwsProtocolEc2QueryNameTrait of string | AwsProtocolEc2QueryTrait | AwsProtocolRestJson1Trait - | AwsProtocolRestXmlTrait + | AwsProtocolRestXmlTrait of restXmlConfig | AwsProtocolsHttpChecksumTrait | BoxTrait | CorsTrait | DefaultTrait | DeprecatedTrait | DocumentationTrait of string - | EndpointTrait + | EndpointTrait of endpointTrait | EnumTrait of enumPair list | EnumValueTrait of [ `String of string | `Int of int ] | ErrorTrait of errorTraitType @@ -128,17 +134,18 @@ type t = | HostLabelTrait | HttpChecksumRequiredTrait | HttpErrorTrait of int - | HttpHeaderTrait + | HttpHeaderTrait of string | HttpLabelTrait | HttpPayloadTrait | HttpPrefixHeadersTrait of string | HttpQueryParams - | HttpQueryTrait + | HttpQueryTrait of string | HttpResponseCodeTrait - | HttpTrait + | HttpTrait of httpTrait | IdempotencyTokenTrait | IdempotentTrait | InputTrait + | InternalTrait | JsonNameTrait of string | LengthTrait of int option * int option | MediaTypeTrait of string @@ -189,6 +196,106 @@ let isAwsApiServiceTrait trait = match trait with ServiceTrait _ -> true | _ -> let isTimestampFormatTrait trait = match trait with TimestampFormatTrait _ -> true | _ -> false let isIdempotencyTokenTrait trait = match trait with IdempotencyTokenTrait -> true | _ -> false +(* A stable per-constructor key used by [Smaws_parse.Smithy.resolve_mixins] to + dedup mixin traits against a consuming shape's own traits (own wins). Two + traits with the same [type_key] occupy the same "slot", so a mixin's + [@xmlNamespace] is dropped when the consuming shape already declares one. + Nullary constructors share a single key; [UnspecifiedTrait] uses the trait + id (e.g. "smithy.api#mixin") so two unspecified traits with different ids are + distinct slots. *) +let type_key (trait : t) : string = + match trait with + | ApiTitleTrait _ -> "ApiTitleTrait" + | ApiXmlNamespaceTrait _ -> "ApiXmlNamespaceTrait" + | AuthTrait -> "AuthTrait" + | AwsApiArnReferenceTrait _ -> "AwsApiArnReferenceTrait" + | AwsApiClientDiscoveredEndpointTrait -> "AwsApiClientDiscoveredEndpointTrait" + | AwsApiClientEndpointDiscoveryTrait _ -> "AwsApiClientEndpointDiscoveryTrait" + | AwsApiControlPlaneTrait -> "AwsApiControlPlaneTrait" + | AwsApiDataPlaneTrait -> "AwsApiDataPlaneTrait" + | AwsAuthSigV4Trait _ -> "AwsAuthSigV4Trait" + | AwsAuthUnsignedPayloadTrait -> "AwsAuthUnsignedPayloadTrait" + | AwsCloudFormationCfnExcludePropertyTrait -> "AwsCloudFormationCfnExcludePropertyTrait" + | AwsCloudFormationCfnMutabilityTrait -> "AwsCloudFormationCfnMutabilityTrait" + | AwsCustomizationsS3UnwrappedXmlOutputTrait -> "AwsCustomizationsS3UnwrappedXmlOutputTrait" + | AwsIamActionPermissionDescriptionTrait -> "AwsIamActionPermissionDescriptionTrait" + | AwsIamConditionKeysTrait -> "AwsIamConditionKeysTrait" + | AwsIamDefineConditionKeysTrait -> "AwsIamDefineConditionKeysTrait" + | AwsIamRequiredActionsTrait -> "AwsIamRequiredActionsTrait" + | AwsProtocolAwsJson1_0Trait -> "AwsProtocolAwsJson1_0Trait" + | AwsProtocolAwsJson1_1Trait -> "AwsProtocolAwsJson1_1Trait" + | AwsProtocolAwsQueryCompatibleTrait -> "AwsProtocolAwsQueryCompatibleTrait" + | AwsProtocolAwsQueryErrorTrait _ -> "AwsProtocolAwsQueryErrorTrait" + | AwsProtocolAwsQueryTrait -> "AwsProtocolAwsQueryTrait" + | AwsProtocolEc2QueryNameTrait _ -> "AwsProtocolEc2QueryNameTrait" + | AwsProtocolEc2QueryTrait -> "AwsProtocolEc2QueryTrait" + | AwsProtocolRestJson1Trait -> "AwsProtocolRestJson1Trait" + | AwsProtocolRestXmlTrait _ -> "AwsProtocolRestXmlTrait" + | AwsProtocolsHttpChecksumTrait -> "AwsProtocolsHttpChecksumTrait" + | BoxTrait -> "BoxTrait" + | CorsTrait -> "CorsTrait" + | DefaultTrait -> "DefaultTrait" + | DeprecatedTrait -> "DeprecatedTrait" + | DocumentationTrait _ -> "DocumentationTrait" + | EndpointTrait _ -> "EndpointTrait" + | EnumTrait _ -> "EnumTrait" + | EnumValueTrait _ -> "EnumValueTrait" + | ErrorTrait _ -> "ErrorTrait" + | EventPayloadTrait -> "EventPayloadTrait" + | ExamplesTrait -> "ExamplesTrait" + | ExternalDocumentationTrait _ -> "ExternalDocumentationTrait" + | HostLabelTrait -> "HostLabelTrait" + | HttpChecksumRequiredTrait -> "HttpChecksumRequiredTrait" + | HttpErrorTrait _ -> "HttpErrorTrait" + | HttpHeaderTrait _ -> "HttpHeaderTrait" + | HttpLabelTrait -> "HttpLabelTrait" + | HttpPayloadTrait -> "HttpPayloadTrait" + | HttpPrefixHeadersTrait _ -> "HttpPrefixHeadersTrait" + | HttpQueryParams -> "HttpQueryParams" + | HttpQueryTrait _ -> "HttpQueryTrait" + | HttpResponseCodeTrait -> "HttpResponseCodeTrait" + | HttpTrait _ -> "HttpTrait" + | IdempotencyTokenTrait -> "IdempotencyTokenTrait" + | IdempotentTrait -> "IdempotentTrait" + | InputTrait -> "InputTrait" + | InternalTrait -> "InternalTrait" + | JsonNameTrait _ -> "JsonNameTrait" + | LengthTrait _ -> "LengthTrait" + | MediaTypeTrait _ -> "MediaTypeTrait" + | OptionalAuthTrait -> "OptionalAuthTrait" + | OutputTrait -> "OutputTrait" + | PaginatedTrait -> "PaginatedTrait" + | PatternTrait _ -> "PatternTrait" + | RangeTrait _ -> "RangeTrait" + | ReadonlyTrait -> "ReadonlyTrait" + | ReferencesTrait _ -> "ReferencesTrait" + | RequiredTrait -> "RequiredTrait" + | RequiresLengthTrait -> "RequiresLengthTrait" + | RequestCompressionTrait _ -> "RequestCompressionTrait" + | RetryableTrait -> "RetryableTrait" + | RulesEndpointRuleSetTrait -> "RulesEndpointRuleSetTrait" + | RulesEndpointTests -> "RulesEndpointTests" + | RulesContextParam _ -> "RulesContextParam" + | RulesStaticContextParams _ -> "RulesStaticContextParams" + | RulesOperationContextParams _ -> "RulesOperationContextParams" + | SensitiveTrait -> "SensitiveTrait" + | ServiceTrait _ -> "ServiceTrait" + | SparseTrait -> "SparseTrait" + | StreamingTrait -> "StreamingTrait" + | SuppressTrait -> "SuppressTrait" + | TagsTrait _ -> "TagsTrait" + | TimestampFormatTrait _ -> "TimestampFormatTrait" + | TestSmokeTests -> "TestSmokeTests" + | TestHttpResponseTests _ -> "TestHttpResponseTests" + | WaitableTrait -> "WaitableTrait" + | XmlAttributeTrait -> "XmlAttributeTrait" + | XmlFlattenedTrait -> "XmlFlattenedTrait" + | XmlNameTrait _ -> "XmlNameTrait" + | PrivateTrait -> "PrivateTrait" + | TestHttpRequestTests _ -> "TestHttpRequestTests" + | IdRefTrait _ -> "IdRefTrait" + | UnspecifiedTrait (name, _) -> "UnspecifiedTrait(" ^ name ^ ")" + let hasTrait traitsOption traitTest = Option.value ~default:false (Option.map