1 files changed, 366 insertions, 0 deletions
diff --git a/apps/dreki/src/dreki_world.erl b/apps/dreki/src/dreki_world.erl
new file mode 100644
index 0000000..437b6c8
--- /dev/null
+++ b/apps/dreki/src/dreki_world.erl
@@ -0,0 +1,366 @@
+-module(dreki_world).
+
+-export([ensure_consistency/0, index/2]).
+-export([get_path/1, get_path/2, paths/0, put_path/3]).
+-export([get_region_from_dns_name/1, get_region/1, get_region/2, get_region/3, create_region/1, put_region/3]).
+-export([node/0, nodes/0, get_node_from_dns_name/1, get_node/1, create_node_from_dns_name/2, create_node/2, put_node/3]).
+-export([refresh_index/2, get/2, get/3, maybe_put_index/5]).
+-export([namespace_to_module/1]).
+-export([path_to_domain/1]).
+-export([to_map/0, root_domain/0, internal_domain/0, domain/0, hierarchy/0, parent/0, me/0, path/0, root_path/0, strip_root_path/1, put_root_path/1, read_uri/1, domain_to_path/1]).
+
+ensure_consistency() ->
+    Dns = dreki_world_dns:as_map(),
+    Vertices = maps:get(vertices, Dns),
+    ensure_consistency(Vertices, []).
+
+ensure_consistency([#{type := root, name := Root} | Rest], Acc) ->
+  Acc = case get_region_from_dns_name(Root) of
+      {error, {not_found, _}} ->
+        ok = create_region_from_dns_name(Root),
+        put_region(Root, root, true),
+        [{root, Root} | Acc];
+      _ ->
+        Acc
+   end,
+   Res = [Log || Kind <- [tasks], Log = {create, _} <- [ensure_global_root_stores(Root, Kind)]],
+   ensure_consistency(Rest, Res ++ Acc);
+
+ensure_consistency([#{type := region, name := Region} | Rest], Acc) ->
+    case get_region_from_dns_name(Region) of
+      {error, {not_found, _}} ->
+        ensure_consistency(Rest, [{Region, create_region_from_dns_name(Region)} | Acc]);
+      _ ->
+        ensure_consistency(Rest, Acc)
+   end;
+ensure_consistency([_ | Rest], Acc) ->
+    ensure_consistency(Rest, Acc);
+ensure_consistency([], Acc) ->
+  Acc.
+
+ensure_global_root_stores(Root, Kind) ->
+    {ok, Region} = get_region_from_dns_name(Root),
+    RegionUri = maps:get(uri, Region),
+    KindB = atom_to_binary(Kind),
+    StoreUri = <<RegionUri/binary, "::", KindB/binary, ":global">>,
+    case dreki_store:get_store(StoreUri) of
+      {ok, _store} -> ok;
+      _ -> {create, {Root,Kind,dreki_store:create_store(StoreUri, dreki_world_store, #{}, #{})}}
+    end.
+
+put_index(IdxKey, IdxValue, Uri, Data) ->
+    plum_db:put({IdxKey, IdxValue}, Uri, Data).
+
+maybe_put_index(Kind, IdxKey, IdxValue, Uri, Data) ->
+    case lists:member(IdxKey, index_fields(Kind)) of
+      true -> put_index(index_key(IdxKey), IdxValue, Uri, Data);
+      false -> ok
+    end.
+
+index_key(roles) -> 'idx:roles';
+index_key(tags) -> 'idx:tags'.
+
+index(Key, Value) ->
+    Idx = index_key(Key),
+    plum_db:fold(fun
+      ({_, ['$deleted']}, Acc) -> Acc;
+      ({Key, Val}, Acc) ->
+        [{Key, Val} | Acc]
+    end, [], {Idx, Value}).
+
+index_fields(node) -> [roles, tags];
+index_fields(region) -> [roles, tags];
+index_fields(_) -> [roles, tags].
+
+refresh_index(Kind, Map) when is_atom(Kind) ->
+   refresh_index(index_fields(Kind), Kind, Map).
+refresh_index([Field | Rest], Kind, Map = #{uri := URI}) ->
+   Values = case maps:get(Field, Map, undefined) of
+     undefined -> [];
+     V when is_list(V) -> V;
+     V -> [V]
+   end,
+   [maybe_put_index(Kind, Field, V, URI, undefined) || V <- Values],
+   refresh_index(Rest, Kind, Map);
+refresh_index([], _, _) ->
+  ok.
+
+clean_path(Path) ->
+  Len = byte_size(Path) - 1,
+  case Path of
+    <<P:Len/binary, ":">> -> P;
+    P -> P
+  end.
+
+put_path(Path0, Kind, Uri) ->
+    Path = clean_path(Path0),
+    {ok, Links} = get({paths, Path}, Path, [{default, #{}}]),
+    case maps:find(Kind, Links) of
+      {ok, _} -> {error, {exists, {Path, Kind}}};
+      error ->
+        ok = plum_db:put({paths, Path}, Path, Links#{Kind => Uri}),
+        ok
+    end.
+
+get_path(Path0) ->
+    Path = clean_path(Path0),
+    case get({paths, Path}, Path) of
+      not_found -> {error, {not_found, {path, Path}}};
+      {ok, Data} -> {ok, Data}
+    end.
+
+get_path(Path, Kind) ->
+    case get_path(Path) of
+      {ok, Map} ->
+        case maps:get(Kind, Map, undefined) of
+          undefined -> {error, {not_found, {Path, Kind}}};
+          Value -> {ok, Value}
+        end;
+      Error = {error, _} -> Error
+   end.
+
+paths() ->
+    plum_db:fold(fun
+      ({_, ['$deleted']}, Acc) -> Acc;
+      ({Path, Value}, Acc) ->
+        maps:put(Path, Value, Acc)
+    end, #{}, {paths, '_'}).
+
+get(Prefix, Key) ->
+  get(Prefix, Key, []).
+
+get(Prefix, Key, Opts) ->
+    case plum_db:get(Prefix, Key, Opts) of
+      undefined -> not_found;
+      ['$deleted'] -> not_found;
+      Val -> {ok, Val}
+   end.
+
+region_uri_from_dns_name(Name) ->
+    Root = internal_domain(),
+    if
+      Root =:= Name -> root_path();
+      true -> domain_to_path(Name)
+    end.
+
+get_region_from_dns_name(Name) ->
+    get_region(region_uri_from_dns_name(Name)).
+
+get_region(Path) ->
+    case get_path(Path, region) of
+      {ok, _} ->
+        Region = plum_db:fold(fun
+          ({_, ['$deleted']}, M) -> M;
+          ({{_, K}, V}, M) -> maps:put(K, V, M)
+        end, #{uri => Path}, {regions, Path}),
+        {ok, Region};
+      Error -> Error
+    end.
+
+get_region(Path, Key) ->
+    get_region(Path, Key, undefined).
+
+get_region(Path, Key, GetOpts) ->
+    case get_path(Path, region) of
+      {ok, _} -> get({regions, Path}, {Path, Key}, GetOpts);
+      Error -> Error
+   end.
+
+create_region_from_dns_name(Name) ->
+    create_region(region_uri_from_dns_name(Name)).
+
+create_region(Path) ->
+    case get_region(Path) of
+      {ok, _} -> {error, {exists, {region, Path}}};
+      {error, {not_found, _}} ->
+          ok = put_path(Path, region, Path),
+          ok = put_region(Path, region, Path),
+          {ok, R} = get_region(Path),
+          ok = refresh_index(region, R),
+          ok
+    end.
+
+put_region(Path, Key, Value) ->
+    case get_path(Path, region) of
+      {ok, _} ->
+        ok = plum_db:put({regions, Path}, {Path, Key}, Value),
+        ok = maybe_put_index(region, Key, Value, Path, undefined);
+      Error -> Error
+    end.
+
+nodes() ->
+    lists:foldr(fun (Domain, Acc) ->
+      case get_node_from_dns_name(Domain) of
+        {ok, Node} -> [Node | Acc];
+        _ -> Acc
+      end
+    end, [], dreki_world_dns:nodes()).
+
+node() ->
+    dreki_world:domain_to_path(dreki_world:domain()).
+
+get_node_from_dns_name(Name) ->
+  get_node(domain_to_path(Name)).
+
+get_node(Path) ->
+    case get_path(Path, node) of
+      {ok, _} ->
+        Node = plum_db:fold(fun
+          ({_, ['$deleted']}, M) -> M;
+          ({{_, K}, [V]}, M) -> maps:put(K, V, M)
+        end, #{uri => Path}, {nodes, Path}),
+        {ok, Node};
+      Error -> Error
+    end.
+
+create_node_from_dns_name(Name, Params) ->
+  create_node(domain_to_path(Name), Params).
+
+create_node(Path, Params) ->
+  case get_path(Path, node) of
+    {ok, _} -> {error, {exists, {node, Path}}};
+    {error, {not_found, _}} ->
+        ok = put_path(Path, node, Path),
+        ok = put_node(Path, node, Path),
+        [ok = put_node(Path, Key, Value) || {Key, Value} <- maps:to_list(Params)],
+        ok
+    end.
+
+put_node(Path, Key, Value) ->
+  case get_path(Path, node) of
+    {ok, _} -> plum_db:put({nodes, Path}, {Path, Key}, Value);
+    Error -> Error
+  end.
+
+domain_to_path(Domain) ->
+    Clean = strip_domain(Domain, internal_domain()),
+    Parts = binary:split(Clean, <<".">>, [global]),
+    Components = [<<"dreki">>, root_domain(), internal_subdomain()] ++ lists:reverse(Parts),
+    join(<<":">>, Components).
+
+path_to_domain(<<"dreki:", Rest/binary>>) ->
+    [Location | _] = binary:split(Rest, <<"::">>),
+    Components = binary:split(Location, <<":">>, [global]),
+    join(<<".">>, lists:reverse(Components)).
+
+root_domain() ->
+  get_env(root_domain).
+
+internal_domain() ->
+  get_env(internal_domain).
+
+domain() ->
+ get_env(domain).
+
+read_uri(U = <<"dreki:", _/binary>>) ->
+  read_uri(U, root_path());
+read_uri(Invalid) ->
+  {error, {bad_type, Invalid}}.
+%% Remove root
+%%read_uri(U, Root) ->
+%%  read_uri(U, Root, Rest).
+%%read_uri(U, Root) ->
+%%  {error, #{message => <<"URI outside of domain">>, uri => U, domain => Root}}.
+%% Extract hierarchy
+read_uri(U, Root) ->
+  {Hier, Res} = case binary:split(U, <<"::">>) of
+    [H, R] -> {H, R};
+    [H] -> {H, undefined}
+  end,
+  case get_path(H) of
+    {ok, Thing} -> read_uri_(U, Root, H, Res, Thing);
+    Error -> Error
+  end.
+
+read_uri_(U, Root, Path, ResPath, Thing) ->
+  Kind = case maps:keys(Thing) of
+    [K] -> K;
+    Ks -> Ks
+  end,
+  RegionStoreHint = case {maps:get(region, Thing, false), maps:get(node, Thing, false)} of
+    {false, _} -> global;
+    {_, false} -> global;
+    {_, _} -> local
+  end,
+  StoreHints = lists:foldr(fun
+    (node, Acc) -> maps:put(node, local, Acc);
+    (region, Acc) -> maps:put(region, RegionStoreHint, Acc)
+  end, #{}, maps:keys(Thing)),
+  Uri = #{domain => Root, path => Path, kind => Kind, store_hints => StoreHints, uri => U},
+  case read_resource_uri(ResPath, Uri) of
+    {ok, Resource} ->
+      {ok, Uri#{resource => Resource}};
+    {error, invalid_resource} ->
+      {error, #{message => <<"Invalid resource">>, uri => U, resource => ResPath}};
+    {error, invalid_namespace, NS} ->
+      {error, #{message => <<"Invalid namespace">>, uri => U, namespace => NS}}
+  end.
+
+read_resource_uri(undefined, _) ->
+  {ok, undefined};
+read_resource_uri(Path, Uri) ->
+  {NS, Rest} = case binary:split(Path, <<":">>) of
+    [NS, R] -> {NS, R};
+    [NS] -> {NS, undefined}
+  end,
+  case namespace_to_module(NS) of
+    {ok, Mod} -> Mod:read_uri(Rest, Uri);
+    error -> {error, invalid_namespace, NS}
+  end.
+
+namespace_to_module(<<"tasks">>) -> namespace_to_module(tasks);
+namespace_to_module(<<"names">>) -> namespace_to_module(names);
+namespace_to_module(tasks) -> {ok, dreki_tasks};
+namespace_to_module(names) -> {ok, dreki_names};
+namespace_to_module(_) -> error.
+
+internal_subdomain() ->
+  strip_domain(internal_domain(), root_domain()).
+
+root_path() ->
+  join(<<":">>, [<<"dreki">>, root_domain(), internal_subdomain()]).
+
+strip_root_path(Path) ->
+  Root = root_path(),
+  binary:replace(Path, <<Root/binary>>, <<"">>).  
+
+put_root_path(Path) ->
+  join(<<":">>, [root_path(), Path]).
+
+path() ->
+  HierJ = lists:reverse(hierarchy()),
+  Components = [<<"dreki">>, root_domain(), internal_subdomain()] ++ HierJ,
+  join(<<":">>, Components).
+
+hierarchy() ->
+  binary:split(strip_domain(domain(), internal_domain()), <<".">>, [global]).
+
+parent() ->
+  case hierarchy() of
+    [_, Parent | _] -> Parent;
+    [Parent] -> Parent
+  end.
+
+me() ->
+  [Me | _] = hierarchy(),
+  Me.
+
+get_env(Key) ->
+  {ok, Val} = application:get_env(dreki, Key),
+  Val.
+
+to_map() ->
+  #{domain => #{root => root_domain(), internal => internal_domain(), self => domain()},
+    path => path(),
+    root_path => root_path(),
+    hiearchy => lists:reverse(hierarchy()),
+    parent => parent(),
+    me => me()}.
+
+strip_domain(FQDN, Parent) ->
+  binary:replace(FQDN, <<".", Parent/binary>>, <<"">>).
+
+join(_Separator, []) ->
+    <<>>;
+join(Separator, [H|T]) ->
+    lists:foldl(fun (Value, Acc) -> <<Acc/binary, Separator/binary, Value/binary>> end, H, T).