restXml protocol: reviewed implementation plan

.gitignore

@@ -2,3 +2,4 @@ node_modules
 _opam
 _build
 _esy
+.pi/

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

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)

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"

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))

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]

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) ->

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