-----------------------------------------------------------------------
--  Security-oauth-servers-tests - Unit tests for server side OAuth
--  Copyright (C) 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 Util.Test_Caller;

with Security.Auth.Tests;
with Security.OAuth.File_Registry;
package body Security.OAuth.Servers.Tests is

   use Auth.Tests;
   use File_Registry;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Find_Application",
                       Test_Application_Manager'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Verify",
                       Test_User_Verify'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Token",
                       Test_Token_Password'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Authenticate",
                       Test_Bad_Token'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.File_Registry.Load",
                       Test_Load_Registry'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the application manager.
   --  ------------------------------
   procedure Test_Application_Manager (T : in out Test) is
      Manager : File_Application_Manager;
      App     : Application;
   begin
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Manager.Add_Application (App);

      --  Check that we can find our application.
      declare
         A : constant Application'Class := Manager.Find_Application ("my-app-id");
      begin
         Util.Tests.Assert_Equals (T, "my-app-id", A.Get_Application_Identifier,
                                   "Invalid application returned by Find");
      end;

      --  Check that an exception is raised for an invalid client ID.
      begin
         declare
            A : constant Application'Class := Manager.Find_Application ("unkown-app-id");
         begin
            Util.Tests.Fail (T, "Found the application " & A.Get_Application_Identifier);
         end;

      exception
         when Invalid_Application =>
            null;
      end;
   end Test_Application_Manager;

   --  ------------------------------
   --  Test the user registration and verification.
   --  ------------------------------
   procedure Test_User_Verify (T : in out Test) is
      Manager : File_Realm_Manager;
      Auth    : Principal_Access;
   begin
      Manager.Add_User ("Gandalf", "Mithrandir");
      Manager.Verify ("Gandalf", "mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid password");

      Manager.Verify ("Sauron", "Mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid user");

      Manager.Verify ("Gandalf", "Mithrandir", Auth);
      T.Assert (Auth /= null, "Verify password operation failed for a good user/password");
   end Test_User_Verify;

   --  ------------------------------
   --  Test the token operation that produces an access token from user/password.
   --  RFC 6749: Section 4.3.  Resource Owner Password Credentials Grant
   --  ------------------------------
   procedure Test_Token_Password (T : in out Test) is
      use type Util.Strings.Name_Access;

      Apps       : aliased File_Application_Manager;
      Realm      : aliased File_Realm_Manager;
      Manager    : Auth_Manager;
      App        : Application;
      Grant      : Grant_Type;
      Auth_Grant : Grant_Type;
      Params     : Test_Parameters;
   begin
      --  Add one test application.
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Apps.Add_Application (App);

      --  Add one test user.
      Realm.Add_User ("Gandalf", "Mithrandir");

      --  Configure the auth manager.
      Manager.Set_Application_Manager (Apps'Unchecked_Access);
      Manager.Set_Realm_Manager (Realm'Unchecked_Access);
      Manager.Set_Private_Key ("server-private-key-no-so-secure");

      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is missing");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "unkown-app");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is invalid");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "my-app-id");
      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "password");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the user/password is missing");

      Params.Set_Parameter (Security.OAuth.USERNAME, "Gandalf");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is missing");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "test");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is invalid");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "Mithrandir");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the client_secret is invalid");

      Params.Set_Parameter (Security.OAuth.CLIENT_SECRET, "my-secret");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");
      T.Assert (Grant.Error = null, "Expecting null error");
      T.Assert (Length (Grant.Token) > 20,
                "Expecting a token with some reasonable size");
      T.Assert (Grant.Auth /= null,
                "Expecting a non null auth principal");
      Util.Tests.Assert_Equals (T, "Gandalf", Grant.Auth.Get_Name,
                                "Invalid user name in the principal");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null, "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth, "Expecting valid auth principal");
      end loop;

      --  Verify the modified access token.
      Manager.Authenticate (To_String (Grant.Token) & "x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for the authenticate");

      Manager.Revoke (To_String (Grant.Token));

      --  Verify the access is now denied.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Revoked_Grant,
                   "Expecting Revoked_Grant for the authenticate");
      end loop;

      --  Change application token expiration time to 1 second.
      App.Expire_Timeout := 1.0;
      Apps.Add_Application (App);

      --  Make the access token.
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null,
                   "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth,
                   "Expecting valid auth principal");
      end loop;

      --  Wait for the token to expire.
      delay 2.0;
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Expired_Grant,
                   "Expecting Expired when the access token is checked");
      end loop;

   end Test_Token_Password;

   --  ------------------------------
   --  Test the access token validation with invalid tokens (bad formed).
   --  ------------------------------
   procedure Test_Bad_Token (T : in out Test) is
      Manager    : Auth_Manager;
      Auth_Grant : Grant_Type;
   begin
      Manager.Authenticate ("x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate (".", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
   end Test_Bad_Token;

   --  ------------------------------
   --  Test the loading configuration files for the File_Registry.
   --  ------------------------------
   procedure Test_Load_Registry (T : in out Test) is
      Apps       : aliased File_Application_Manager;
      Realm      : aliased File_Realm_Manager;
      Manager    : Auth_Manager;
      Grant      : Grant_Type;
      Auth_Grant : Grant_Type;
      Params     : Test_Parameters;
   begin
      Apps.Load (Util.Tests.Get_Path ("regtests/files/user_apps.properties"), "apps");
      Realm.Load (Util.Tests.Get_Path ("regtests/files/user_apps.properties"), "users");

      --  Configure the auth manager.
      Manager.Set_Application_Manager (Apps'Unchecked_Access);
      Manager.Set_Realm_Manager (Realm'Unchecked_Access);
      Manager.Set_Private_Key ("server-private-key-no-so-secure");
      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "app-id-1");
      Params.Set_Parameter (Security.OAuth.CLIENT_SECRET, "app-secret-1");
      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "password");
      Params.Set_Parameter (Security.OAuth.USERNAME, "joe");
      Params.Set_Parameter (Security.OAuth.PASSWORD, "test");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");
   end Test_Load_Registry;

end Security.OAuth.Servers.Tests;

-----------------------------------------------------------------------
--  security-oauth-servers-tests - Unit tests for server side OAuth
--  Copyright (C) 2017, 2018, 2019 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.Test_Caller;

with Security.Auth.Tests;
with Security.OAuth.File_Registry;
package body Security.OAuth.Servers.Tests is

   use Auth.Tests;
   use File_Registry;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Find_Application",
                       Test_Application_Manager'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Verify",
                       Test_User_Verify'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Token",
                       Test_Token_Password'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.Servers.Authenticate",
                       Test_Bad_Token'Access);
      Caller.Add_Test (Suite, "Test Security.OAuth.File_Registry.Load",
                       Test_Load_Registry'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the application manager.
   --  ------------------------------
   procedure Test_Application_Manager (T : in out Test) is
      Manager : File_Application_Manager;
      App     : Application;
   begin
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Manager.Add_Application (App);

      --  Check that we can find our application.
      declare
         A : constant Application'Class := Manager.Find_Application ("my-app-id");
      begin
         Util.Tests.Assert_Equals (T, "my-app-id", A.Get_Application_Identifier,
                                   "Invalid application returned by Find");
      end;

      --  Check that an exception is raised for an invalid client ID.
      begin
         declare
            A : constant Application'Class := Manager.Find_Application ("unkown-app-id");
         begin
            Util.Tests.Fail (T, "Found the application " & A.Get_Application_Identifier);
         end;

      exception
         when Invalid_Application =>
            null;
      end;
   end Test_Application_Manager;

   --  ------------------------------
   --  Test the user registration and verification.
   --  ------------------------------
   procedure Test_User_Verify (T : in out Test) is
      Manager : File_Realm_Manager;
      Auth    : Principal_Access;
   begin
      Manager.Add_User ("Gandalf", "Mithrandir");
      Manager.Verify ("Gandalf", "mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid password");

      Manager.Verify ("Sauron", "Mithrandir", Auth);
      T.Assert (Auth = null, "Verify password should fail with an invalid user");

      Manager.Verify ("Gandalf", "Mithrandir", Auth);
      T.Assert (Auth /= null, "Verify password operation failed for a good user/password");
   end Test_User_Verify;

   --  ------------------------------
   --  Test the token operation that produces an access token from user/password.
   --  RFC 6749: Section 4.3.  Resource Owner Password Credentials Grant
   --  ------------------------------
   procedure Test_Token_Password (T : in out Test) is
      use type Util.Strings.Name_Access;

      Apps       : aliased File_Application_Manager;
      Realm      : aliased File_Realm_Manager;
      Manager    : Auth_Manager;
      App        : Application;
      Grant      : Grant_Type;
      Auth_Grant : Grant_Type;
      Params     : Test_Parameters;
   begin
      --  Add one test application.
      App.Set_Application_Identifier ("my-app-id");
      App.Set_Application_Secret ("my-secret");
      App.Set_Application_Callback ("my-callback");
      Apps.Add_Application (App);

      --  Add one test user.
      Realm.Add_User ("Gandalf", "Mithrandir");

      --  Configure the auth manager.
      Manager.Set_Application_Manager (Apps'Unchecked_Access);
      Manager.Set_Realm_Manager (Realm'Unchecked_Access);
      Manager.Set_Private_Key ("server-private-key-no-so-secure");

      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is missing");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "unkown-app");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant, "Expecting Invalid_Grant when client_id is invalid");

      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "my-app-id");
      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when client_id is empty");

      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "password");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the user/password is missing");

      Params.Set_Parameter (Security.OAuth.USERNAME, "Gandalf");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is missing");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "test");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the password is invalid");

      Params.Set_Parameter (Security.OAuth.PASSWORD, "Mithrandir");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant when the client_secret is invalid");

      Params.Set_Parameter (Security.OAuth.CLIENT_SECRET, "my-secret");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");
      T.Assert (Grant.Error = null, "Expecting null error");
      T.Assert (Length (Grant.Token) > 20,
                "Expecting a token with some reasonable size");
      T.Assert (Grant.Auth /= null,
                "Expecting a non null auth principal");
      Util.Tests.Assert_Equals (T, "Gandalf", Grant.Auth.Get_Name,
                                "Invalid user name in the principal");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null, "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth, "Expecting valid auth principal");
      end loop;

      --  Verify the modified access token.
      Manager.Authenticate (To_String (Grant.Token) & "x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for the authenticate");

      Manager.Revoke (To_String (Grant.Token));

      --  Verify the access is now denied.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Revoked_Grant,
                   "Expecting Revoked_Grant for the authenticate");
      end loop;

      --  Change application token expiration time to 1 second.
      App.Expire_Timeout := 1.0;
      Apps.Add_Application (App);

      --  Make the access token.
      Manager.Token (Params, Grant);
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");

      --  Verify the access token.
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Request = Access_Grant,
                   "Expecting Access_Grant for the authenticate");
         T.Assert (Auth_Grant.Status = Valid_Grant,
                   "Expecting Valid_Grant when the access token is checked");
         T.Assert (Auth_Grant.Error = null,
                   "Expecting null error for access_token");
         T.Assert (Auth_Grant.Auth = Grant.Auth,
                   "Expecting valid auth principal");
      end loop;

      --  Wait for the token to expire.
      delay 2.0;
      for I in 1 .. 5 loop
         Manager.Authenticate (To_String (Grant.Token), Auth_Grant);
         T.Assert (Auth_Grant.Status = Expired_Grant,
                   "Expecting Expired when the access token is checked");
      end loop;

   end Test_Token_Password;

   --  ------------------------------
   --  Test the access token validation with invalid tokens (bad formed).
   --  ------------------------------
   procedure Test_Bad_Token (T : in out Test) is
      Manager    : Auth_Manager;
      Auth_Grant : Grant_Type;
   begin
      Manager.Authenticate ("x", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate (".", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
      Manager.Authenticate ("a..b", Auth_Grant);
      T.Assert (Auth_Grant.Status = Invalid_Grant,
                "Expecting Invalid_Grant for badly formed token");
   end Test_Bad_Token;

   --  ------------------------------
   --  Test the loading configuration files for the File_Registry.
   --  ------------------------------
   procedure Test_Load_Registry (T : in out Test) is
      Apps       : aliased File_Application_Manager;
      Realm      : aliased File_Realm_Manager;
      Manager    : Auth_Manager;
      Grant      : Grant_Type;
      Params     : Test_Parameters;
   begin
      Apps.Load (Util.Tests.Get_Path ("regtests/files/user_apps.properties"), "apps");
      Realm.Load (Util.Tests.Get_Path ("regtests/files/user_apps.properties"), "users");

      --  Configure the auth manager.
      Manager.Set_Application_Manager (Apps'Unchecked_Access);
      Manager.Set_Realm_Manager (Realm'Unchecked_Access);
      Manager.Set_Private_Key ("server-private-key-no-so-secure");
      Params.Set_Parameter (Security.OAuth.CLIENT_ID, "app-id-1");
      Params.Set_Parameter (Security.OAuth.CLIENT_SECRET, "app-secret-1");
      Params.Set_Parameter (Security.OAuth.GRANT_TYPE, "password");
      Params.Set_Parameter (Security.OAuth.USERNAME, "joe");
      Params.Set_Parameter (Security.OAuth.PASSWORD, "test");
      Manager.Token (Params, Grant);
      T.Assert (Grant.Request = Password_Grant,
                "Expecting Password_Grant for the grant request");
      T.Assert (Grant.Status = Valid_Grant,
                "Expecting Valid_Grant when the user/password are correct");
   end Test_Load_Registry;

end Security.OAuth.Servers.Tests;

Remove unused variable

Remove unused variable


-----------------------------------------------------------------------
--  security-oauth -- OAuth Security
--  Copyright (C) 2012, 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.Strings.Unbounded;

--  == OAuth ==
--  The Security.OAuth package defines and implements the OAuth 2.0 authorization
--  framework as defined by the IETF working group.
--  See http://tools.ietf.org/html/draft-ietf-oauth-v2-26
package Security.OAuth is

   --  OAuth 2.0: Section 10.2.2. Initial Registry Contents
   --  RFC 6749: 11.2.2.  Initial Registry Contents
   CLIENT_ID         : constant String := "client_id";
   CLIENT_SECRET     : constant String := "client_secret";
   RESPONSE_TYPE     : constant String := "response_type";
   REDIRECT_URI      : constant String := "redirect_uri";
   SCOPE             : constant String := "scope";
   STATE             : constant String := "state";
   CODE              : constant String := "code";
   ERROR_DESCRIPTION : constant String := "error_description";
   ERROR_URI         : constant String := "error_uri";
   GRANT_TYPE        : constant String := "grant_type";
   ACCESS_TOKEN      : constant String := "access_token";
   TOKEN_TYPE        : constant String := "token_type";
   EXPIRES_IN        : constant String := "expires_in";
   USERNAME          : constant String := "username";
   PASSWORD          : constant String := "password";
   REFRESH_TOKEN     : constant String := "refresh_token";

   --  RFC 6749: 5.2.  Error Response
   INVALID_REQUEST        : aliased constant String := "invalid_request";
   INVALID_CLIENT         : aliased constant String := "invalid_client";
   INVALID_GRANT          : aliased constant String := "invalid_grant";
   UNAUTHORIZED_CLIENT    : aliased constant String := "unauthorized_client";
   UNSUPPORTED_GRANT_TYPE : aliased constant String := "unsupported_grant_type";
   INVALID_SCOPE          : aliased constant String := "invalid_scope";

   --  RFC 6749: 4.1.2.1.  Error Response
   ACCESS_DENIED             : aliased constant String := "access_denied";
   UNSUPPORTED_RESPONSE_TYPE : aliased constant String := "unsupported_response_type";
   SERVER_ERROR              : aliased constant String := "server_error";
   TEMPORARILY_UNAVAILABLE   : aliased constant String := "temporarily_unavailable";

   --  ------------------------------
   --  Application
   --  ------------------------------
   --  The Application holds the necessary information to let a user
   --  grant access to its protected resources on the resource server.  It contains
   --  information that allows the OAuth authorization server to identify the
   --  application (client id and secret key).
   type Application is tagged private;

private

   type Application is tagged record
      Client_Id   : Ada.Strings.Unbounded.Unbounded_String;
      Secret      : Ada.Strings.Unbounded.Unbounded_String;
      Callback    : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Security.OAuth;

-----------------------------------------------------------------------
--  security-oauth -- OAuth Security
--  Copyright (C) 2012, 2016, 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.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;

--  == OAuth ==
--  The Security.OAuth package defines and implements the OAuth 2.0 authorization
--  framework as defined by the IETF working group.
--  See http://tools.ietf.org/html/draft-ietf-oauth-v2-26
package Security.OAuth is

   --  OAuth 2.0: Section 10.2.2. Initial Registry Contents
   --  RFC 6749: 11.2.2.  Initial Registry Contents
   CLIENT_ID         : constant String := "client_id";
   CLIENT_SECRET     : constant String := "client_secret";
   RESPONSE_TYPE     : constant String := "response_type";
   REDIRECT_URI      : constant String := "redirect_uri";
   SCOPE             : constant String := "scope";
   STATE             : constant String := "state";
   CODE              : constant String := "code";
   ERROR_DESCRIPTION : constant String := "error_description";
   ERROR_URI         : constant String := "error_uri";
   GRANT_TYPE        : constant String := "grant_type";
   ACCESS_TOKEN      : constant String := "access_token";
   TOKEN_TYPE        : constant String := "token_type";
   EXPIRES_IN        : constant String := "expires_in";
   USERNAME          : constant String := "username";
   PASSWORD          : constant String := "password";
   REFRESH_TOKEN     : constant String := "refresh_token";

   --  RFC 6749: 5.2.  Error Response
   INVALID_REQUEST        : aliased constant String := "invalid_request";
   INVALID_CLIENT         : aliased constant String := "invalid_client";
   INVALID_GRANT          : aliased constant String := "invalid_grant";
   UNAUTHORIZED_CLIENT    : aliased constant String := "unauthorized_client";
   UNSUPPORTED_GRANT_TYPE : aliased constant String := "unsupported_grant_type";
   INVALID_SCOPE          : aliased constant String := "invalid_scope";

   --  RFC 6749: 4.1.2.1.  Error Response
   ACCESS_DENIED             : aliased constant String := "access_denied";
   UNSUPPORTED_RESPONSE_TYPE : aliased constant String := "unsupported_response_type";
   SERVER_ERROR              : aliased constant String := "server_error";
   TEMPORARILY_UNAVAILABLE   : aliased constant String := "temporarily_unavailable";

   --  ------------------------------
   --  Application
   --  ------------------------------
   --  The Application holds the necessary information to let a user
   --  grant access to its protected resources on the resource server.  It contains
   --  information that allows the OAuth authorization server to identify the
   --  application (client id and secret key).
   type Application is tagged private;

   --  Get the application identifier.
   function Get_Application_Identifier (App : in Application) return String;

   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String);

   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String);

   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String);

private

   type Application is tagged record
      Client_Id   : Ada.Strings.Unbounded.Unbounded_String;
      Secret      : Ada.Strings.Unbounded.Unbounded_String;
      Callback    : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Security.OAuth;

Declare Get_Application_Identifier, Set_Application_Identifier, Set_Application_Secret and Set_Application_Callback


-----------------------------------------------------------------------
--  awa-storages -- Storage module
--  Copyright (C) 2012 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Storages</b> module provides a set of storage services allowing an application
--  to store data files, documents, images in a persistent area.  The persistent store can
--  be on a file system, in the database or provided by a remote service such as
--  Amazon Simple Storage Service.
--
--  == Creating a storage ==
--  A content in the storage is represented by a `Storage_Ref` instance.  The data itself
--  can be physically stored in the file system (`FILE` mode), in the database (`DATABASE`
--  mode) or on a remote server (`URL` mode).  To put a file in the storage, first create
--  the storage object instance:
--
--    Data : AWA.Storages.Models.Storage_Ref;
--
--  Then setup the storage mode that you want.  The storage service uses this information
--  to save the data in a file, in the database or in a remote service (in the future).
--
--    Data.Set_Storage (Storage => AWA.Storages.Models.DATABASE);
--
--  To save a file in the store, we can use the `Save` operation.  It will read the file
--  and put in in the corresponding persistent store (the database in this example).
--
--    Service.Save (Into => Data, Path => Path_To_The_File);
--
--  Upon successful completion, the storage instance `Data` will be allocated a unique
--  identifier that can be retrieved by `Get_Id` or `Get_Key`.
--
--  == Getting the data ==
--  Several operations are defined to retrieve the data.  Each of them has been designed
--  to optimize the retrieval and
--
--    * The data can be retrieved in a local file.
--      This mode is useful if an external program must be launched and be able to read
--      the file.  If the storage mode of the data is `FILE`, the path of the file on
--      the storage file system is used.  For other storage modes, the file is saved
--      in a temporary file.  In that case the `Store_Local` database table is used
--      to track such locally saved data.
--
--    * The data can be returned as a stream.
--      When the application has to read the data, opening a read stream connection is
--      the most efficient mechanism.
--
--  === Local file ===
--  To access the data by using a local file, we must define a local storage reference:
--
--    Data : AWA.Storages.Models.Store_Local_Ref;
--
--  and use the `Load` operation with the storage identifier.  When loading locally we
--  also indicate whether the file will be read or written.  A file that is in `READ` mode
--  can be shared by several tasks or processes.  A file that is in `WRITE` mode will have
--  a specific copy for the caller.  An optional expiration parameter indicate when the
--  local file representation can expire.
--
--    Service.Load (From => Id, Into => Data, Mode => READ, Expire => ONE_DAY);
--
--  Once the load operation succeeded, the data is stored on the file system and
--  the local path is obtained by using the `Get_Path` operation:
--
--    Path : constant String := Data.Get_Path;
--
--  == Ada Beans ==
--  @include storages.xml
--
--  == Model ==
--  [http://ada-awa.googlecode.com/svn/wiki/awa_storage_model.png]
--
--  @include Storages.hbm.xml
package AWA.Storages is

end AWA.Storages;

-----------------------------------------------------------------------
--  awa-storages -- Storage module
--  Copyright (C) 2012 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Storages</b> module provides a set of storage services allowing an application
--  to store data files, documents, images in a persistent area.  The persistent store can
--  be on a file system, in the database or provided by a remote service such as
--  Amazon Simple Storage Service.
--
--  == Creating a storage ==
--  A data in the storage is represented by a `Storage_Ref` instance.  The data itself
--  can be physically stored in a file system (`FILE` mode), in the database (`DATABASE`
--  mode) or on a remote server (`URL` mode).  To put a file in the storage space, first create
--  the storage object instance:
--
--    Data : AWA.Storages.Models.Storage_Ref;
--
--  Then setup the storage mode that you want.  The storage service uses this information
--  to save the data in a file, in the database or in a remote service (in the future).
--
--    Data.Set_Storage (Storage => AWA.Storages.Models.DATABASE);
--
--  To save a file in the store, we can use the `Save` operation of the storage service.
--  It will read the file and put in in the corresponding persistent store (the database
--  in this example).
--
--    Service.Save (Into => Data, Path => Path_To_The_File);
--
--  Upon successful completion, the storage instance `Data` will be allocated a unique
--  identifier that can be retrieved by `Get_Id` or `Get_Key`.
--
--  == Getting the data ==
--  Several operations are defined to retrieve the data.  Each of them has been designed
--  to optimize the retrieval and
--
--    * The data can be retrieved in a local file.
--      This mode is useful if an external program must be launched and be able to read
--      the file.  If the storage mode of the data is `FILE`, the path of the file on
--      the storage file system is used.  For other storage modes, the file is saved
--      in a temporary file.  In that case the `Store_Local` database table is used
--      to track such locally saved data.
--
--    * The data can be returned as a stream.
--      When the application has to read the data, opening a read stream connection is
--      the most efficient mechanism.
--
--  === Local file ===
--  To access the data by using a local file, we must define a local storage reference:
--
--    Data : AWA.Storages.Models.Store_Local_Ref;
--
--  and use the `Load` operation with the storage identifier.  When loading locally we
--  also indicate whether the file will be read or written.  A file that is in `READ` mode
--  can be shared by several tasks or processes.  A file that is in `WRITE` mode will have
--  a specific copy for the caller.  An optional expiration parameter indicate when the
--  local file representation can expire.
--
--    Service.Load (From => Id, Into => Data, Mode => READ, Expire => ONE_DAY);
--
--  Once the load operation succeeded, the data is stored on the file system and
--  the local path is obtained by using the `Get_Path` operation:
--
--    Path : constant String := Data.Get_Path;
--
--  == Ada Beans ==
--  @include storages.xml
--
--  == Model ==
--  [http://ada-awa.googlecode.com/svn/wiki/awa_storage_model.png]
--
--  @include Storages.hbm.xml
package AWA.Storages is

end AWA.Storages;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  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.Containers.Ordered_Maps;

with Bfd.Symbols;
with Bfd.Files;
with Bfd.Constants;

with Util.Refs;

with MAT.Types;
with MAT.Consoles;
with MAT.Memory;
package MAT.Symbols.Targets is

   --  The <tt>Region_Symbols</tt> holds the symbol table associated with the program or
   --  a shared library loaded by the program.  The <tt>Region</tt> indicates
   --  the text segment address of the program or the loaded library.
   type Region_Symbols is new Util.Refs.Ref_Entity with record
      Region     : MAT.Memory.Region_Info;
      Offset     : MAT.Types.Target_Addr;
      File       : Bfd.Files.File_Type;
      Symbols    : Bfd.Symbols.Symbol_Table;
   end record;
   type Region_Symbols_Access is access all Region_Symbols;

   --  Load the symbol table for the associated region.
   procedure Open (Symbols     : in out Region_Symbols;
                   Path        : in String;
                   Search_Path : in String);

   package Region_Symbols_Refs is
     new Util.Refs.References (Region_Symbols, Region_Symbols_Access);

   subtype Region_Symbols_Ref is Region_Symbols_Refs.Ref;

   type Symbol_Info is limited record
      File    : Ada.Strings.Unbounded.Unbounded_String;
      Name    : Ada.Strings.Unbounded.Unbounded_String;
      Line    : Natural;
      Symbols : Region_Symbols_Ref;
   end record;

   --  The <tt>Symbols_Maps</tt> keeps a sorted list of symbol tables indexed
   --  by their mapping address.
   use type Region_Symbols_Refs.Ref;
   use type MAT.Types.Target_Addr;
   package Symbols_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Symbols_Ref);

   subtype Symbols_Map is Symbols_Maps.Map;
   subtype Symbols_Cursor is Symbols_Maps.Cursor;

   type Target_Symbols is new Util.Refs.Ref_Entity with record
      Path        : Ada.Strings.Unbounded.Unbounded_String;
      Search_Path : Ada.Strings.Unbounded.Unbounded_String;
      Symbols     : Bfd.Symbols.Symbol_Table;
      Libraries   : Symbols_Maps.Map;
      Demangle    : Bfd.Demangle_Flags := Bfd.Constants.DMGL_AUTO;
      Console     : MAT.Consoles.Console_Access;
   end record;
   type Target_Symbols_Access is access all Target_Symbols;

   --  Open the binary and load the symbols from that file.
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String);

   --  Load the symbols associated with a shared library described by the memory region.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr);

   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map);

   --  Demangle the symbol.
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info);

   --  Find the nearest source file and line for the given address.
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   --  Find the symbol in the symbol table and return the start and end address.
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Name    : in String;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr);

   package Target_Symbols_Refs is
     new Util.Refs.References (Target_Symbols, Target_Symbols_Access);

   subtype Target_Symbols_Ref is Target_Symbols_Refs.Ref;

