-----------------------------------------------------------------------
--  awa-modules -- Application Module
--  Copyright (C) 2009, 2010, 2011, 2012, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Serialize.IO;
with Util.Listeners;

with EL.Expressions;

with ASF.Beans;
with ASF.Applications;
with ADO.Sessions;

with AWA.Events;
limited with AWA.Applications;

--  == Introduction ==
--  A module is a software component that can be integrated in the
--  web application.  The module can bring a set of service APIs,
--  some Ada beans and some presentation files.  The AWA framework
--  allows to configure various parts of a module when it is integrated
--  in an application.  Some modules are designed to be re-used by
--  several applications (for example a _mail_ module, a _users_
--  module, ...).  Other modules could be specific to an application.
--  An application will be made of several modules, some will be
--  generic some others specific to the application.
--
--  == Registration ==
--  The module should have only one instance per application and it must
--  be registered when the application is initialized.  The module
--  instance should be added to the application record as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Xxx       : aliased Xxx_Module;
--    end record;
--
--  The application record must override the `Initialize_Module` procedure
--  and it must register the module instance.  This is done as follows:
--
--    overriding
--    procedure Initialize_Modules (App : in out Application) is
--    begin
--       Register (App    => App.Self.all'Access,
--                 Name   => Xxx.Module.NAME,
--                 URI    => "xxx",
--                 Module => App.User_Module'Access);
--    end Initialize_Modules;
--
--  The module is registered under a unique name.  That name is used
--  to load the module configuration.
--
--  == Configuration ==
--  The module is configured by using an XML or a properties file.
--  The configuration file is used to define:
--
--    * the Ada beans that the module defines and uses,
--    * the events that the module wants to receive and the action
--      that must be performed when the event is posted,
--    * the permissions that the module needs and how to check them,
--    * the navigation rules which are used for the module web interface,
--    * the servlet and filter mappings used by the module
--
--  The module configuration is located in the *config* directory
--  and must be the name of the module followed by the file extension
--  (example: `module-name`.xml or `module-name`.properties).
--
--
package AWA.Modules is

   type Application_Access is access all AWA.Applications.Application'Class;

   --  ------------------------------
   --  Module manager
   --  ------------------------------
   --
   --  The Module_Manager represents the root of the logic manager
   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with private;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object;

   --  ------------------------------
   --  Module
   --  ------------------------------
   type Module is abstract new Ada.Finalization.Limited_Controlled with private;
   type Module_Access is access all Module'Class;

   --  Get the module name
   function Get_Name (Plugin : Module) return String;

   --  Get the base URI for this module
   function Get_URI (Plugin : Module) return String;

   --  Get the application in which this module is registered.
   function Get_Application (Plugin : in Module) return Application_Access;

   --  Find the module with the given name
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Integer := -1) return Integer;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in String := "")
                        return EL.Expressions.Expression;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class);

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Initialize the configuration file parser represented by Parser to recognize
   --  the specific configuration recognized by the module.
   procedure Initialize_Parser (Plugin : in out Module;
                                Parser : in out Util.Serialize.IO.Parser'Class) is null;

   --  Configures the module after its initialization and after having read its XML configuration.
   procedure Configure (Plugin : in out Module;
                        Props  : in ASF.Applications.Config) is null;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class);

   --  Get the database connection for reading
   function Get_Session (Manager : Module)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session;

   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access);

   --  Add a listener to the module listner list.  The module will invoke the listner
   --  depending on events or actions that occur in the module.
   procedure Add_Listener (Into : in out Module;
                           Item : in Util.Listeners.Listener_Access);

   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access);

   --  Remove a listener from the module listener list.
   procedure Remove_Listener (Into : in out Module;
                              Item : in Util.Listeners.Listener_Access);

   --  Finalize the module.
   overriding
   procedure Finalize (Plugin : in out Module);

   type Pool_Module is abstract new Module with private;

   type Session_Module is abstract new Module with private;

   generic
      type Manager_Type is new Module_Manager with private;
      type Manager_Type_Access is access all Manager_Type'Class;
      Name : String;
   function Get_Manager return Manager_Type_Access;

   --  Get the database connection for reading
   function Get_Session (Manager : Module_Manager)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module_Manager)
                                return ADO.Sessions.Master_Session;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class);

   --  ------------------------------
   --  Module Registry
   --  ------------------------------
   --  The module registry maintains the list of available modules with
   --  operations to retrieve them either from a name or from the base URI.
   type Module_Registry is limited private;
   type Module_Registry_Access is access all Module_Registry;

   --  Initialize the registry
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config);

   --  Register the module in the registry.
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String);

   --  Find the module with the given name
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access;

   --  Find the module mapped to a given URI
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access;

   --  Iterate over the modules that have been registered and execute the Process
   --  procedure on each of the module instance.
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class));

private

   use Ada.Strings.Unbounded;

   type Module is abstract new Ada.Finalization.Limited_Controlled with record
      Registry   : Module_Registry_Access;
      App        : Application_Access := null;
      Name       : Unbounded_String;
      URI        : Unbounded_String;
      Config     : ASF.Applications.Config;
      Self       : Module_Access := null;
      Listeners  : Util.Listeners.List;
   end record;

   --  Map to find a module from its name or its URI
   package Module_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Module_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Module_Registry is limited record
      Config   : ASF.Applications.Config;
      Name_Map : Module_Maps.Map;
      URI_Map  : Module_Maps.Map;
   end record;

   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Module : Module_Access := null;
   end record;

   type Pool_Module is new Module with record
      D : Natural;
   end record;

   type Session_Module is new Module with record
      P : Natural;
   end record;

   use Util.Log;

   --  The logger (used by the generic Get function).
   Log : constant Loggers.Logger := Loggers.Create ("AWA.Modules");

end AWA.Modules;

-----------------------------------------------------------------------
--  awa-modules -- Application Module
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Log.Loggers;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Serialize.IO;
with Util.Listeners;

with EL.Expressions;

with ASF.Beans;
with ASF.Applications;
with ADO.Sessions;

with AWA.Events;
limited with AWA.Applications;

