Merge branch 'anders/diameter/callback_redirection/OTP-9777'

* anders/diameter/callback_redirection/OTP-9777:
  Update documentation
  Use diameter_callback in relay and tls suites
  Use diameter_callback in failover suite
  Update app suite
  Smarter diameter_callback

3 files changed, 171 insertions, 11 deletions

diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index ecd3d9542a..336f0c1f2d 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -73,6 +73,7 @@
               'IPFilterRule'/0,
               'QoSFilterRule'/0]).
 
+-include_lib("diameter/include/diameter.hrl").
 -include("diameter_internal.hrl").
 
 %% ---------------------------------------------------------------------------
@@ -298,7 +299,8 @@ call(SvcName, App, Message) ->
 
 -type app_module()
    :: module()
-    | maybe_improper_list(module(), list()).
+    | maybe_improper_list(module(), list())
+    | #diameter_callback{}.
 
 %% Identifier returned by add_transport/2
 
diff --git a/lib/diameter/src/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl
index 6d5c8cdca1..90431099b0 100644
--- a/lib/diameter/src/base/diameter_callback.erl
+++ b/lib/diameter/src/base/diameter_callback.erl
@@ -18,11 +18,58 @@
 %%
 
 %%
-%% A minimal application callback module.
+%% A diameter callback module that can redirect selected callbacks,
+%% providing reasonable default implementations otherwise.
+%%
+%% To order alternate callbacks, configure a #diameter_callback record
+%% as the Diameter application callback in question. The record has
+%% one field for each callback function as well as 'default' and
+%% 'extra' fields. A function-specific field can be set to a
+%% diameter:evaluable() in order to redirect the callback
+%% corresponding to that field, or to 'false' to request the default
+%% callback implemented in this module. If neither of these fields are
+%% set then the 'default' field determines the form of the callback: a
+%% module name results in the usual callback as if the module had been
+%% configured directly as the callback module, a diameter_evaluable()
+%% in a callback applied to the atom-valued callback name and argument
+%% list. For all callbacks not to this module, the 'extra' field is a
+%% list of additional arguments, following arguments supplied by
+%% diameter but preceeding those of the diameter:evaluable() being
+%% applied.
+%%
+%% For example, the following config to diameter:start_service/2, in
+%% an 'application' tuple, would result in only a mymod:peer_down/3
+%% callback, this module implementing the remaining callbacks.
+%%
+%%   {module, #diameter_callback{peer_down = {mymod, down, []}}}
+%%
+%% Equivalently, this can also be specified with a [Mod | Args]
+%% field/value list as follows.
+%%
+%%   {module, [diameter_callback, {peer_down, {mymod, down, []}}]}
+%%
+%% The following would result in this module suppying peer_up and
+%% peer_down callback, others taking place in module mymod.
+%%
+%%   {module, #diameter_callback{peer_up = false,
+%%                               peer_down = false,
+%%                               default = mymod}}
+%%
+%% The following would result in all callbacks taking place as
+%% calls to mymod:diameter/2.
+%%
+%%   {module, #diameter_callback{default = {mymod, diameter, []}}}
+%%
+%% The following are equivalent and result in all callbacks being
+%% provided by this module.
+%%
+%%   {module, #diameter_callback{}}
+%%   {module, diameter_callback}
 %%
 
 -module(diameter_callback).
 
+%% Default callbacks when no aleternate is specified.
 -export([peer_up/3,
          peer_down/3,
          pick_peer/4,
@@ -32,6 +79,16 @@
          handle_answer/4,
          handle_error/4]).
 
+%% Callbacks taking a #diameter_callback record.
+-export([peer_up/4,
+         peer_down/4,
+         pick_peer/5,
+         prepare_request/4,
+         prepare_retransmit/4,
+         handle_request/4,
+         handle_answer/5,
+         handle_error/5]).
+
 -include_lib("diameter/include/diameter.hrl").
 
 %%% ----------------------------------------------------------
@@ -41,51 +98,137 @@
 peer_up(_Svc, _Peer, State) ->
     State.
 
+peer_up(Svc, Peer, State, D) ->
+    cb(peer_up,
+       [Svc, Peer, State],
+       D#diameter_callback.peer_up,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # peer_down/3
 %%% ----------------------------------------------------------
 
-peer_down(_SvcName, _Peer, State) ->
+peer_down(_Svc, _Peer, State) ->
     State.
 
+peer_down(Svc, Peer, State, D) ->
+    cb(peer_down,
+       [Svc, Peer, State],
+       D#diameter_callback.peer_down,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # pick_peer/4
 %%% ----------------------------------------------------------
 
-pick_peer([Peer|_], _, _SvcName, _State) ->
-    {ok, Peer}.
+pick_peer([Peer|_], _, _Svc, _State) ->
+    {ok, Peer};
+pick_peer([], _, _Svc, _State) ->
+    false.
+
+pick_peer(PeersL, PeersR, Svc, State, D) ->
+    cb(pick_peer,
+       [PeersL, PeersR, Svc, State],
+       D#diameter_callback.pick_peer,
+       D).
 
 %%% ----------------------------------------------------------
 %%% # prepare_request/3
 %%% ----------------------------------------------------------
 
-prepare_request(Pkt, _SvcName, _Peer) ->
+prepare_request(Pkt, _Svc, _Peer) ->
     {send, Pkt}.
 
+prepare_request(Pkt, Svc, Peer, D) ->
+    cb(prepare_request,
+       [Pkt, Svc, Peer],
+       D#diameter_callback.prepare_request,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # prepare_retransmit/3
 %%% ----------------------------------------------------------
 
-prepare_retransmit(Pkt, _SvcName, _Peer) ->
+prepare_retransmit(Pkt, _Svc, _Peer) ->
     {send, Pkt}.
 
+prepare_retransmit(Pkt, Svc, Peer, D) ->
+    cb(prepare_retransmit,
+       [Pkt, Svc, Peer],
+       D#diameter_callback.prepare_retransmit,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # handle_request/3
 %%% ----------------------------------------------------------
 
-handle_request(_Pkt, _SvcName, _Peer) ->
+handle_request(_Pkt, _Svc, _Peer) ->
     {protocol_error, 3001}.  %% DIAMETER_COMMAND_UNSUPPORTED
 
+handle_request(Pkt, Svc, Peer, D) ->
+    cb(handle_request,
+       [Pkt, Svc, Peer],
+       D#diameter_callback.handle_request,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # handle_answer/4
 %%% ----------------------------------------------------------
 
-handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) ->
-    Ans.
+handle_answer(#diameter_packet{msg = Ans, errors = []}, _Req, _Svc, _Peer) ->
+    Ans;
+handle_answer(#diameter_packet{msg = Ans, errors = Es}, _Req, _Svc, _Peer) ->
+    [Ans | Es].
+
+handle_answer(Pkt, Req, Svc, Peer, D) ->
+    cb(handle_answer,
+       [Pkt, Req, Svc, Peer],
+       D#diameter_callback.handle_answer,
+       D).
 
 %%% ---------------------------------------------------------------------------
 %%% # handle_error/4
 %%% ---------------------------------------------------------------------------
 
-handle_error(Reason, _Req, _SvcName, _Peer) ->
+handle_error(Reason, _Req, _Svc, _Peer) ->
     {error, Reason}.
+
+handle_error(Reason, Req, Svc, Peer, D) ->
+    cb(handle_error,
+       [Reason, Req, Svc, Peer],
+       D#diameter_callback.handle_error,
+       D).
+
+%% ===========================================================================
+
+%% cb/4
+
+%% Unspecified callback: use default field to determine something
+%% appropriate.
+cb(CB, Args, undefined, D) ->
+    cb(CB, Args, D);
+
+%% Explicitly requested default.
+cb(CB, Args, false, _) ->
+    apply(?MODULE, CB, Args);
+
+%% A specified callback.
+cb(_, Args, F, #diameter_callback{extra = X}) ->
+    diameter_lib:eval([[F|X] | Args]).
+
+%% cb/3
+
+%% No user-supplied default: call ours.
+cb(CB, Args, #diameter_callback{default = undefined}) ->
+    apply(?MODULE, CB, Args);
+
+%% Default is a module name: make the usual callback.
+cb(CB, Args, #diameter_callback{default = M,
+                                extra = X})
+  when is_atom(M) ->
+    apply(M, CB, Args ++ X);
+
+%% Default is something else: apply if to callback name and arguments.
+cb(CB, Args, #diameter_callback{default = F,
+                                extra = X}) ->
+    diameter_lib:eval([F, CB, Args | X]).
diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl
index a6b48fe65b..9253af0de2 100644
--- a/lib/diameter/src/base/diameter_config.erl
+++ b/lib/diameter/src/base/diameter_config.erl
@@ -605,6 +605,13 @@ app_acc({application, Opts}, Acc) ->
 app_acc(_, Acc) ->
     Acc.
 
+init_mod(#diameter_callback{} = R) ->
+    init_mod([diameter_callback, R]);
+init_mod([diameter_callback, #diameter_callback{}] = L) ->
+    L;
+init_mod([diameter_callback = M | L])
+  when is_list(L) ->
+    [M, init_cb(L)];
 init_mod(M)
   when is_atom(M) ->
     [M];
@@ -614,6 +621,14 @@ init_mod([M|_] = L)
 init_mod(M) ->
     ?THROW({module, M}).
 
+init_cb(List) ->
+    Fields = record_info(fields, diameter_callback),
+    Defaults = lists:zip(Fields, tl(tuple_to_list(#diameter_callback{}))),
+    Values = [V || F <- Fields,
+                   D <- [proplists:get_value(F, Defaults)],
+                   V <- [proplists:get_value(F, List, D)]],
+    #diameter_callback{} = list_to_tuple([diameter_callback | Values]).
+
 init_mutable(M)
   when M == true;
        M == false ->