end MAT.Symbols.Targets;

-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014, 2015, 2021 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.Containers.Ordered_Maps;

with Bfd.Symbols;
with Bfd.Files;
with Bfd.Constants;

with Util.Refs;

with MAT.Types;
with MAT.Consoles;
with MAT.Memory;
package MAT.Symbols.Targets is

   --  The <tt>Region_Symbols</tt> holds the symbol table associated with the program or
   --  a shared library loaded by the program.  The <tt>Region</tt> indicates
   --  the text segment address of the program or the loaded library.
   type Region_Symbols is new Util.Refs.Ref_Entity with record
      Region     : MAT.Memory.Region_Info;
      Offset     : MAT.Types.Target_Addr;
      File       : Bfd.Files.File_Type;
      Symbols    : Bfd.Symbols.Symbol_Table;
   end record;
   type Region_Symbols_Access is access all Region_Symbols;

   --  Load the symbol table for the associated region.
   procedure Open (Symbols     : in out Region_Symbols;
                   Path        : in String;
                   Search_Path : in String);

   package Region_Symbols_Refs is
     new Util.Refs.References (Region_Symbols, Region_Symbols_Access);

   subtype Region_Symbols_Ref is Region_Symbols_Refs.Ref;

   type Symbol_Info is limited record
      File    : Ada.Strings.Unbounded.Unbounded_String;
      Name    : Ada.Strings.Unbounded.Unbounded_String;
      Line    : Natural;
      Symbols : Region_Symbols_Ref;
   end record;

   --  The <tt>Symbols_Maps</tt> keeps a sorted list of symbol tables indexed
   --  by their mapping address.
   use type Region_Symbols_Refs.Ref;
   use type MAT.Types.Target_Addr;
   package Symbols_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Symbols_Ref);

   subtype Symbols_Map is Symbols_Maps.Map;
   subtype Symbols_Cursor is Symbols_Maps.Cursor;

   type Target_Symbols is new Util.Refs.Ref_Entity with record
      Path        : Ada.Strings.Unbounded.Unbounded_String;
      Search_Path : Ada.Strings.Unbounded.Unbounded_String;
      Symbols     : Bfd.Symbols.Symbol_Table;
      Libraries   : Symbols_Maps.Map;
      Demangle    : Bfd.Demangle_Flags := Bfd.Constants.DMGL_AUTO;
      Console     : MAT.Consoles.Console_Access;
   end record;
   type Target_Symbols_Access is access all Target_Symbols;

   --  Open the binary and load the symbols from that file.
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String);

   --  Load the symbols associated with a shared library described by the memory region.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr);

   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map);

   --  Demangle the symbol.
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info);

   --  Find the nearest source file and line for the given address.
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   --  Find the symbol in the symbol table and return the start and end address.
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Name    : in String;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr);

   --  Find the symbol region in the symbol table which contains the given address
   --  and return the start and end address.
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Addr    : in Mat.Types.Target_Addr;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr);

   package Target_Symbols_Refs is
     new Util.Refs.References (Target_Symbols, Target_Symbols_Access);

   subtype Target_Symbols_Ref is Target_Symbols_Refs.Ref;