--  == Introduction ==
--  A module is a software component that can be integrated in the
--  web application.  The module can bring a set of service APIs,
--  some Ada beans and some presentation files.  The AWA framework
--  allows to configure various parts of a module when it is integrated
--  in an application.  Some modules are designed to be re-used by
--  several applications (for example a _mail_ module, a _users_
--  module, ...).  Other modules could be specific to an application.
--  An application will be made of several modules, some will be
--  generic some others specific to the application.
--
--  == Registration ==
--  The module should have only one instance per application and it must
--  be registered when the application is initialized.  The module
--  instance should be added to the application record as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Xxx       : aliased Xxx_Module;
--    end record;
--
--  The application record must override the `Initialize_Module` procedure
--  and it must register the module instance.  This is done as follows:
--
--    overriding
--    procedure Initialize_Modules (App : in out Application) is
--    begin
--       Register (App    => App.Self.all'Access,
--                 Name   => Xxx.Module.NAME,
--                 URI    => "xxx",
--                 Module => App.User_Module'Access);
--    end Initialize_Modules;
--
--  The module is registered under a unique name.  That name is used
--  to load the module configuration.
--
--  == Configuration ==
--  The module is configured by using an XML or a properties file.
--  The configuration file is used to define:
--
--    * the Ada beans that the module defines and uses,
--    * the events that the module wants to receive and the action
--      that must be performed when the event is posted,
--    * the permissions that the module needs and how to check them,
--    * the navigation rules which are used for the module web interface,
--    * the servlet and filter mappings used by the module
--
--  The module configuration is located in the *config* directory
--  and must be the name of the module followed by the file extension
--  (example: `module-name`.xml or `module-name`.properties).
--
--
package AWA.Modules is

   type Application_Access is access all AWA.Applications.Application'Class;

   --  ------------------------------
   --  Module manager
   --  ------------------------------
   --
   --  The Module_Manager represents the root of the logic manager
   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with private;

   function Get_Value (Manager : in Module_Manager;
                       Name    : in String) return Util.Beans.Objects.Object;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module_Manager;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module_Manager;
                        Config : in ASF.Applications.Config_Param) return String;

   --  ------------------------------
   --  Module
   --  ------------------------------
   type Module is abstract new Ada.Finalization.Limited_Controlled with private;
   type Module_Access is access all Module'Class;

   --  Get the module name
   function Get_Name (Plugin : Module) return String;

   --  Get the base URI for this module
   function Get_URI (Plugin : Module) return String;

   --  Get the application in which this module is registered.
   function Get_Application (Plugin : in Module) return Application_Access;

   --  Find the module with the given name
   function Find_Module (Plugin : Module;
                         Name   : String) return Module_Access;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : String := "") return String;

   --  Get the module configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : Module;
                        Name    : String;
                        Default : Integer := -1) return Integer;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the property does not exist, the default configuration value is returned.
   function Get_Config (Plugin : in Module;
                        Config : in ASF.Applications.Config_Param) return String;

   --  Get the module configuration property identified by the <tt>Config</tt> parameter.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Plugin  : in Module;
                        Name    : in String;
                        Default : in String := "")
                        return EL.Expressions.Expression;

   procedure Initialize (Manager : in out Module_Manager;
                         Module  : in AWA.Modules.Module'Class);

   procedure Initialize (Plugin : in out Module;
                         App    : in Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Initialize the configuration file parser represented by Parser to recognize
   --  the specific configuration recognized by the module.
   procedure Initialize_Parser (Plugin : in out Module;
                                Parser : in out Util.Serialize.IO.Parser'Class) is null;

   --  Configures the module after its initialization and after having read its XML configuration.
   procedure Configure (Plugin : in out Module;
                        Props  : in ASF.Applications.Config) is null;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Plugin  : in Module;
                         Content : in AWA.Events.Module_Event'Class);

   --  Get the database connection for reading
   function Get_Session (Manager : Module)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module)
                                return ADO.Sessions.Master_Session;

   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   procedure Register (Plugin : in out Module;
                       Name    : in String;
                       Bind    : in ASF.Beans.Class_Binding_Access);

   --  Add a listener to the module listner list.  The module will invoke the listner
   --  depending on events or actions that occur in the module.
   procedure Add_Listener (Into : in out Module;
                           Item : in Util.Listeners.Listener_Access);

   --  Find the module with the given name in the application and add the listener to the
   --  module listener list.
   procedure Add_Listener (Plugin : in Module;
                           Name   : in String;
                           Item   : in Util.Listeners.Listener_Access);

   --  Remove a listener from the module listener list.
   procedure Remove_Listener (Into : in out Module;
                              Item : in Util.Listeners.Listener_Access);

   --  Finalize the module.
   overriding
   procedure Finalize (Plugin : in out Module);

   type Pool_Module is abstract new Module with private;

   type Session_Module is abstract new Module with private;

   generic
      type Manager_Type is new Module_Manager with private;
      type Manager_Type_Access is access all Manager_Type'Class;
      Name : String;
   function Get_Manager return Manager_Type_Access;

   --  Get the database connection for reading
   function Get_Session (Manager : Module_Manager)
                         return ADO.Sessions.Session;

   --  Get the database connection for writing
   function Get_Master_Session (Manager : Module_Manager)
                                return ADO.Sessions.Master_Session;

   --  Send the event to the module.  The module identified by To is
   --  found and the event is posted on its event channel.
   procedure Send_Event (Manager : in Module_Manager;
                         Content : in AWA.Events.Module_Event'Class);

   --  ------------------------------
   --  Module Registry
   --  ------------------------------
   --  The module registry maintains the list of available modules with
   --  operations to retrieve them either from a name or from the base URI.
   type Module_Registry is limited private;
   type Module_Registry_Access is access all Module_Registry;

   --  Initialize the registry
   procedure Initialize (Registry : in out Module_Registry;
                         Config   : in ASF.Applications.Config);

   --  Register the module in the registry.
   procedure Register (Registry : in Module_Registry_Access;
                       App      : in Application_Access;
                       Plugin   : in Module_Access;
                       Name     : in String;
                       URI      : in String);

   --  Find the module with the given name
   function Find_By_Name (Registry : Module_Registry;
                          Name     : String) return Module_Access;

   --  Find the module mapped to a given URI
   function Find_By_URI (Registry : Module_Registry;
                         URI      : String) return Module_Access;

   --  Iterate over the modules that have been registered and execute the Process
   --  procedure on each of the module instance.
   procedure Iterate (Registry : in Module_Registry;
                      Process  : access procedure (Plugin : in out Module'Class));

private

   use Ada.Strings.Unbounded;

   type Module is abstract new Ada.Finalization.Limited_Controlled with record
      Registry   : Module_Registry_Access;
      App        : Application_Access := null;
      Name       : Unbounded_String;
      URI        : Unbounded_String;
      Config     : ASF.Applications.Config;
      Self       : Module_Access := null;
      Listeners  : Util.Listeners.List;
   end record;

   --  Map to find a module from its name or its URI
   package Module_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Module_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Module_Registry is limited record
      Config   : ASF.Applications.Config;
      Name_Map : Module_Maps.Map;
      URI_Map  : Module_Maps.Map;
   end record;

   type Module_Manager is new Ada.Finalization.Limited_Controlled
     and Util.Beans.Basic.Readonly_Bean with record
      Module : Module_Access := null;
   end record;

   type Pool_Module is new Module with record
      D : Natural;
   end record;

   type Session_Module is new Module with record
      P : Natural;
   end record;

   use Util.Log;

   --  The logger (used by the generic Get function).
   Log : constant Loggers.Logger := Loggers.Create ("AWA.Modules");

end AWA.Modules;

Declare Get_Config function with the Module_Manager type


-----------------------------------------------------------------------
--  Security-oayth-jwt-tests - Unit tests for JSON Web Token
--  Copyright (C) 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar.Formatting;

with Util.Test_Caller;

package body Security.OAuth.JWT.Tests is

   package Caller is new Util.Test_Caller (Test, "Security.OAuth.JWT");

   --  A JWT token returned by Google+.
   K : constant String := "eyJhbGciOiJSUzI1NiIsImtpZCI6IjVmOTBlMWExMGE4YzgwZWJhZWNmYzM4NzBjZDl"
     & "lMGVhMGI3ZDVmZGMifQ.eyJpc3MiOiJhY2NvdW50cy5nb29nbGUuY29tIiwiYXRfaGFzaCI6Im9Ka19EYnFvb1"
     & "FVc0FhY3k2cnkxeHciLCJhdWQiOiI4NzI2NTU5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJz"
     & "dWIiOiIxMDgzNjA3MDMwOTk3MDg5Nzg4NzAiLCJlbWFpbF92ZXJpZmllZCI6InRydWUiLCJhenAiOiI4NzI2NT"
     & "U5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJlbWFpbCI6InN0ZXBoYW5lLmNhcnJlekBnbWFp"
     & "bC5jb20iLCJpYXQiOjEzNjg5NjgyMzMsImV4cCI6MTM2ODk3MjEzM30.UL1qp2wmleV-ED2A_hlqgDLIGgJB3f"
     & "_N7fiz1CgttJcwbmMVwhag3ox2WE9C1KwXhrjwT8eigZ0WkDys5WO1dYs2G1QbDZPnsYYMyHK9XpycaDMEKtVZ"
     & "C4C6DkB1SrBHbN0Tv6ExWpszzp1JEL8nZnHd3T_AA3paqONnkvQw_yo";

   procedure Test_Operation (T : in out Test) is
      R : Token;
   begin
      R := Decode (K);
      Util.Tests.Assert_Equals (T, Value, Get (R), "Extraction failed");
   end Test_Operation;

   procedure Test_Time_Operation (T : in out Test) is
      R : Token;
   begin
      R := Decode (K);
      Util.Tests.Assert_Equals (T, Value, Ada.Calendar.Formatting.Image (Get (R)),
                                "Extraction failed");
   end Test_Time_Operation;

   procedure Test_Get_Issuer is
     new Test_Operation (Get_Issuer, "accounts.google.com");
   procedure Test_Get_Audience is
     new Test_Operation (Get_Audience, "872655994014.apps.googleusercontent.com");
   procedure Test_Get_Subject is
     new Test_Operation (Get_Subject, "108360703099708978870");
   procedure Test_Get_Authorized_Presenters is
     new Test_Operation (Get_Authorized_Presenters, "872655994014.apps.googleusercontent.com");
   procedure Test_Get_Expiration is
     new Test_Time_Operation (Get_Expiration, "2013-05-19 14:02:13");
   procedure Test_Get_Issued_At is
     new Test_Time_Operation (Get_Issued_At, "2013-05-19 12:57:13");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Decode",
                       Test_Get_Issuer'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Issuer",
                       Test_Get_Issuer'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Audience",
                       Test_Get_Audience'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Subject",
                       Test_Get_Subject'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Authorized_Presenters",
                       Test_Get_Authorized_Presenters'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Expiration",
                       Test_Get_Expiration'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Authentication_Time",
                       Test_Get_Issued_At'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Decode (error)",
                       Test_Decode_Error'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test Decode operation with errors.
   --  ------------------------------
   procedure Test_Decode_Error (T : in out Test) is
      K : constant String := "eyJhbxGciOiJSUzI1NiIsImtpZCI6IjVmOTBlMWExMGE4YzgwZWJhZWNmYzM4NzBjZDl"
        & "lMGVhMGI3ZDVmZGMifQ.eyJpc3xMiOiJhY2NvdW50cy5nb29nbGUuY29tIiwiYXRfaGFzaCI6Im9Ka19EYnFvb1"
        & "FVc0FhY3k2cnkxeHciLCJhdWQiOiI4NzI2NTU5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJz"
        & "dWIiOiIxMDgzNjA3MDMwOTk3MDg5Nzg4NzAiLCJlbWFpbF92ZXJpZmllZCI6InRydWUiLCJhenAiOiI4NzI2NT"
        & "U5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJlbWFpbCI6InN0ZXBoYW5lLmNhcnJlekBnbWFp"
        & "bC5jb20iLCJpYXQiOjEzNjg5NjgyMzMsImV4cCI6MTM2ODk3MjEzM30.UL1qp2wmleV-ED2A_hlqgDLIGgJB3f"
        & "_N7fiz1CgttJcwbmMVwhag3ox2WE9C1KwXhrjwT8eigZ0WkDys5WO1dYs2G1QbDZPnsYYMyHK9XpycaDMEKtVZ"
        & "C4C6DkB1SrBHbN0Tv6ExWpszzp1JEL8nZnHd3T_AA3paqONnkvQw_yx";
      R : Token;
   begin
      R := Decode (K);
      T.Fail ("No exception raised");
      T.Assert (False, "Bad");

   exception
      when Invalid_Token =>
         null;
   end Test_Decode_Error;

end Security.OAuth.JWT.Tests;

-----------------------------------------------------------------------
--  Security-oayth-jwt-tests - Unit tests for JSON Web Token
--  Copyright (C) 2013, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar.Formatting;

with Util.Test_Caller;

package body Security.OAuth.JWT.Tests is

   package Caller is new Util.Test_Caller (Test, "Security.OAuth.JWT");

   --  A JWT token returned by Google+.
   K : constant String := "eyJhbGciOiJSUzI1NiIsImtpZCI6IjVmOTBlMWExMGE4YzgwZWJhZWNmYzM4NzBjZDl"
     & "lMGVhMGI3ZDVmZGMifQ.eyJpc3MiOiJhY2NvdW50cy5nb29nbGUuY29tIiwiYXRfaGFzaCI6Im9Ka19EYnFvb1"
     & "FVc0FhY3k2cnkxeHciLCJhdWQiOiI4NzI2NTU5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJz"
     & "dWIiOiIxMDgzNjA3MDMwOTk3MDg5Nzg4NzAiLCJlbWFpbF92ZXJpZmllZCI6InRydWUiLCJhenAiOiI4NzI2NT"
     & "U5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJlbWFpbCI6InN0ZXBoYW5lLmNhcnJlekBnbWFp"
     & "bC5jb20iLCJpYXQiOjEzNjg5NjgyMzMsImV4cCI6MTM2ODk3MjEzM30.UL1qp2wmleV-ED2A_hlqgDLIGgJB3f"
     & "_N7fiz1CgttJcwbmMVwhag3ox2WE9C1KwXhrjwT8eigZ0WkDys5WO1dYs2G1QbDZPnsYYMyHK9XpycaDMEKtVZ"
     & "C4C6DkB1SrBHbN0Tv6ExWpszzp1JEL8nZnHd3T_AA3paqONnkvQw_yo";

   procedure Test_Operation (T : in out Test) is
      R : Token;
   begin
      R := Decode (K);
      Util.Tests.Assert_Equals (T, Value, Get (R), "Extraction failed");
   end Test_Operation;

   procedure Test_Time_Operation (T : in out Test) is
      R : Token;
   begin
      R := Decode (K);
      Util.Tests.Assert_Equals (T, Value, Ada.Calendar.Formatting.Image (Get (R)),
                                "Extraction failed");
   end Test_Time_Operation;

   procedure Test_Get_Issuer is
     new Test_Operation (Get_Issuer, "accounts.google.com");
   procedure Test_Get_Audience is
     new Test_Operation (Get_Audience, "872655994014.apps.googleusercontent.com");
   procedure Test_Get_Subject is
     new Test_Operation (Get_Subject, "108360703099708978870");
   procedure Test_Get_Authorized_Presenters is
     new Test_Operation (Get_Authorized_Presenters, "872655994014.apps.googleusercontent.com");
   procedure Test_Get_Expiration is
     new Test_Time_Operation (Get_Expiration, "2013-05-19 14:02:13");
   procedure Test_Get_Issued_At is
     new Test_Time_Operation (Get_Issued_At, "2013-05-19 12:57:13");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Decode",
                       Test_Get_Issuer'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Issuer",
                       Test_Get_Issuer'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Audience",
                       Test_Get_Audience'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Subject",
                       Test_Get_Subject'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Authorized_Presenters",
                       Test_Get_Authorized_Presenters'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Expiration",
                       Test_Get_Expiration'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Get_Authentication_Time",
                       Test_Get_Issued_At'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.JWT.Decode (error)",
                       Test_Decode_Error'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test Decode operation with errors.
   --  ------------------------------
   procedure Test_Decode_Error (T : in out Test) is
      K : constant String := "eyJhbxGciOiJSUzI1NiIsImtpZCI6IjVmOTBlMWExMGE4YzgwZWJhZWNmYzM4NzBjZDl"
        & "lMGVhMGI3ZDVmZGMifQ.eyJpc3xMiOiJhY2NvdW50cy5nb29nbGUuY29tIiwiYXRfaGFzaCI6Im9Ka19EYnFvb1"
        & "FVc0FhY3k2cnkxeHciLCJhdWQiOiI4NzI2NTU5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJz"
        & "dWIiOiIxMDgzNjA3MDMwOTk3MDg5Nzg4NzAiLCJlbWFpbF92ZXJpZmllZCI6InRydWUiLCJhenAiOiI4NzI2NT"
        & "U5OTQwMTQuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJlbWFpbCI6InN0ZXBoYW5lLmNhcnJlekBnbWFp"
        & "bC5jb20iLCJpYXQiOjEzNjg5NjgyMzMsImV4cCI6MTM2ODk3MjEzM30.UL1qp2wmleV-ED2A_hlqgDLIGgJB3f"
        & "_N7fiz1CgttJcwbmMVwhag3ox2WE9C1KwXhrjwT8eigZ0WkDys5WO1dYs2G1QbDZPnsYYMyHK9XpycaDMEKtVZ"
        & "C4C6DkB1SrBHbN0Tv6ExWpszzp1JEL8nZnHd3T_AA3paqONnkvQw_yx";
      R : Token;
      pragma Unreferenced (R);
   begin
      R := Decode (K);
      T.Fail ("No exception raised");
      T.Assert (False, "Bad");

   exception
      when Invalid_Token =>
         null;
   end Test_Decode_Error;

end Security.OAuth.JWT.Tests;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Calendar;
with Ada.Containers;
with Ada.Finalization;

with Util.Streams.Texts;

--  The Measures package defines utility types and functions to make
--  performance measurements in an Ada application.  It is designed to be used
--  for production and multi-threaded environments.
--
--  A measurement point starts by the creation of a Stamp variable
--  and ends at the next call to Report on that variable.
--
--   declare
--      M : Stamp;
--   begin
--      ...
--      Util.Measures.Report (M, "Request for X");
--   end;
--
--  Measures are collected in a Measure_Set which collects the number of
--  times each measure was made and the sum of their duration.
--  Measures can be written in an XML file once they are collected.
package Util.Measures is

   type Unit_Type is (Seconds, Milliseconds, Microseconds, Nanoseconds);

   --  ------------------------------
   --  Measure Set
   --  ------------------------------
   --  The measure set represent a collection of measures each of them being
   --  associated with a same name.  Several measure sets can be created to
   --  collect different kinds of runtime information.  The measure set can be
   --  set on a per-thread data and every call to Report will be
   --  associated with that measure set.
   --
   --  Measure set are thread-safe.
   type Measure_Set is limited private;
   type Measure_Set_Access is access all Measure_Set;

   --  Disable collecting measures on the measure set.
   procedure Disable (Measures : in out Measure_Set);

   --  Enable collecting measures on the measure set.
   procedure Enable (Measures : in out Measure_Set);

   --  Set the per-thread measure set.
   procedure Set_Current (Measures : in Measure_Set_Access);

   --  Get the per-thread measure set.
   function Get_Current return Measure_Set_Access;

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class);

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type);

   --  Dump  an XML result with the measures in a file.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String);

   --  ------------------------------
   --  Stamp
   --  ------------------------------
   --  The stamp marks the beginning of a measure when the variable of such
   --  type is declared.  The measure represents the time that elapsed between
   --  the stamp creation and when the Report method is called.
   type Stamp is limited private;

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   procedure Report (S     : in out Stamp;
                     Title : in String);

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String);

   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds);

