fed-sx-types Phase 4: object-schema validation stage in pipeline

pipeline:apply_object_schema/2 (+ stage_object_schema/1 factory) — the
object-schema stage between activity-type validation and the kernel
append (plans/fed-sx-host-types.md step 4). When an inbound activity's
:object declares a refinement type ({type, TypeName}), resolve it
(Cfg type_index: TypeName -> TypeCid; then peer_types:lookup_or_fetch/2,
a local hit or a wire fetch) and apply the record's refinement schema
to the object's :field_values, rejecting on schema-fail with
{error, {validation_failed, object_schema}}.

The schema is either a 1-arity Erlang predicate (substrate stand-in,
locally stored) or a term_codec-safe {required, [Field,...]} constraint
(so a wire-fetched record validates too). Default
strict_object_schema = false: an unresolvable type is let through (the
skip is where a validation_skipped log belongs); strict rejects.
Objects with no declared type, and names absent from the local index,
are skipped (open-world).

Test: next/tests/object_schema.sh (15) — local hit, wire fetch, fetch
failure strict/non-strict, no peer_types, untyped object, undeclared
name, fun + data schema forms, no-schema record, stage composition.

No regression: pipeline_signature, pipeline_driver green. Plan doc
steps 1-4 marked done.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

next/kernel/pipeline.erl

@@ -6,7 +6,8 @@
          stage_envelope/1,
          stage_signature/1, stage_signature/2,
          stage_replay/1, stage_replay/2,
-         stage_schema/1, stage_schema/2]).
+         stage_schema/1, stage_schema/2,
+         apply_object_schema/2, stage_object_schema/1]).
 
 %% Validation pipeline per design §14.
 %%
@@ -165,3 +166,138 @@ check_object_schema(Activity, SchemaFn) ->
 
 stage_schema(SchemaLookup) ->
     fun (Activity) -> stage_schema(Activity, SchemaLookup) end.
+
+%% ── host-type fed Step 4: object-schema validation stage ────────
+%%
+%% apply_object_schema/2 — when an inbound activity's :object declares
+%% a refinement type ({type, TypeName} on the object), resolve that
+%% type's record and apply its refinement schema to the object's
+%% :field_values. Sits between activity-type (stage_schema) validation
+%% and the kernel append; rejects the activity on schema-fail.
+%%
+%% Resolution mirrors the design note: TypeName -> TypeCid via Cfg's
+%% `type_index` ([{TypeName, TypeCid}, ...], the local Define-name
+%% index), then TypeCid -> TypeRecord via peer_types:lookup_or_fetch/2
+%% (a local cache hit, or a wire fetch through the Cfg type_fetch_fn).
+%%
+%% Outcomes:
+%%   object has no {type, _}             -> ok   (no schema applies)
+%%   TypeName not in type_index          -> ok   (undeclared type;
+%%                                                 open-world default)
+%%   record resolved, schema passes      -> ok
+%%   record resolved, schema fails       -> {error, {validation_failed,
+%%                                                    object_schema}}
+%%   record unresolvable (cache miss +   -> strict_object_schema:
+%%     fetch failure / no peer_types)        true  -> {error, ...}
+%%                                            false -> ok (skipped)
+%%
+%% Default strict_object_schema = false: a node only blocks on an
+%% unresolvable type when it opts into airtight validation via Cfg
+%% {strict_object_schema, true}. The non-strict skip is where a
+%% `validation_skipped` log entry belongs (left to the caller's logger
+%% so this stage keeps the ok | {error, _} contract run_stages wants).
+%%
+%% A TypeRecord's refinement schema is either a 1-arity Erlang
+%% predicate over the field-values (the substrate stand-in, for
+%% locally-defined types) or a data constraint {required, [Field, ...]}
+%% (term_codec-safe, so a wire-fetched TypeRecord can still validate).
+
+apply_object_schema(Activity, Cfg) ->
+    case object_type_name(Activity) of
+        none -> ok;
+        {ok, TypeName} ->
+            case type_cid_for(TypeName, Cfg) of
+                none -> ok;
+                {ok, TypeCid} ->
+                    case resolve_type_record(TypeCid, Cfg) of
+                        {ok, TR}   -> check_object_against(Activity, TR);
+                        {error, _} -> on_unresolved_type(Cfg)
+                    end
+            end
+    end.
+
+stage_object_schema(Cfg) ->
+    fun (Activity) -> apply_object_schema(Activity, Cfg) end.
+
+object_type_name(Activity) ->
+    case envelope:get_field(object, Activity) of
+        {ok, Obj} when is_list(Obj) ->
+            case envelope:get_field(type, Obj) of
+                {ok, T} -> {ok, T};
+                _       -> none
+            end;
+        _ -> none
+    end.
+
+object_field_values(Activity) ->
+    case envelope:get_field(object, Activity) of
+        {ok, Obj} when is_list(Obj) ->
+            case envelope:get_field(field_values, Obj) of
+                {ok, FV} -> FV;
+                _        -> []
+            end;
+        _ -> []
+    end.
+
+type_cid_for(TypeName, Cfg) ->
+    case stage_field(type_index, Cfg) of
+        nil -> none;
+        Index ->
+            case find_keyed(TypeName, Index) of
+                {ok, Cid} -> {ok, Cid};
+                _         -> none
+            end
+    end.
+
+resolve_type_record(TypeCid, Cfg) ->
+    case stage_field(peer_types, Cfg) of
+        nil -> {error, no_peer_types};
+        _ ->
+            case erlang:whereis(peer_types) of
+                undefined -> {error, peer_types_down};
+                _         -> peer_types:lookup_or_fetch(TypeCid, Cfg)
+            end
+    end.
+
+on_unresolved_type(Cfg) ->
+    case stage_field(strict_object_schema, Cfg) of
+        true -> {error, {validation_failed, object_schema}};
+        _    -> ok
+    end.
+
+check_object_against(Activity, TR) ->
+    case stage_field(refinement_schema, TR) of
+        nil    -> ok;
+        Schema -> apply_refinement(Schema, object_field_values(Activity))
+    end.
+
+apply_refinement(Fn, FieldValues) when is_function(Fn, 1) ->
+    case Fn(FieldValues) of
+        true -> ok;
+        _    -> {error, {validation_failed, object_schema}}
+    end;
+apply_refinement({required, Fields}, FieldValues) ->
+    case all_present(Fields, FieldValues) of
+        true  -> ok;
+        false -> {error, {validation_failed, object_schema}}
+    end;
+apply_refinement(_, _) -> ok.
+
+all_present([], _) -> true;
+all_present([F | Rest], FV) ->
+    case has_key(F, FV) of
+        true  -> all_present(Rest, FV);
+        false -> false
+    end.
+
+has_key(_, []) -> false;
+has_key(K, [{K, _} | _]) -> true;
+has_key(K, [_ | Rest]) -> has_key(K, Rest).
+
+stage_field(K, [{K, V} | _]) -> V;
+stage_field(K, [_ | Rest]) -> stage_field(K, Rest);
+stage_field(_, []) -> nil.
+
+find_keyed(_, []) -> {error, not_found};
+find_keyed(K, [{K, V} | _]) -> {ok, V};
+find_keyed(K, [_ | Rest]) -> find_keyed(K, Rest).