end MAT.Symbols.Targets;

Declare the Find_Symbol_Range procedure to find a function address range known some code address


-----------------------------------------------------------------------
--  gen-commands-database -- Database creation from application model
--  Copyright (C) 2011, 2012, 2016, 2017, 2018, 2019 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.Strings.Fixed;
with Ada.Directories;
with Ada.Exceptions;

with Util.Strings;
with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Vectors;

with ADO.Drivers;
with ADO.Sessions.Sources;
with ADO.Schemas.Databases;

package body Gen.Commands.Database is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Database");

   function Get_Schema_Path (Model_Dir : in String;
                             Model     : in String;
                             Config    : in ADO.Sessions.Sources.Data_Source) return String;

   function Get_Schema_Path (Model_Dir : in String;
                             Model     : in String;
                             Config    : in ADO.Sessions.Sources.Data_Source) return String is
      Driver : constant String := Config.Get_Driver;
      Dir    : constant String := Util.Files.Compose (Model_Dir, Driver);
   begin
      return Util.Files.Compose (Dir, "create-" & Model & "-" & Driver & ".sql");
   end Get_Schema_Path;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name);

      procedure Create_Database (Model_Dir : in String;
                                 Database  : in String;
                                 Username  : in String;
                                 Password  : in String);

      --  ------------------------------
      --  Create the database, the user and the tables.
      --  ------------------------------
      procedure Create_Database (Model_Dir : in String;
                                 Database  : in String;
                                 Username  : in String;
                                 Password  : in String) is
         Admin    : ADO.Sessions.Sources.Data_Source;
         Config   : ADO.Sessions.Sources.Data_Source;
         Messages : Util.Strings.Vectors.Vector;
      begin
         Config.Set_Connection (Database);
         Admin := Config;
         if Config.Get_Database = "" then
            Generator.Error ("Invalid database connection: no database name specified");
            return;
         end if;

         declare
            Name : constant String := Generator.Get_Project_Name;
            Path : constant String := Get_Schema_Path (Model_Dir, Name, Config);
         begin
            Log.Info ("Creating database tables using schema '{0}'", Path);

            if not Ada.Directories.Exists (Path) then
               Generator.Error ("SQL file '{0}' does not exist.", Path);
               Generator.Error ("Please, run the following command: dynamo generate db");
               return;
            end if;

            if Config.Get_Driver = "mysql" or Config.Get_Driver = "postgresql" then
               if Config.Get_Property ("user") = "" then
                  Generator.Error ("Invalid database connection: missing user property");
                  return;
               end if;
               Admin.Set_Property ("user", Username);
               Admin.Set_Property ("password", Password);

            elsif Config.Get_Driver /= "sqlite" then
               Generator.Error ("Database driver {0} is not supported.", Config.Get_Driver);
               return;
            end if;
            Admin.Set_Database ("");
            ADO.Schemas.Databases.Create_Database (Admin, Config, Path, Messages);

            --  Report the messages
            for Msg of Messages loop
               Log.Error ("{0}", Msg);
            end loop;
         end;
         --  Remember the database connection string.
         Generator.Set_Project_Property ("database", Database);
         Generator.Save_Project;

      exception
         when E : others =>
            Generator.Error (Ada.Exceptions.Exception_Message (E));
      end Create_Database;

      Model  : constant String := (if Args.Get_Count > 0 then Args.Get_Argument (1) else "");
      Arg1   : constant String := (if Args.Get_Count > 1 then Args.Get_Argument (2) else "");
      Arg2   : constant String := (if Args.Get_Count > 2 then Args.Get_Argument (3) else "");
      Arg3   : constant String := (if Args.Get_Count > 3 then Args.Get_Argument (4) else "");
   begin
      Generator.Read_Project ("dynamo.xml");

      --  Initialize the database drivers.
      ADO.Drivers.Initialize (Generator.Get_Properties);

      --  Check if a database is specified in the command line and use it.
      if Ada.Strings.Fixed.Index (Arg1, "://") > 0 or Arg3'Length > 0 then
         Create_Database (Model, Arg1, Arg2, Arg3);
      else
         declare
            Database : constant String := Generator.Get_Project_Property ("database");
         begin
            --  Otherwise, get the database identification from dynamo.xml configuration.
            if Ada.Strings.Fixed.Index (Database, "://") = 0 then
               Generator.Error ("No database specified.");
               return;
            end if;
            Create_Database (Model, Database, Arg1, Arg2);
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-database: Creates the database");
      Put_Line ("Usage: create-database MODEL [CONNECTION] ADMIN-USER [ADMIN-PASSWORD]");
      New_Line;
      Put_Line ("  Create the database specified by the connection string.");
      Put_Line ("  The connection string has the form:");
      Put_Line ("     driver://host[:port]/database");
      New_Line;
      Put_Line ("  The database must not exist.  The user specified in the connection string");
      Put_Line ("  is granted the access to the new database.");
   end Help;