private

   type String_Access is access String;

   type Stamp is limited record
      Start : Ada.Calendar.Time := Ada.Calendar.Clock;
   end record;

   type Measure;
   type Measure_Access is access Measure;

   type Measure is limited record
      Next  : Measure_Access;
      Time  : Duration;
      Count : Positive;
      Name  : String_Access;
   end record;

   type Buckets_Type is
     array (Ada.Containers.Hash_Type range <>) of Measure_Access;
   type Buckets_Access is access all Buckets_Type;

   --  To reduce contention we only protect insertion and updates of measures.
   --  To write the measure set, we steal the buckets and force the next call
   --  to Add to reallocate the buckets.
   protected type Measure_Data is

      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time);

      --  Add the measure
      procedure Add (Title : in String; D : in Duration);

   private
      Start   : Ada.Calendar.Time := Ada.Calendar.Clock;
      Buckets : Buckets_Access;
   end Measure_Data;

   type Measure_Set is new Ada.Finalization.Limited_Controlled with record
      Enabled : Boolean := True;
      pragma Atomic (Enabled);

      Data    : Measure_Data;
   end record;

   --  Finalize the measures and release the storage.
   overriding
   procedure Finalize (Measures : in out Measure_Set);

end Util.Measures;

-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Calendar;
with Ada.Containers;
with Ada.Finalization;

