;; identity/federation.sx — federated identity: peer-asserted subjects,
;; advisory and trust-gated.
;;
;; A peer instance can assert \"this remote subject authenticated with me\".
;; We accept such an assertion ONLY from a peer we explicitly trust
;; (trust-gated); an assertion from an unknown peer is {error, untrusted},
;; never silently honoured. Even when accepted, the resulting identity is
;; ADVISORY: it is flagged peer_asserted with its origin peer, never
;; promoted to local authority. Downstream (acl) decides how much a
;; peer-asserted identity may do; identity only records who asserted it.
;;
;; Cross-instance subject mapping turns a (Peer, RemoteSubject) pair into a
;; stable local subject. By default it is namespaced — {federated, Peer,
;; RemoteSubject} — so two peers' \"alice\" never collide; an explicit map
;; can alias a remote subject to a local one.
;;
;;   trust(F, Peer) / untrust(F, Peer) / trusted(F, Peer)
;;   map(F, Peer, Remote, Local)            -> ok    (optional alias)
;;   resolve(F, Peer, Remote)               -> {ok, LocalSubject}
;;   assert_id(F, Peer, Remote)             -> {ok, LocalSubject}
;;                                           | {error, untrusted}
;;   provenance(F, LocalSubject)            -> {peer_asserted, Peer} | {local}

(define
  identity-federation-source
  "-module(identity_federation).\n\n   start() ->\n     spawn(fun () -> loop([], [], []) end).\n\n   trust(F, Peer) ->\n     F ! {trust, Peer, self()},\n     receive {fed_reply, R} -> R end.\n\n   untrust(F, Peer) ->\n     F ! {untrust, Peer, self()},\n     receive {fed_reply, R} -> R end.\n\n   trusted(F, Peer) ->\n     F ! {trusted, Peer, self()},\n     receive {fed_reply, R} -> R end.\n\n   map(F, Peer, Remote, Local) ->\n     F ! {map, Peer, Remote, Local, self()},\n     receive {fed_reply, R} -> R end.\n\n   resolve(F, Peer, Remote) ->\n     F ! {resolve, Peer, Remote, self()},\n     receive {fed_reply, R} -> R end.\n\n   assert_id(F, Peer, Remote) ->\n     F ! {assert_id, Peer, Remote, self()},\n     receive {fed_reply, R} -> R end.\n\n   provenance(F, Local) ->\n     F ! {provenance, Local, self()},\n     receive {fed_reply, R} -> R end.\n\n   loop(Trusted, Maps, Asserted) ->\n     receive\n       {trust, Peer, From} ->\n         From ! {fed_reply, ok},\n         loop(add_unique(Peer, Trusted), Maps, Asserted);\n       {untrust, Peer, From} ->\n         From ! {fed_reply, ok},\n         loop(drop(Peer, Trusted), Maps, Asserted);\n       {trusted, Peer, From} ->\n         From ! {fed_reply, member(Peer, Trusted)},\n         loop(Trusted, Maps, Asserted);\n       {map, Peer, Remote, Local, From} ->\n         From ! {fed_reply, ok},\n         loop(Trusted, [{{Peer, Remote}, Local} | drop_map(Peer, Remote, Maps)], Asserted);\n       {resolve, Peer, Remote, From} ->\n         From ! {fed_reply, {ok, resolve_local(Peer, Remote, Maps)}},\n         loop(Trusted, Maps, Asserted);\n       {assert_id, Peer, Remote, From} ->\n         case member(Peer, Trusted) of\n           false ->\n             From ! {fed_reply, {error, untrusted}},\n             loop(Trusted, Maps, Asserted);\n           true ->\n             Local = resolve_local(Peer, Remote, Maps),\n             From ! {fed_reply, {ok, Local}},\n             loop(Trusted, Maps, [{Local, Peer} | drop_assert(Local, Asserted)])\n         end;\n       {provenance, Local, From} ->\n         case find_assert(Local, Asserted) of\n           {ok, Peer} -> From ! {fed_reply, {peer_asserted, Peer}};\n           none -> From ! {fed_reply, {local}}\n         end,\n         loop(Trusted, Maps, Asserted);\n       {stop, From} ->\n         From ! {fed_reply, ok}\n     end.\n\n   resolve_local(Peer, Remote, Maps) ->\n     case find_map(Peer, Remote, Maps) of\n       {ok, Local} -> Local;\n       none -> {federated, Peer, Remote}\n     end.\n\n   find_map(_, _, []) -> none;\n   find_map(Peer, Remote, [{{P, R}, Local} | Rest]) ->\n     case same(P, Peer, R, Remote) of\n       true -> {ok, Local};\n       false -> find_map(Peer, Remote, Rest)\n     end.\n\n   drop_map(_, _, []) -> [];\n   drop_map(Peer, Remote, [{{P, R}, Local} | Rest]) ->\n     case same(P, Peer, R, Remote) of\n       true -> drop_map(Peer, Remote, Rest);\n       false -> [{{P, R}, Local} | drop_map(Peer, Remote, Rest)]\n     end.\n\n   same(P, Peer, R, Remote) ->\n     case P =:= Peer of\n       true -> R =:= Remote;\n       false -> false\n     end.\n\n   find_assert(_, []) -> none;\n   find_assert(Local, [{L, Peer} | Rest]) ->\n     case L =:= Local of\n       true -> {ok, Peer};\n       false -> find_assert(Local, Rest)\n     end.\n\n   drop_assert(_, []) -> [];\n   drop_assert(Local, [{L, Peer} | Rest]) ->\n     case L =:= Local of\n       true -> drop_assert(Local, Rest);\n       false -> [{L, Peer} | drop_assert(Local, Rest)]\n     end.\n\n   add_unique(X, Xs) ->\n     case member(X, Xs) of\n       true -> Xs;\n       false -> [X | Xs]\n     end.\n\n   drop(_, []) -> [];\n   drop(X, [Y | Rest]) ->\n     case X =:= Y of\n       true -> drop(X, Rest);\n       false -> [Y | drop(X, Rest)]\n     end.\n\n   member(_, []) -> false;\n   member(X, [Y | Rest]) ->\n     case X =:= Y of\n       true -> true;\n       false -> member(X, Rest)\n     end.")

(define
  identity-load-federation!
  (fn () (erlang-load-module identity-federation-source)))