1 files changed, 173 insertions, 0 deletions
diff --git a/apps/dreki/src/dreki_urn.erl b/apps/dreki/src/dreki_urn.erl
new file mode 100644
index 0000000..2da6c69
--- /dev/null
+++ b/apps/dreki/src/dreki_urn.erl
@@ -0,0 +1,173 @@
+-module(dreki_urn).
+-define(PT, dreki_urn).
+
+-export([nid/0, start/0, namespaces/0, namespace/1, register_namespace/3, expand/1, to_urn/1]).
+
+-callback expand_urn_resource_rest(namespace(), expanded_resource(), resource_part(), NsEnv :: #{}) -> {ok, expanded_resource()} | {error, any()}.
+
+-type urn() :: binary().
+-type namespace() :: binary().
+-type directory() :: binary().
+-type location_part() :: binary().
+-type resource_part() :: binary().
+
+nid() -> <<"dreki">>.
+
+-spec start() -> ok.
+start() ->
+  persistent_term:put(?PT, #{}).
+
+-spec namespaces() -> #{namespace() := {module(), #{}}}.
+namespaces() ->
+  persistent_term:get(?PT).
+
+-spec namespace(namespace()) -> {module(), #{}} | undefined.
+namespace(NS) ->
+  maps:get(NS, namespaces(), undefined).
+
+-spec register_namespace(namespace(), module(), #{}) -> ok | {error, {namespace_already_registered, namespace(), module()}}.
+register_namespace(Namespace, Mod, Env) ->
+  Map = persistent_term:get(?PT),
+  case maps:get(Namespace, Map, {Mod, undefined}) of
+    {Mod, Env} -> ok;
+    {Mod, _} -> persistent_term:put(?PT, maps:put(Namespace, {Mod, Env}, Map));
+    {OtherMod, _} -> {error, {namespace_already_registered, Namespace, OtherMod}}
+  end.
+
+-type expand_error() :: not_dreki_urn.
+
+-spec expand(urn()) -> {ok, expanded()} | {error, expand_error()}.
+expand(U = <<"dreki:", _/binary>>) ->
+  expand(U, dreki_world:root_path());
+expand(U = <<"urn:dreki:", _/binary>>) ->
+  expand(U, dreki_world:root_path());
+expand(_Invalid) ->
+  {error, not_dreki_urn}.
+%% Remove root
+%%expand(U, Root) ->
+%%  expand(U, Root, Rest).
+%%expand(U, Root) ->
+%%  {error, #{message => <<"URI outside of domain">>, uri => U, domain => Root}}.
+%% Extract hierarchy
+expand(U, Root) ->
+  {Hier, Res} = case binary:split(U, <<"::">>) of
+    [H, R] -> {H, R};
+    [H] -> {H, undefined}
+  end,
+  % XXX: Do we really need to store theses paths ? o_o
+  case dreki_world:get_path(Hier) of
+    {ok, Thing} -> expand(U, Root, Hier, Res, Thing);
+    Error -> Error
+  end.
+
+-type expanded() :: #{
+  urn := urn(),
+  world := binary(),
+  location := location_part(),
+  kind := region | node | [],
+  resource => expanded_resource(),
+  query => #{},
+  fragment => binary()
+}.
+
+-type expanded_resource() :: #{
+  resource => expanded_resource_resource(),
+  directory => expanded_resource_directory(),
+  namespace => namespace(),
+  lookup => expanded_resource_lookup()
+}.
+
+-type expanded_resource_lookup() :: #{
+  namespace => namespace(),
+  id => binary()
+}.
+
+-type expanded_resource_resource() :: #{
+  namespace => namespace(),
+  directory => binary(),
+  id => binary()
+}.
+
+-type expanded_resource_directory() :: #{
+  namespace => namespace(),
+  directory => directory()
+}.
+
+expand(Urn, Root, Path, ResPart, Thing) ->
+  Kind = case maps:keys(Thing) of
+    [K] -> K;
+    Ks -> Ks
+  end,
+  XUrn = #{world => Root, kind => Kind, domain => Root, location => Path, urn => Urn},
+  case expand_resource(ResPart) of
+    {ok, Resource} ->
+      {ok, XUrn#{resource => Resource}};
+    {error, invalid_resource} ->
+      {error, #{message => <<"Invalid resource">>, uri => Urn, resource => ResPart}};
+    {error, invalid_namespace, NS} ->
+      {error, #{message => <<"Invalid namespace">>, uri => Urn, namespace => NS}}
+  end.
+
+expand_resource(undefined) ->
+  {ok, undefined};
+expand_resource(Path) ->
+  {NS, Rest} = case binary:split(Path, <<":">>) of
+    [N, R] -> {N, R};
+    [N] -> {N, <<>>}
+  end,
+  case namespace(NS) of
+    NSS = {_, _} -> expand_resource(NS, Rest, NSS);
+    undefined -> {error, invalid_namespace, NS}
+  end.
+
+expand_resource(NS, FullResPart, {NSMod, NSEnv}) ->
+  {ResPart, Rest} = case binary:split(FullResPart, <<"::">>) of
+    [R] -> {R, undefined};
+    [R, Rs] -> {R, Rs}
+  end,
+  case expand_resource_part(NS, ResPart) of
+    Error = {error, _} -> Error;
+    {ok, Res} -> expand_resource_rest(NS, NSMod, NSEnv, Res, Rest)
+  end.
+
+expand_resource_part(NS, ResPart) ->
+  case binary:split(ResPart, <<":">>, [global]) of
+    [<<>>, <<>>] -> {error, invalid_resource};
+    [<<>>, Id] -> {ok, #{lookup => #{namespace => NS, id => Id}}};
+    [<<>>] -> {ok, #{namespace => NS}};
+    [S] -> {ok, #{directory => #{namespace => NS, directory => S}}};
+    [S, <<>>] -> {ok, #{directory => #{namespace => NS, directory => S}}};
+    [S, Id] -> {ok, #{resource => #{namespace => NS, directory => S, id => Id}}};
+    [] -> {ok, #{namespace => NS}};
+    R -> {error, {invalid_address, {ResPart, R}}}
+  end.
+
+expand_resource_rest(_, _, _, Resource, undefined) ->
+    {ok, Resource};
+expand_resource_rest(NS, NSMod, NSEnv, Resource, Part) ->
+    case NSMod:expand_urn_resource_rest(NS, Resource, Part, NSEnv) of
+      {ok, Data} -> {ok, Data};
+      error -> {error, {invalid_part, {NS, Part}}}
+    end.
+
+to_urn(XUrn = #{location := Location}) ->
+    case resource_to_urn_part(XUrn) of
+      Binary when is_binary(Binary) -> <<Location/binary, "::", Binary/binary>>;
+      undefined -> Location
+    end.
+
+resource_to_urn_part(#{resource := Res0 = #{schemas := all}}) ->
+    Res = maps:remove(schemas, Res0),
+    ResP = resource_to_urn_part(Res),
+    <<ResP/binary, "::", "schemas">>;
+resource_to_urn_part(#{resource := Res0 = #{schema := #{schema := Schema, version := Vers}}}) ->
+    Res = maps:remove(schema, Res0),
+    ResP = resource_to_urn_part(Res),
+    <<ResP/binary, "::", "schemas:", Schema/binary, ":", Vers/binary>>;
+resource_to_urn_part(#{resource := #{namespace := NS}}) ->
+    NS;
+resource_to_urn_part(#{resource := #{directory := #{directory := Dir, namespace := NS}}}) ->
+    <<NS/binary, ":", Dir/binary>>;
+resource_to_urn_part(#{resource := #{resource := #{id := Id, directory := Dir, namespace := NS}}}) ->
+    <<NS/binary, ":", Dir/binary, ":", Id/binary>>.
+