with Util.Streams.Texts;

--  The Measures package defines utility types and functions to make
--  performance measurements in an Ada application.  It is designed to be used
--  for production and multi-threaded environments.
--
--  A measurement point starts by the creation of a Stamp variable
--  and ends at the next call to Report on that variable.
--
--   declare
--      M : Stamp;
--   begin
--      ...
--      Util.Measures.Report (M, "Request for X");
--   end;
--
--  Measures are collected in a Measure_Set which collects the number of
--  times each measure was made and the sum of their duration.
--  Measures can be written in an XML file once they are collected.
package Util.Measures is

   type Unit_Type is (Seconds, Milliseconds, Microseconds, Nanoseconds);

   --  ------------------------------
   --  Measure Set
   --  ------------------------------
   --  The measure set represent a collection of measures each of them being
   --  associated with a same name.  Several measure sets can be created to
   --  collect different kinds of runtime information.  The measure set can be
   --  set on a per-thread data and every call to Report will be
   --  associated with that measure set.
   --
   --  Measure set are thread-safe.
   type Measure_Set is limited private;
   type Measure_Set_Access is access all Measure_Set;

   --  Disable collecting measures on the measure set.
   procedure Disable (Measures : in out Measure_Set);

   --  Enable collecting measures on the measure set.
   procedure Enable (Measures : in out Measure_Set);

   --  Set the per-thread measure set.
   procedure Set_Current (Measures : in Measure_Set_Access);

   --  Get the per-thread measure set.
   function Get_Current return Measure_Set_Access;

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class);

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type);

   --  Dump  an XML result with the measures in a file.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String);

   --  ------------------------------
   --  Stamp
   --  ------------------------------
   --  The stamp marks the beginning of a measure when the variable of such
   --  type is declared.  The measure represents the time that elapsed between
   --  the stamp creation and when the Report method is called.
   type Stamp is limited private;

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds);