end Gen.Commands.Database;

-----------------------------------------------------------------------
--  gen-commands-database -- Database creation from application model
--  Copyright (C) 2011, 2012, 2016, 2017, 2018, 2019 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.Strings.Fixed;
with Ada.Directories;
with Ada.Exceptions;

with Util.Strings;
with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Vectors;

with ADO.Drivers;
with ADO.Sessions.Sources;
with ADO.Schemas.Databases;

package body Gen.Commands.Database is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Database");

   function Get_Schema_Path (Model_Dir : in String;
                             Model     : in String;
                             Config    : in ADO.Sessions.Sources.Data_Source) return String;

   function Get_Schema_Path (Model_Dir : in String;
                             Model     : in String;
                             Config    : in ADO.Sessions.Sources.Data_Source) return String is
      Driver : constant String := Config.Get_Driver;
      Dir    : constant String := Util.Files.Compose (Model_Dir, Driver);
   begin
      return Util.Files.Compose (Dir, "create-" & Model & "-" & Driver & ".sql");
   end Get_Schema_Path;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name);

      procedure Create_Database (Model_Dir : in String;
                                 Database  : in String;
                                 Username  : in String;
                                 Password  : in String);

      --  ------------------------------
      --  Create the database, the user and the tables.
      --  ------------------------------
      procedure Create_Database (Model_Dir : in String;
                                 Database  : in String;
                                 Username  : in String;
                                 Password  : in String) is
         Admin    : ADO.Sessions.Sources.Data_Source;
         Config   : ADO.Sessions.Sources.Data_Source;
         Messages : Util.Strings.Vectors.Vector;
      begin
         Config.Set_Connection (Database);
         Admin := Config;
         if Config.Get_Database = "" then
            Generator.Error ("Invalid database connection: no database name specified");
            return;
         end if;

         declare
            Name : constant String := Generator.Get_Project_Name;
            Path : constant String := Get_Schema_Path (Model_Dir, Name, Config);
         begin
            Log.Info ("Creating database tables using schema '{0}'", Path);

            if not Ada.Directories.Exists (Path) then
               Generator.Error ("SQL file '{0}' does not exist.", Path);
               Generator.Error ("Please, run the following command: dynamo generate db");
               return;
            end if;

            if Config.Get_Driver = "mysql" or Config.Get_Driver = "postgresql" then
               if Config.Get_Property ("user") = "" then
                  Generator.Error ("Invalid database connection: missing user property");
                  return;
               end if;
               Admin.Set_Property ("user", Username);
               Admin.Set_Property ("password", Password);

            elsif Config.Get_Driver /= "sqlite" then
               Generator.Error ("Database driver {0} is not supported.", Config.Get_Driver);
               return;
            end if;
            Admin.Set_Database ("");
            ADO.Schemas.Databases.Create_Database (Admin, Config, Path, Messages);

            --  Report the messages
            for Msg of Messages loop
               Log.Error ("{0}", Msg);
            end loop;
         end;
         --  Remember the database connection string.
         Generator.Set_Project_Property ("database", Database);
         Generator.Save_Project;

      exception
         when E : others =>
            Generator.Error (Ada.Exceptions.Exception_Message (E));
      end Create_Database;

      Model  : constant String := (if Args.Get_Count > 0 then Args.Get_Argument (1) else "");
      Arg1   : constant String := (if Args.Get_Count > 1 then Args.Get_Argument (2) else "");
      Arg2   : constant String := (if Args.Get_Count > 2 then Args.Get_Argument (3) else "");
      Arg3   : constant String := (if Args.Get_Count > 3 then Args.Get_Argument (4) else "");
   begin
      Generator.Read_Project ("dynamo.xml");

      --  Initialize the database drivers.
      ADO.Drivers.Initialize (Generator.Get_Properties);

      --  Check if a database is specified in the command line and use it.
      if Ada.Strings.Fixed.Index (Arg1, "://") > 0 or Arg3'Length > 0 then
         Create_Database (Model, Arg1, Arg2, Arg3);
      else
         declare
            Database : constant String := Generator.Get_Project_Property ("database");
         begin
            --  Otherwise, get the database identification from dynamo.xml configuration.
            if Ada.Strings.Fixed.Index (Database, "://") = 0 then
               Generator.Error ("No database specified.");
               return;
            end if;
            Create_Database (Model, Database, Arg1, Arg2);
         end;
      end if;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in out Command;
                   Name      : in String;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-database: Creates the database");
      Put_Line ("Usage: create-database MODEL [CONNECTION] ADMIN-USER [ADMIN-PASSWORD]");
      New_Line;
      Put_Line ("  Create the database specified by the connection string.");
      Put_Line ("  The connection string has the form:");
      Put_Line ("     driver://host[:port]/database");
      New_Line;
      Put_Line ("  The database must not exist.  The user specified in the connection string");
      Put_Line ("  is granted the access to the new database.");
   end Help;