private

   type String_Access is access String;

   type Stamp is limited record
      Start : Ada.Calendar.Time := Ada.Calendar.Clock;
   end record;

   type Measure;
   type Measure_Access is access Measure;

   type Measure is limited record
      Next  : Measure_Access;
      Time  : Duration;
      Count : Positive;
      Name  : String_Access;
   end record;

   type Buckets_Type is
     array (Ada.Containers.Hash_Type range <>) of Measure_Access;
   type Buckets_Access is access all Buckets_Type;

   --  To reduce contention we only protect insertion and updates of measures.
   --  To write the measure set, we steal the buckets and force the next call
   --  to Add to reallocate the buckets.
   protected type Measure_Data is

      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time);

      --  Add the measure
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1);

   private
      Start   : Ada.Calendar.Time := Ada.Calendar.Clock;
      Buckets : Buckets_Access;
   end Measure_Data;

   type Measure_Set is new Ada.Finalization.Limited_Controlled with record
      Enabled : Boolean := True;
      pragma Atomic (Enabled);

      Data    : Measure_Data;
   end record;

   --  Finalize the measures and release the storage.
   overriding
   procedure Finalize (Measures : in out Measure_Set);

end Util.Measures;

Add an optional Count parameter to each Report procedure


-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Initialize the process targets by loading the MAT files.
   procedure Initialize_Files (Target  : in out MAT.Targets.Target_Type'Class);

   --  Symbol command.
   --  Load the symbols from the binary file.
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Threads command.
   --  Collect statistics about the threads and their allocation.
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String);

   --  Events command.
   --  Print the probe events.
   procedure Events_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Event command.
   --  Print the probe event with the stack frame.
   procedure Event_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Info command to print symmary information about the program.
   procedure Info_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);

end MAT.Commands;

-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Initialize the process targets by loading the MAT files.
   procedure Initialize_Files (Target  : in out MAT.Targets.Target_Type'Class);

   --  Symbol command.
   --  Load the symbols from the binary file.
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Threads command.
   --  Collect statistics about the threads and their allocation.
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String);

   --  Events command.
   --  Print the probe events.
   procedure Events_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Event command.
   --  Print the probe event with the stack frame.
   procedure Event_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Info command to print symmary information about the program.
   procedure Info_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);

   --  Timeline command.
   --  Identify the interesting timeline groups in the events and display them.
   procedure Timeline_Command (Target : in out MAT.Targets.Target_Type'Class;
                               Args   : in String);

end MAT.Commands;

Declare the Timeline_Command procedure

Declare the Timeline_Command procedure


-----------------------------------------------------------------------
--  awa-tests-helpers - Helpers for AWA unit tests
--  Copyright (C) 2011, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body AWA.Tests.Helpers is

   --  ------------------------------
   --  Extract from the Location header the part that is after the given base string.
   --  If the Location header does not start with the base string, returns the empty
   --  string.
   --  ------------------------------
   function Extract_Redirect (Reply : in ASF.Responses.Mockup.Response'Class;
                              Base  : in String) return String is
      R : constant String := Reply.Get_Header ("Location");
   begin
      if R'Length < Base'Length then
         return "";
      elsif R (R'First .. R'First + Base'Length - 1) /= Base then
         return "";
      else
         return R (R'First + Base'Length .. R'Last);
      end if;
   end Extract_Redirect;

   function Extract_Redirect (Reply : in ASF.Responses.Mockup.Response'Class;
                              Base  : in String) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (Extract_Redirect (Reply, Base));
   end Extract_Redirect;

end AWA.Tests.Helpers;

-----------------------------------------------------------------------
--  awa-tests-helpers - Helpers for AWA unit tests
--  Copyright (C) 2011, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with GNAT.Regpat;
package body AWA.Tests.Helpers is

   --  ------------------------------
   --  Extract from the Location header the part that is after the given base string.
   --  If the Location header does not start with the base string, returns the empty
   --  string.
   --  ------------------------------
   function Extract_Redirect (Reply : in ASF.Responses.Mockup.Response'Class;
                              Base  : in String) return String is
      R : constant String := Reply.Get_Header ("Location");
   begin
      if R'Length < Base'Length then
         return "";
      elsif R (R'First .. R'First + Base'Length - 1) /= Base then
         return "";
      else
         return R (R'First + Base'Length .. R'Last);
      end if;
   end Extract_Redirect;

   function Extract_Redirect (Reply : in ASF.Responses.Mockup.Response'Class;
                              Base  : in String) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (Extract_Redirect (Reply, Base));
   end Extract_Redirect;

   --  ------------------------------
   --  Extract from the response content a link with a given title.
   --  ------------------------------
   function Extract_Link (Content : in String;
                          Title   : in String) return String is
      use GNAT.Regpat;

      Pattern : constant String := " href=""([a-zA-Z0-9/]+)"">" & Title & "</a>";
      Regexp  : constant Pattern_Matcher := Compile (Expression => Pattern);
      Result  : GNAT.Regpat.Match_Array (0 .. 1);
   begin
      Match (Regexp, Content, Result);
      if Result (1) = GNAT.Regpat.No_Match then
         return "";
      end if;
      return Content (Result (1).First .. Result (1).Last);
   end Extract_Link;

end AWA.Tests.Helpers;

Implement the Extract_Link function

Implement the Extract_Link function


-----------------------------------------------------------------------
--  awa-users-beans -- ASF Beans for user module
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with ASF.Principals;
with ASF.Sessions;
with ASF.Events.Actions;
with ASF.Contexts.Faces;
with ASF.Cookies;

with AWA.Users.Principals;
package body AWA.Users.Beans is

   use AWA.Users.Models;

   --  ------------------------------
   --  Action to register a user
   --  ------------------------------
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");
   end Register_User;

   --  ------------------------------
   --  Action to verify the user after the registration
   --  ------------------------------
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                User    => User,
                                IpAddr  => "",
                                Session => Session);

      Data.Set_Session_Principal (User, Session);
      Outcome := To_Unbounded_String ("success");
   end Verify_User;

   --  ------------------------------
   --  Action to trigger the lost password email process.
   --  ------------------------------
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");
   end Lost_Password;

   --  ------------------------------
   --  Action to validate the reset password key and set a new password.
   --  ------------------------------
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Reset_Password (Key      => To_String (Data.Access_Key),
                                   Password => To_String (Data.Password),
                                   IpAddr   => "",
                                   User     => User,
                                   Session  => Session);
      Outcome := To_Unbounded_String ("success");
   end Reset_Password;

   procedure Set_Session_Principal (Data : in Authenticate_Bean;
                                    User : in AWA.Users.Models.User_Ref;
                                    Sess : in AWA.Users.Models.Session_Ref) is
      pragma Unreferenced (Data);

      Principal : constant Principals.Principal_Access := Principals.Create (User, Sess);
      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
   begin
      Session.Set_Principal (Principal.all'Access);
   end Set_Session_Principal;

   --  ------------------------------
   --  Action to authenticate a user (password authentication).
   --  ------------------------------
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      User      : User_Ref;
      Session   : Session_Ref;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 User     => User,
                                 Session  => Session);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (User, Session);
   end Authenticate_User;

   --  ------------------------------
   --  Logout the user and closes the session.
   --  ------------------------------
   procedure Logout_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      use type ASF.Principals.Principal_Access;

      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => False);
   begin
      Outcome := To_Unbounded_String ("success");

      --  If there is no session, we are done.
      if not Session.Is_Valid then
         return;
      end if;

      declare
         Principal : constant ASF.Principals.Principal_Access := Session.Get_Principal;
      begin
         if Principal /= null and then Principal.all in AWA.Users.Principals.Principal'Class then
            declare
               P : constant AWA.Users.Principals.Principal_Access :=
                 AWA.Users.Principals.Principal'Class (Principal.all)'Access;
            begin
               Data.Manager.Close_Session (Id => P.Get_Session_Identifier);
            end;
         end if;
         Session.Invalidate;
      end;

      --  Remove the session cookie.
      declare
         C : ASF.Cookies.Cookie := ASF.Cookies.Create ("SID", "");
      begin
         ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
         ASF.Cookies.Set_Max_Age (C, 0);
         Ctx.Get_Response.Add_Cookie (Cookie => C);
      end;
   end Logout_User;

   --  ------------------------------
   --  Create an authenticate bean.
   --  ------------------------------
   function Create_Authenticate_Bean (Module : in AWA.Users.Module.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Module.Get_User_Manager;
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Authenticate_User,
                                                Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Register_User,
                                                Name   => "register");

   package Verify_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Verify_User,
                                                Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Lost_Password,
                                                Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Reset_Password,
                                                Name   => "resetPassword");

   package Logout_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Logout_User,
                                                Name   => "logout");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Access,
         Register_Binding.Proxy'Access,
         Verify_Binding.Proxy'Access,
         Lost_Password_Binding.Proxy'Access,
         Reset_Password_Binding.Proxy'Access,
         Logout_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = EMAIL_ATTR then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = PASSWORD_ATTR then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = FIRST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.First_Name);
      elsif Name = LAST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.Last_Name);
      elsif Name = KEY_ATTR then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = EMAIL_ATTR then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = PASSWORD_ATTR then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = FIRST_NAME_ATTR then
         From.First_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = LAST_NAME_ATTR then
         From.Last_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = KEY_ATTR then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Authenticate_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