end Gen.Commands.Database;

Add Name parameter to the Help procedure


-----------------------------------------------------------------------
--  awa-permissions-services -- Permissions controller
--  Copyright (C) 2011, 2012, 2013, 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.
-----------------------------------------------------------------------

with ADO.Queries;
with ADO.Sessions.Entities;
with ADO.Statements;
with Util.Log.Loggers;

with Security.Policies.URLs;

with AWA.Permissions.Models;
with AWA.Services.Contexts;
package body AWA.Permissions.Services is

   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Permissions.Services");

   --  ------------------------------
   --  Check if the permission with the name <tt>Name</tt> is granted for the current user.
   --  If the <tt>Entity</tt> is defined, an <tt>Entity_Permission</tt> is created and verified.
   --  Returns True if the user is granted the given permission.
   --  ------------------------------
   function Has_Permission (Name   : in Util.Beans.Objects.Object;
                            Entity : in Util.Beans.Objects.Object)
                            return Util.Beans.Objects.Object is
      use type Security.Contexts.Security_Context_Access;

      Context : constant Security.Contexts.Security_Context_Access := Security.Contexts.Current;
      Perm    : constant String := Util.Beans.Objects.To_String (Name);
      Result  : Boolean;
   begin
      if Util.Beans.Objects.Is_Empty (Name) or Context = null then
         Result := False;

      elsif Util.Beans.Objects.Is_Empty (Entity) then
         Result := Context.Has_Permission (Perm);

      else
         declare
            P : Entity_Permission (Security.Permissions.Get_Permission_Index (Perm));
         begin
            P.Entity := ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Entity));
            Result := Context.Has_Permission (P);
         end;
      end if;
      return Util.Beans.Objects.To_Object (Result);

   exception
      when Security.Permissions.Invalid_Name =>
         Log.Error ("Invalid permission {0}", Perm);
         raise;
   end Has_Permission;

   URI        : aliased constant String := "http://code.google.com/p/ada-awa/auth";

   --  ------------------------------
   --  Register the security EL functions in the EL mapper.
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "hasPermission",
                           Namespace => URI,
                           Func      => Has_Permission'Access,
                           Optimize  => False);
   end Set_Functions;

   --  ------------------------------
   --  Get the permission manager associated with the security context.
   --  Returns null if there is none.
   --  ------------------------------
   function Get_Permission_Manager (Context : in Security.Contexts.Security_Context'Class)
                                    return Permission_Manager_Access is
      use type Security.Policies.Policy_Manager_Access;

      M : constant Security.Policies.Policy_Manager_Access
        := Context.Get_Permission_Manager;
   begin
      if M = null then
         Log.Info ("There is no permission manager");
         return null;

      elsif not (M.all in Permission_Manager'Class) then
         Log.Info ("Permission manager is not a AWA permission manager");
         return null;

      else
         return Permission_Manager'Class (M.all)'Access;
      end if;
   end Get_Permission_Manager;

   --  ------------------------------
   --  Get the application instance.
   --  ------------------------------
   function Get_Application (Manager : in Permission_Manager)
                             return AWA.Applications.Application_Access is
   begin
      return Manager.App;
   end Get_Application;

   --  ------------------------------
   --  Set the application instance.
   --  ------------------------------
   procedure Set_Application (Manager : in out Permission_Manager;
                              App : in AWA.Applications.Application_Access) is
   begin
      Manager.App := App;
   end Set_Application;

   --  ------------------------------
   --  Add a permission for the current user to access the entity identified by
   --  Entity and Kind.
   --  ------------------------------
   procedure Add_Permission (Manager    : in Permission_Manager;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type) is
      pragma Unreferenced (Manager);

      Ctx  : constant AWA.Services.Contexts.Service_Context_Access
        := AWA.Services.Contexts.Current;
      DB   : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Perm : AWA.Permissions.Models.ACL_Ref;
   begin
      Log.Info ("Adding permission");

      Ctx.Start;
      Perm.Set_Entity_Type (Kind);
      Perm.Set_User_Id (Ctx.Get_User_Identifier);
      Perm.Set_Entity_Id (Entity);
      Perm.Set_Writeable (Permission = AWA.Permissions.WRITE);
      Perm.Set_Workspace_Id (Workspace);
      Perm.Save (DB);
      Ctx.Commit;
   end Add_Permission;

   --  ------------------------------
   --  Check that the current user has the specified permission.
   --  Raise NO_PERMISSION exception if the user does not have the permission.
   --  ------------------------------
   procedure Check_Permission (Manager    : in Permission_Manager;
                               Entity     : in ADO.Identifier;
                               Kind       : in ADO.Entity_Type;
                               Permission : in Permission_Type) is
      pragma Unreferenced (Manager, Permission);
      use AWA.Services;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Permissions.Models.Query_Check_Entity_Permission);
      Query.Bind_Param ("user_id", User);
      Query.Bind_Param ("entity_id", Entity);
      Query.Bind_Param ("entity_type", Integer (Kind));
      declare
         Stmt : ADO.Statements.Query_Statement := DB.Create_Statement (Query);
      begin
         Stmt.Execute;
         if not Stmt.Has_Elements then
            Log.Info ("User {0} does not have permission to access entity {1}/{2}",
                      ADO.Identifier'Image (User), ADO.Identifier'Image (Entity),
                      ADO.Entity_Type'Image (Kind));
            raise NO_PERMISSION;
         end if;
      end;
   end Check_Permission;

   --  ------------------------------
   --  Get the role names that grant the given permission.
   --  ------------------------------
   function Get_Role_Names (Manager : in Permission_Manager;
                            Permission : in Security.Permissions.Permission_Index)
                            return Security.Policies.Roles.Role_Name_Array is
   begin
      return Manager.Roles.Get_Role_Names (Manager.Roles.Get_Grants (Permission));
   end Get_Role_Names;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity which is of type Kind.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Acl : AWA.Permissions.Models.ACL_Ref;
   begin
      Acl.Set_User_Id (User);
      Acl.Set_Entity_Type (Kind);
      Acl.Set_Entity_Id (Entity);
      Acl.Set_Writeable (Permission = WRITE);
      Acl.Set_Workspace_Id (Workspace);
      Acl.Save (Session);

      Log.Info ("Permission created for {0} to access {1}, entity type {2}",
                ADO.Identifier'Image (User),
                ADO.Identifier'Image (Entity),
                ADO.Entity_Type'Image (Kind));
   end Add_Permission;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Objects.Object_Ref'Class;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Key  : constant ADO.Objects.Object_Key := Entity.Get_Key;
      Kind : constant ADO.Entity_Type
        := ADO.Sessions.Entities.Find_Entity_Type (Session => Session,
                                                   Object  => Key);
   begin
      Add_Permission (Session, User, ADO.Objects.Get_Value (Key), Kind, Workspace, Permission);
   end Add_Permission;

   --  ------------------------------
   --  Create a permission manager for the given application.
   --  ------------------------------
   function Create_Permission_Manager (App : in AWA.Applications.Application_Access)
                                       return Security.Policies.Policy_Manager_Access is
      Result : constant AWA.Permissions.Services.Permission_Manager_Access
        := new AWA.Permissions.Services.Permission_Manager (10);
      RP : constant Security.Policies.Roles.Role_Policy_Access
        := new Security.Policies.Roles.Role_Policy;
      RU : constant Security.Policies.URLs.URL_Policy_Access
        := new Security.Policies.URLs.URL_Policy;
      RE : constant Entity_Policy_Access
        := new Entity_Policy;
   begin
      Result.Roles := RP;
      Result.Add_Policy (RP.all'Access);
      Result.Add_Policy (RU.all'Access);
      Result.Add_Policy (RE.all'Access);
      Result.Set_Application (App);

      Log.Info ("Creation of the AWA Permissions manager");
      return Result.all'Access;
   end Create_Permission_Manager;

   --  ------------------------------
   --  Delete all the permissions for a user and on the given workspace.
   --  ------------------------------
   procedure Delete_Permissions (Session   : in out ADO.Sessions.Master_Session;
                                 User      : in ADO.Identifier;
                                 Workspace : in ADO.Identifier) is
      Stmt   : ADO.Statements.Delete_Statement
        := Session.Create_Statement (Models.ACL_TABLE);
      Result : Natural;
   begin
      Stmt.Set_Filter (Filter => "workspace_id = ? AND user_id = ?");
      Stmt.Add_Param (Value => Workspace);
      Stmt.Add_Param (Value => User);
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} permissions for user {1} in workspace {2}",
                Natural'Image (Result), ADO.Identifier'Image (User),
                ADO.Identifier'Image (Workspace));
   end Delete_Permissions;

end AWA.Permissions.Services;

-----------------------------------------------------------------------
--  awa-permissions-services -- Permissions controller
--  Copyright (C) 2011, 2012, 2013, 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.
-----------------------------------------------------------------------

with ADO.Queries;
with ADO.Sessions.Entities;
with ADO.Statements;
with ADO.Caches.Discrete;
with Util.Log.Loggers;
with Util.Strings;

with Security.Policies.URLs;

with AWA.Permissions.Models;
with AWA.Services.Contexts;
package body AWA.Permissions.Services is

   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Permissions.Services");

   package Permission_Cache is
     new ADO.Caches.Discrete (Element_Type => Integer);

   --  ------------------------------
   --  Check if the permission with the name <tt>Name</tt> is granted for the current user.
   --  If the <tt>Entity</tt> is defined, an <tt>Entity_Permission</tt> is created and verified.
   --  Returns True if the user is granted the given permission.
   --  ------------------------------
   function Has_Permission (Name   : in Util.Beans.Objects.Object;
                            Entity : in Util.Beans.Objects.Object)
                            return Util.Beans.Objects.Object is
      use type Security.Contexts.Security_Context_Access;

      Context : constant Security.Contexts.Security_Context_Access := Security.Contexts.Current;
      Perm    : constant String := Util.Beans.Objects.To_String (Name);
      Result  : Boolean;
   begin
      if Util.Beans.Objects.Is_Empty (Name) or Context = null then
         Result := False;

      elsif Util.Beans.Objects.Is_Empty (Entity) then
         Result := Context.Has_Permission (Perm);

      else
         declare
            P : Entity_Permission (Security.Permissions.Get_Permission_Index (Perm));
         begin
            P.Entity := ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Entity));
            Result := Context.Has_Permission (P);
         end;
      end if;
      return Util.Beans.Objects.To_Object (Result);

   exception
      when Security.Permissions.Invalid_Name =>
         Log.Error ("Invalid permission {0}", Perm);
         raise;
   end Has_Permission;

   URI        : aliased constant String := "http://code.google.com/p/ada-awa/auth";

   --  ------------------------------
   --  Register the security EL functions in the EL mapper.
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "hasPermission",
                           Namespace => URI,
                           Func      => Has_Permission'Access,
                           Optimize  => False);
   end Set_Functions;

   --  ------------------------------
   --  Get the permission manager associated with the security context.
   --  Returns null if there is none.
   --  ------------------------------
   function Get_Permission_Manager (Context : in Security.Contexts.Security_Context'Class)
                                    return Permission_Manager_Access is
      use type Security.Policies.Policy_Manager_Access;

      M : constant Security.Policies.Policy_Manager_Access
        := Context.Get_Permission_Manager;
   begin
      if M = null then
         Log.Info ("There is no permission manager");
         return null;

      elsif not (M.all in Permission_Manager'Class) then
         Log.Info ("Permission manager is not a AWA permission manager");
         return null;

      else
         return Permission_Manager'Class (M.all)'Access;
      end if;
   end Get_Permission_Manager;

   --  ------------------------------
   --  Get the application instance.
   --  ------------------------------
   function Get_Application (Manager : in Permission_Manager)
                             return AWA.Applications.Application_Access is
   begin
      return Manager.App;
   end Get_Application;

   --  ------------------------------
   --  Set the application instance.
   --  ------------------------------
   procedure Set_Application (Manager : in out Permission_Manager;
                              App : in AWA.Applications.Application_Access) is
   begin
      Manager.App := App;
   end Set_Application;

   --  ------------------------------
   --  Initialize the permissions.
   --  ------------------------------
   procedure Start (Manager : in out Permission_Manager) is
      package Perm renames Security.Permissions;

      DB         : ADO.Sessions.Master_Session := Manager.App.Get_Master_Session;
      Cache      : constant Permission_Cache.Cache_Type_Access := new Permission_Cache.Cache_Type;
      Count      : constant Perm.Permission_Index := Perm.Get_Last_Permission_Index;
      Last       : Natural := 0;
      Insert     : ADO.Statements.Insert_Statement;
      Stmt       : ADO.Statements.Query_Statement;
      Load_Count : Natural := 0;
      Add_Count  : Natural := 0;
   begin
      Log.Info ("Initializing {0} permissions", Perm.Permission_Index'Image (Count));

      DB.Begin_Transaction;

      --  Step 1: load the permissions from the database.
      Stmt := DB.Create_Statement ("SELECT id, name FROM awa_permission");
      Stmt.Execute;
      while Stmt.Has_Elements loop
         declare
            Id   : constant Integer := Stmt.Get_Integer (0);
            Name : constant String := Stmt.Get_String (1);
         begin
            Log.Debug ("Loaded permission {0} as {1}", Name, Util.Strings.Image (Id));
            Permission_Cache.Insert (Cache.all, Name, Id);
            Load_Count := Load_Count + 1;
            if Id > Last then
               Last := Id;
            end if;
         end;
         Stmt.Next;
      end loop;

      --  Step 2: Check that every application permission is defined in the database.
      --  Create the new entries and allocate them the last id.
      for I in 1 .. Count loop
         declare
            Name   : constant String := Perm.Get_Name (I);
            Result : Integer;
         begin
            Result := Cache.Find (Name);

         exception
            when ADO.Caches.No_Value =>
               Last := Last + 1;
               Log.Info ("Adding permission {0} as {1}", Name, Util.Strings.Image (Last));
               Insert := DB.Create_Statement (AWA.Permissions.Models.PERMISSION_TABLE);
               Insert.Save_Field (Name => "id", Value => Last);
               Insert.Save_Field (Name => "name", Value => Name);
               Insert.Execute (Result);
               Cache.Insert (Name, Last);
               Add_Count := Add_Count + 1;

         end;
      end loop;
      DB.Add_Cache ("permission", Cache.all'Access);
      DB.Commit;
      if Add_Count > 0 then
         Log.Info ("Found {0} permissions in the database and created {1} permissions",
                   Util.Strings.Image (Load_Count), Util.Strings.Image (Add_Count));
      else
         Log.Info ("Found {0} permissions in the database",
                   Util.Strings.Image (Load_Count));
      end if;
   end Start;

   --  ------------------------------
   --  Add a permission for the current user to access the entity identified by
   --  Entity and Kind.
   --  ------------------------------
   procedure Add_Permission (Manager    : in Permission_Manager;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type) is
      pragma Unreferenced (Manager);

      Ctx  : constant AWA.Services.Contexts.Service_Context_Access
        := AWA.Services.Contexts.Current;
      DB   : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Perm : AWA.Permissions.Models.ACL_Ref;
   begin
      Log.Info ("Adding permission");

      Ctx.Start;
      Perm.Set_Entity_Type (Kind);
      Perm.Set_User_Id (Ctx.Get_User_Identifier);
      Perm.Set_Entity_Id (Entity);
      Perm.Set_Writeable (Permission = AWA.Permissions.WRITE);
      Perm.Set_Workspace_Id (Workspace);
      Perm.Save (DB);
      Ctx.Commit;
   end Add_Permission;

   --  ------------------------------
   --  Check that the current user has the specified permission.
   --  Raise NO_PERMISSION exception if the user does not have the permission.
   --  ------------------------------
   procedure Check_Permission (Manager    : in Permission_Manager;
                               Entity     : in ADO.Identifier;
                               Kind       : in ADO.Entity_Type;
                               Permission : in Permission_Type) is
      pragma Unreferenced (Manager, Permission);
      use AWA.Services;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Permissions.Models.Query_Check_Entity_Permission);
      Query.Bind_Param ("user_id", User);
      Query.Bind_Param ("entity_id", Entity);
      Query.Bind_Param ("entity_type", Integer (Kind));
      declare
         Stmt : ADO.Statements.Query_Statement := DB.Create_Statement (Query);
      begin
         Stmt.Execute;
         if not Stmt.Has_Elements then
            Log.Info ("User {0} does not have permission to access entity {1}/{2}",
                      ADO.Identifier'Image (User), ADO.Identifier'Image (Entity),
                      ADO.Entity_Type'Image (Kind));
            raise NO_PERMISSION;
         end if;
      end;
   end Check_Permission;

   --  ------------------------------
   --  Get the role names that grant the given permission.
   --  ------------------------------
   function Get_Role_Names (Manager : in Permission_Manager;
                            Permission : in Security.Permissions.Permission_Index)
                            return Security.Policies.Roles.Role_Name_Array is
   begin
      return Manager.Roles.Get_Role_Names (Manager.Roles.Get_Grants (Permission));
   end Get_Role_Names;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity which is of type Kind.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Acl : AWA.Permissions.Models.ACL_Ref;
   begin
      Acl.Set_User_Id (User);
      Acl.Set_Entity_Type (Kind);
      Acl.Set_Entity_Id (Entity);
      Acl.Set_Writeable (Permission = WRITE);
      Acl.Set_Workspace_Id (Workspace);
      Acl.Save (Session);

      Log.Info ("Permission created for {0} to access {1}, entity type {2}",
                ADO.Identifier'Image (User),
                ADO.Identifier'Image (Entity),
                ADO.Entity_Type'Image (Kind));
   end Add_Permission;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Objects.Object_Ref'Class;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Key  : constant ADO.Objects.Object_Key := Entity.Get_Key;
      Kind : constant ADO.Entity_Type
        := ADO.Sessions.Entities.Find_Entity_Type (Session => Session,
                                                   Object  => Key);
   begin
      Add_Permission (Session, User, ADO.Objects.Get_Value (Key), Kind, Workspace, Permission);
   end Add_Permission;

   --  ------------------------------
   --  Create a permission manager for the given application.
   --  ------------------------------
   function Create_Permission_Manager (App : in AWA.Applications.Application_Access)
                                       return Security.Policies.Policy_Manager_Access is
      Result : constant AWA.Permissions.Services.Permission_Manager_Access
        := new AWA.Permissions.Services.Permission_Manager (10);
      RP : constant Security.Policies.Roles.Role_Policy_Access
        := new Security.Policies.Roles.Role_Policy;
      RU : constant Security.Policies.URLs.URL_Policy_Access
        := new Security.Policies.URLs.URL_Policy;
      RE : constant Entity_Policy_Access
        := new Entity_Policy;
   begin
      Result.Roles := RP;
      Result.Add_Policy (RP.all'Access);
      Result.Add_Policy (RU.all'Access);
      Result.Add_Policy (RE.all'Access);
      Result.Set_Application (App);

      Log.Info ("Creation of the AWA Permissions manager");
      return Result.all'Access;
   end Create_Permission_Manager;

   --  ------------------------------
   --  Delete all the permissions for a user and on the given workspace.
   --  ------------------------------
   procedure Delete_Permissions (Session   : in out ADO.Sessions.Master_Session;
                                 User      : in ADO.Identifier;
                                 Workspace : in ADO.Identifier) is
      Stmt   : ADO.Statements.Delete_Statement
        := Session.Create_Statement (Models.ACL_TABLE);
      Result : Natural;
   begin
      Stmt.Set_Filter (Filter => "workspace_id = ? AND user_id = ?");
      Stmt.Add_Param (Value => Workspace);
      Stmt.Add_Param (Value => User);
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} permissions for user {1} in workspace {2}",
                Natural'Image (Result), ADO.Identifier'Image (User),
                ADO.Identifier'Image (Workspace));
   end Delete_Permissions;

end AWA.Permissions.Services;

Implement the Start procedure - load the permissions from the database and setup the permission cache - look each application permission and make sure we have an entry in the database - create a awa_permission row in the database for each new permission - register the permission cache to the database session manager