end AWA.Users.Beans;

-----------------------------------------------------------------------
--  awa-users-beans -- ASF Beans for user module
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Log.Loggers;

with ASF.Principals;
with ASF.Sessions;
with ASF.Events.Actions;
with ASF.Contexts.Faces;
with ASF.Cookies;
with ASF.Applications.Messages.Factory;

with AWA.Users.Principals;
package body AWA.Users.Beans is

   use Util.Log;
   use AWA.Users.Models;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Users.Beans");

   --  ------------------------------
   --  Action to register a user
   --  ------------------------------
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");
   end Register_User;

   --  ------------------------------
   --  Action to verify the user after the registration
   --  ------------------------------
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                User    => User,
                                IpAddr  => "",
                                Session => Session);

      Data.Set_Session_Principal (User, Session);
      Outcome := To_Unbounded_String ("success");
   end Verify_User;

   --  ------------------------------
   --  Action to trigger the lost password email process.
   --  ------------------------------
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");
   end Lost_Password;

   --  ------------------------------
   --  Action to validate the reset password key and set a new password.
   --  ------------------------------
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Reset_Password (Key      => To_String (Data.Access_Key),
                                   Password => To_String (Data.Password),
                                   IpAddr   => "",
                                   User     => User,
                                   Session  => Session);
      Outcome := To_Unbounded_String ("success");
   end Reset_Password;

   procedure Set_Session_Principal (Data : in Authenticate_Bean;
                                    User : in AWA.Users.Models.User_Ref;
                                    Sess : in AWA.Users.Models.Session_Ref) is
      pragma Unreferenced (Data);

      Principal : constant Principals.Principal_Access := Principals.Create (User, Sess);
      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
   begin
      Session.Set_Principal (Principal.all'Access);
   end Set_Session_Principal;

   --  ------------------------------
   --  Action to authenticate a user (password authentication).
   --  ------------------------------
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      User      : User_Ref;
      Session   : Session_Ref;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 User     => User,
                                 Session  => Session);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (User, Session);

   exception
      when Services.Not_Found =>
         Outcome := To_Unbounded_String ("failure");

         ASF.Applications.Messages.Factory.Add_Message ("users.login_signup_fail_message");
   end Authenticate_User;

   --  ------------------------------
   --  Logout the user and closes the session.
   --  ------------------------------
   procedure Logout_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      use type ASF.Principals.Principal_Access;

      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => False);
   begin
      Outcome := To_Unbounded_String ("success");

      --  If there is no session, we are done.
      if not Session.Is_Valid then
         return;
      end if;

      declare
         Principal : constant ASF.Principals.Principal_Access := Session.Get_Principal;
      begin
         if Principal /= null and then Principal.all in AWA.Users.Principals.Principal'Class then
            declare
               P : constant AWA.Users.Principals.Principal_Access :=
                 AWA.Users.Principals.Principal'Class (Principal.all)'Access;
            begin
               Data.Manager.Close_Session (Id => P.Get_Session_Identifier);

            exception
               when others =>
                  Log.Error ("Exception when closing user session...");
            end;
         end if;
         Session.Invalidate;
      end;

      --  Remove the session cookie.
      declare
         C : ASF.Cookies.Cookie := ASF.Cookies.Create ("SID", "");
      begin
         ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
         ASF.Cookies.Set_Max_Age (C, 0);
         Ctx.Get_Response.Add_Cookie (Cookie => C);
      end;
   end Logout_User;

   --  ------------------------------
   --  Create an authenticate bean.
   --  ------------------------------
   function Create_Authenticate_Bean (Module : in AWA.Users.Module.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Module.Get_User_Manager;
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Authenticate_User,
                                                Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Register_User,
                                                Name   => "register");

   package Verify_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Verify_User,
                                                Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Lost_Password,
                                                Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Reset_Password,
                                                Name   => "resetPassword");

   package Logout_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Logout_User,
                                                Name   => "logout");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Access,
         Register_Binding.Proxy'Access,
         Verify_Binding.Proxy'Access,
         Lost_Password_Binding.Proxy'Access,
         Reset_Password_Binding.Proxy'Access,
         Logout_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = EMAIL_ATTR then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = PASSWORD_ATTR then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = FIRST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.First_Name);
      elsif Name = LAST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.Last_Name);
      elsif Name = KEY_ATTR then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = EMAIL_ATTR then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = PASSWORD_ATTR then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = FIRST_NAME_ATTR then
         From.First_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = LAST_NAME_ATTR then
         From.Last_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = KEY_ATTR then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Authenticate_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

end AWA.Users.Beans;

Add a global error message if the user authentication failed.


-----------------------------------------------------------------------
--  mat-expressions -- Expressions for event and memory slot selection
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Finalization;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
with MAT.Events;
package MAT.Expressions is

   type Resolver_Type is limited interface;
   type Resolver_Type_Access is access all Resolver_Type'Class;

   --  Find the region that matches the given name.
   function Find_Region (Resolver : in Resolver_Type;
                         Name     : in String) return MAT.Memory.Region_Info is abstract;

   --  Find the symbol in the symbol table and return the start and end address.
   function Find_Symbol (Resolver : in Resolver_Type;
                         Name     : in String) return MAT.Memory.Region_Info is abstract;

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Inside_Type is (INSIDE_REGION,
                        INSIDE_DIRECT_REGION,
                        INSIDE_FUNCTION,
                        INSIDE_DIRECT_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Create an addr range expression node.
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type;

   --  Create an time range expression node.
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type;

   --  Create an event ID range expression node.
   function Create_Event (Min : in MAT.Events.Event_Id_Type;
                          Max : in MAT.Events.Event_Id_Type) return Expression_Type;

   --  Create a thread ID range expression node.
   function Create_Thread (Min : in MAT.Types.Target_Thread_Ref;
                           Max : in MAT.Types.Target_Thread_Ref) return Expression_Type;

   --  Create a event type expression check.
   function Create_Event_Type (Event_Kind : in MAT.Events.Probe_Index_Type)
                               return Expression_Type;

   --  Create an expression node to keep allocation events which don't have any associated free.
   function Create_No_Free return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Event      : in MAT.Events.Target_Event_Type) return Boolean;

   --  Parse the string and return the expression tree.
   function Parse (Expr     : in String;
                   Resolver : in Resolver_Type_Access) return Expression_Type;

   --  Empty expression.
   EMPTY : constant Expression_Type;

   type yystype is record
      low   : MAT.Types.Uint64 := 0;
      high  : MAT.Types.Uint64 := 0;
      bval  : Boolean := False;
      name  : Ada.Strings.Unbounded.Unbounded_String;
      expr  : Expression_Type;
   end record;

private

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_RANGE_TIME, N_EVENT, N_HAS_ADDR,
                      N_CONDITION, N_THREAD, N_TYPE, N_NO_FREE);

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT | N_HAS_ADDR
            | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_RANGE_TIME =>
            Min_Time : MAT.Types.Target_Tick_Ref;
            Max_Time : MAT.Types.Target_Tick_Ref;

         when N_THREAD =>
            Min_Thread : MAT.Types.Target_Thread_Ref;
            Max_Thread : MAT.Types.Target_Thread_Ref;

         when N_EVENT =>
            Min_Event : MAT.Events.Event_Id_Type;
            Max_Event : MAT.Events.Event_Id_Type;

         when N_TYPE =>
            Event_Kind : MAT.Events.Probe_Index_Type;

         when others =>
            null;
      end case;
   end record;

   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Node_Type;
                         Event      : in MAT.Events.Target_Event_Type) return Boolean;

   type Expression_Type is new Ada.Finalization.Controlled with record
      Node : Node_Type_Access;
   end record;

   --  Release the reference and destroy the expression tree if it was the last reference.
   overriding
   procedure Finalize (Obj : in out Expression_Type);

   --  Update the reference after an assignment.
   overriding
   procedure Adjust (Obj : in out Expression_Type);

   --  Empty expression.
   EMPTY : constant Expression_Type := Expression_Type'(Ada.Finalization.Controlled with
                                                        Node => null);

end MAT.Expressions;

-----------------------------------------------------------------------
--  mat-expressions -- Expressions for event and memory slot selection
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Finalization;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
with MAT.Events;
package MAT.Expressions is

   type Resolver_Type is limited interface;
   type Resolver_Type_Access is access all Resolver_Type'Class;

   --  Find the region that matches the given name.
   function Find_Region (Resolver : in Resolver_Type;
                         Name     : in String) return MAT.Memory.Region_Info is abstract;

   --  Find the symbol in the symbol table and return the start and end address.
   function Find_Symbol (Resolver : in Resolver_Type;
                         Name     : in String) return MAT.Memory.Region_Info is abstract;

   --  Get the start time for the tick reference.
   function Get_Start_Time (Resolver : in Resolver_Type)
                            return MAT.Types.Target_Tick_Ref is abstract;

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Inside_Type is (INSIDE_REGION,
                        INSIDE_DIRECT_REGION,
                        INSIDE_FUNCTION,
                        INSIDE_DIRECT_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Create an addr range expression node.
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type;

   --  Create an time range expression node.
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type;

   --  Create an event ID range expression node.
   function Create_Event (Min : in MAT.Events.Event_Id_Type;
                          Max : in MAT.Events.Event_Id_Type) return Expression_Type;

   --  Create a thread ID range expression node.
   function Create_Thread (Min : in MAT.Types.Target_Thread_Ref;
                           Max : in MAT.Types.Target_Thread_Ref) return Expression_Type;

   --  Create a event type expression check.
   function Create_Event_Type (Event_Kind : in MAT.Events.Probe_Index_Type)
                               return Expression_Type;

   --  Create an expression node to keep allocation events which don't have any associated free.
   function Create_No_Free return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Event      : in MAT.Events.Target_Event_Type) return Boolean;

   --  Parse the string and return the expression tree.
   function Parse (Expr     : in String;
                   Resolver : in Resolver_Type_Access) return Expression_Type;

   --  Empty expression.
   EMPTY : constant Expression_Type;

   type yystype is record
      low   : MAT.Types.Uint64 := 0;
      high  : MAT.Types.Uint64 := 0;
      bval  : Boolean := False;
      name  : Ada.Strings.Unbounded.Unbounded_String;
      expr  : Expression_Type;
   end record;

private

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_RANGE_TIME, N_EVENT, N_HAS_ADDR,
                      N_CONDITION, N_THREAD, N_TYPE, N_NO_FREE);

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT | N_HAS_ADDR
            | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_RANGE_TIME =>
            Min_Time : MAT.Types.Target_Tick_Ref;
            Max_Time : MAT.Types.Target_Tick_Ref;

         when N_THREAD =>
            Min_Thread : MAT.Types.Target_Thread_Ref;
            Max_Thread : MAT.Types.Target_Thread_Ref;

         when N_EVENT =>
            Min_Event : MAT.Events.Event_Id_Type;
            Max_Event : MAT.Events.Event_Id_Type;

         when N_TYPE =>
            Event_Kind : MAT.Events.Probe_Index_Type;

         when others =>
            null;
      end case;
   end record;

   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Node_Type;
                         Event      : in MAT.Events.Target_Event_Type) return Boolean;

   type Expression_Type is new Ada.Finalization.Controlled with record
      Node : Node_Type_Access;
   end record;

   --  Release the reference and destroy the expression tree if it was the last reference.
   overriding
   procedure Finalize (Obj : in out Expression_Type);

   --  Update the reference after an assignment.
   overriding
   procedure Adjust (Obj : in out Expression_Type);

   --  Empty expression.
   EMPTY : constant Expression_Type := Expression_Type'(Ada.Finalization.Controlled with
                                                        Node => null);

end MAT.Expressions;

Declare the Get_Start_Time abstract function for the Resolver_Type