-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with GNAT.Command_Line;
with GNAT.OS_Lib;

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

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

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
      Gtk_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: ? -web -tool -ado -gtk") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            elsif Full_Switch = "-gtk" then
               Gtk_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag and not Gtk_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Gen.Commands.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Gen.Commands.Usage;
            return;
         end if;

         Generator.Set_Project_Property ("is_web", Boolean'Image (Web_Flag));
         Generator.Set_Project_Property ("is_tool", Boolean'Image (Tool_Flag));
         Generator.Set_Project_Property ("is_ado", Boolean'Image (Ado_Flag));
         Generator.Set_Project_Property ("is_gtk", Boolean'Image (Gtk_Flag));
         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         if Ado_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-ado");
         elsif Gtk_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-gtk");
         else
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");
         end if;

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|mit|bsd3|proprietary] [--web] [--tool]"
                & "[--ado] [--gtk] NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the MIT license, the BSD 3 clauses");
      Put_Line ("  license, the GNU license or a proprietary license.");
      Put_Line ("  The author's name and email addresses are also reported in generated files.");
      New_Line;
      Put_Line ("  --web   Generate a Web application (the default)");
      Put_Line ("  --tool  Generate a command line tool");
      Put_Line ("  --ado   Generate a database tool operation for ADO");
      Put_Line ("  --gtk   Generate a GtkAda project");
   end Help;

end Gen.Commands.Project;

-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with GNAT.Command_Line;
with GNAT.OS_Lib;

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

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

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
      Gtk_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: ? -web -tool -ado -gtk") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            elsif Full_Switch = "-gtk" then
               Gtk_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "gpl3" then
                  Generator.Set_Project_Property ("license", "gpl3");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, gpl3, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag and not Gtk_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Gen.Commands.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Gen.Commands.Usage;
            return;
         end if;

         Generator.Set_Project_Property ("is_web", Boolean'Image (Web_Flag));
         Generator.Set_Project_Property ("is_tool", Boolean'Image (Tool_Flag));
         Generator.Set_Project_Property ("is_ado", Boolean'Image (Ado_Flag));
         Generator.Set_Project_Property ("is_gtk", Boolean'Image (Gtk_Flag));
         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         if Ado_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-ado");
         elsif Gtk_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-gtk");
         else
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");
         end if;

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|gpl3|mit|bsd3|proprietary] [--web] [--tool]"
                & "[--ado] [--gtk] NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the MIT license, the BSD 3 clauses");
      Put_Line ("  license, the GNU licenses or a proprietary license.");
      Put_Line ("  The author's name and email addresses are also reported in generated files.");
      New_Line;
      Put_Line ("  --web   Generate a Web application (the default)");
      Put_Line ("  --tool  Generate a command line tool");
      Put_Line ("  --ado   Generate a database tool operation for ADO");
      Put_Line ("  --gtk   Generate a GtkAda project");
   end Help;

end Gen.Commands.Project;

Add support for GPL v3 license

Add support for GPL v3 license


-----------------------------------------------------------------------
--  gen-commands-propset -- Set a property on dynamo project
--  Copyright (C) 2011, 2012, 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 Ada.Text_IO;

package body Gen.Commands.Propset is

   --  ------------------------------
   --  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
   begin
      if Args.Get_Count /= 2 then
         Cmd.Usage (Name);
         return;
      end if;

      Generator.Read_Project ("dynamo.xml", True);
      Generator.Set_Project_Property (Args.Get_Argument (1), Args.Get_Argument (2));
      Generator.Save_Project;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("propset: Set the value of a property in the dynamo project file");
      Put_Line ("Usage: propset NAME VALUE");
      New_Line;
   end Help;

end Gen.Commands.Propset;

-----------------------------------------------------------------------
--  gen-commands-propset -- Set a property on dynamo project
--  Copyright (C) 2011, 2012, 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 Ada.Text_IO;

package body Gen.Commands.Propset is

   --  ------------------------------
   --  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
   begin
      if Args.Get_Count /= 2 then
         Cmd.Usage (Name, Generator);
         return;
      end if;

      Generator.Read_Project ("dynamo.xml", True);
      Generator.Set_Project_Property (Args.Get_Argument (1), Args.Get_Argument (2));
      Generator.Save_Project;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("propset: Set the value of a property in the dynamo project file");
      Put_Line ("Usage: propset NAME VALUE");
      New_Line;
   end Help;

end Gen.Commands.Propset;

Update to use an in out parameter for Help procedure


-----------------------------------------------------------------------
--  security-filters-oauth -- OAuth Security filter
--  Copyright (C) 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;

with Util.Log.Loggers;

with ASF.Applications.Main;

with Security.Contexts;
with Security.Policies.URLs;
package body ASF.Security.Filters.OAuth is

   use Ada.Strings.Unbounded;
   use Servers;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.Filters.OAuth");

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Auth_Filter;
                         Config  : in ASF.Servlets.Filter_Config) is
      use ASF.Applications;

      Context : constant Servlets.Servlet_Registry_Access := Servlets.Get_Servlet_Context (Config);
   begin
      if Context.all in Main.Application'Class then
         Server.Set_Permission_Manager (Main.Application'Class (Context.all).Get_Security_Manager);
      end if;
   end Initialize;

   --  ------------------------------
   --  Set the permission manager that must be used to verify the permission.
   --  ------------------------------
   procedure Set_Permission_Manager (Filter  : in out Auth_Filter;
                                     Manager : in Policies.Policy_Manager_Access) is
   begin
      Filter.Manager := Manager;
   end Set_Permission_Manager;

   function Get_Access_Token (Request : in ASF.Requests.Request'Class) return String is
      Header : constant String := Request.Get_Header (AUTHORIZATION_HEADER_NAME);
   begin
      if Header'Length > 0 then
         return Header;
      end if;
      return Header;
   end Get_Access_Token;

   --  ------------------------------
   --  Filter the request to make sure the user is authenticated.
   --  Invokes the Do_Login procedure if there is no user.
   --  If a permission manager is defined, check that the user has the permission
   --  to view the page.  Invokes the Do_Deny procedure if the permission
   --  is denied.
   --  ------------------------------
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is
      use Ada.Strings.Unbounded;
      use Policies.URLs;
      use type Policies.Policy_Manager_Access;

      Servlet : constant String := Request.Get_Servlet_Path;
      URL     : constant String := Servlet & Request.Get_Path_Info;
   begin
      if F.Realm = null then
         Log.Error ("Deny access on {0} due to missing realm", URL);
         Auth_Filter'Class (F).Do_Deny (Request, Response);
         return;
      end if;
      declare
         Bearer  : constant String := Get_Access_Token (Request);
         Auth    : Principal_Access;
         Grant   : Servers.Grant_Type;
         Context : aliased Contexts.Security_Context;
      begin
         if Bearer'Length = 0 then
            Log.Info ("Ask authentication on {0} due to missing access token", URL);
            Auth_Filter'Class (F).Do_Login (Request, Response);
            return;
         end if;
         F.Realm.Authenticate (Bearer, Grant);
         if Grant.Status /= Valid_Grant then
            Log.Info ("Ask authentication on {0} due to missing access token", URL);
            Auth_Filter'Class (F).Do_Deny (Request, Response);
            return;
         end if;

         --  Request is authorized, proceed to the next filter.
         ASF.Servlets.Do_Filter (Chain    => Chain,
                                 Request  => Request,
                                 Response => Response);
      end;
   end Do_Filter;

   --  ------------------------------
   --  Display or redirects the user to the login page.  This procedure is called when
   --  the user is not authenticated.
   --  ------------------------------
   procedure Do_Login (F        : in Auth_Filter;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (F, Request);
   begin
      Response.Send_Error (ASF.Responses.SC_UNAUTHORIZED);
   end Do_Login;

   --  ------------------------------
   --  Display the forbidden access page.  This procedure is called when the user is not
   --  authorized to see the page.  The default implementation returns the SC_FORBIDDEN error.
   --  ------------------------------
   procedure Do_Deny (F        : in Auth_Filter;
                      Request  : in out ASF.Requests.Request'Class;
                      Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (Request);
   begin
      Response.Add_Header (WWW_AUTHENTICATE_HEADER_NAME,
                           "Bearer realm=""" & To_String (F.Realm_URL)
                           & """, error=""invalid_token""");
      Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
   end Do_Deny;

end ASF.Security.Filters.OAuth;

-----------------------------------------------------------------------
--  security-filters-oauth -- OAuth Security filter
--  Copyright (C) 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 Util.Log.Loggers;

with ASF.Applications.Main;

with Security.Contexts;
with Security.Policies.URLs;
package body ASF.Security.Filters.OAuth is

   use Ada.Strings.Unbounded;
   use Servers;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.Filters.OAuth");

   function Get_Access_Token (Request : in ASF.Requests.Request'Class) return String;

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Auth_Filter;
                         Config  : in ASF.Servlets.Filter_Config) is
      use ASF.Applications;

      Context : constant Servlets.Servlet_Registry_Access := Servlets.Get_Servlet_Context (Config);
   begin
      if Context.all in Main.Application'Class then
         Server.Set_Permission_Manager (Main.Application'Class (Context.all).Get_Security_Manager);
      end if;
   end Initialize;

   --  ------------------------------
   --  Set the permission manager that must be used to verify the permission.
   --  ------------------------------
   procedure Set_Permission_Manager (Filter  : in out Auth_Filter;
                                     Manager : in Policies.Policy_Manager_Access) is
   begin
      Filter.Manager := Manager;
   end Set_Permission_Manager;

   function Get_Access_Token (Request : in ASF.Requests.Request'Class) return String is
      Header : constant String := Request.Get_Header (AUTHORIZATION_HEADER_NAME);
   begin
      if Header'Length > 0 then
         return Header;
      end if;
      return Header;
   end Get_Access_Token;

   --  ------------------------------
   --  Filter the request to make sure the user is authenticated.
   --  Invokes the Do_Login procedure if there is no user.
   --  If a permission manager is defined, check that the user has the permission
   --  to view the page.  Invokes the Do_Deny procedure if the permission
   --  is denied.
   --  ------------------------------
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is
      use Policies.URLs;
      use type Policies.Policy_Manager_Access;

      Servlet : constant String := Request.Get_Servlet_Path;
      URL     : constant String := Servlet & Request.Get_Path_Info;
   begin
      if F.Realm = null then
         Log.Error ("Deny access on {0} due to missing realm", URL);
         Auth_Filter'Class (F).Do_Deny (Request, Response);
         return;
      end if;
      declare
         Bearer  : constant String := Get_Access_Token (Request);
         Auth    : Principal_Access;
         Grant   : Servers.Grant_Type;
         Context : aliased Contexts.Security_Context;
      begin
         if Bearer'Length = 0 then
            Log.Info ("Ask authentication on {0} due to missing access token", URL);
            Auth_Filter'Class (F).Do_Login (Request, Response);
            return;
         end if;
         F.Realm.Authenticate (Bearer, Grant);
         if Grant.Status /= Valid_Grant then
            Log.Info ("Ask authentication on {0} due to missing access token", URL);
            Auth_Filter'Class (F).Do_Deny (Request, Response);
            return;
         end if;

         --  OAuth_Permission
         --  if not F.Manager.Has_Permission (Context, Perm) then
         --     -- deny
         --  Request.Set_Attribute ("application", Grant.Application);
         --  Request is authorized, proceed to the next filter.
         ASF.Servlets.Do_Filter (Chain    => Chain,
                                 Request  => Request,
                                 Response => Response);
      end;
   end Do_Filter;

   --  ------------------------------
   --  Display or redirects the user to the login page.  This procedure is called when
   --  the user is not authenticated.
   --  ------------------------------
   procedure Do_Login (F        : in Auth_Filter;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (F, Request);
   begin
      Response.Send_Error (ASF.Responses.SC_UNAUTHORIZED);
   end Do_Login;

   --  ------------------------------
   --  Display the forbidden access page.  This procedure is called when the user is not
   --  authorized to see the page.  The default implementation returns the SC_FORBIDDEN error.
   --  ------------------------------
   procedure Do_Deny (F        : in Auth_Filter;
                      Request  : in out ASF.Requests.Request'Class;
                      Response : in out ASF.Responses.Response'Class) is
      pragma Unreferenced (Request);
   begin
      Response.Add_Header (WWW_AUTHENTICATE_HEADER_NAME,
                           "Bearer realm=""" & To_String (F.Realm_URL)
                           & """, error=""invalid_token""");
      Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
   end Do_Deny;

end ASF.Security.Filters.OAuth;

Fix compilation warnings

Fix compilation warnings


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

with GNAT.Command_Line;

with Ada.Text_IO;

with Gen.Artifacts.Docs;
with Gen.Model.Packages;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

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

      Doc    : Gen.Artifacts.Docs.Artifact;
      M      : Gen.Model.Packages.Model_Definition;
      Arg1   : constant String := Get_Argument;
      Arg2   : constant String := Get_Argument;
      Footer : Boolean := True;
      Fmt    : Gen.Artifacts.Docs.Doc_Format := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
   begin
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml", False);
      end if;

      if Arg1'Length = 0 then
         Generator.Error ("Missing target directory");
         return;
      elsif Arg1 (Arg1'First) /= '-' then
         if Arg2'Length /= 0 then
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         --  Setup the target directory where the distribution is created.
         Generator.Set_Result_Directory (Arg1);
      else
         if Arg1 = "-markdown" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
         elsif Arg1 = "-google" then
            Fmt := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
         elsif Arg1 = "-pandoc" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
            Footer := False;
         else
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         if Arg2'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Arg2);
      end if;
      Doc.Set_Format (Fmt, Footer);
      Doc.Read_Links (Generator.Get_Project_Property ("links", "links.txt"));
      Doc.Prepare (M, Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc [-markdown|-google|-pandoc] target-dir");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

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

with GNAT.Command_Line;

with Ada.Text_IO;
with Ada.Directories;

with Gen.Artifacts.Docs;
with Gen.Model.Packages;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

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

      Doc    : Gen.Artifacts.Docs.Artifact;
      M      : Gen.Model.Packages.Model_Definition;
      Arg1   : constant String := Get_Argument;
      Arg2   : constant String := Get_Argument;
      Footer : Boolean := True;
      Fmt    : Gen.Artifacts.Docs.Doc_Format := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
   begin
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml", False);
      end if;

      if Arg1'Length = 0 then
         Generator.Error ("Missing target directory");
         return;
      elsif Arg1 (Arg1'First) /= '-' then
         if Arg2'Length /= 0 then
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         --  Setup the target directory where the distribution is created.
         Generator.Set_Result_Directory (Arg1);
      else
         if Arg1 = "-markdown" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
         elsif Arg1 = "-google" then
            Fmt := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
         elsif Arg1 = "-pandoc" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
            Footer := False;
         else
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         if Arg2'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Arg2);
      end if;
      Doc.Set_Format (Fmt, Footer);
      Doc.Read_Links (Generator.Get_Project_Property ("links", "links.txt"));
      Doc.Prepare (M, Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc [-markdown|-google|-pandoc] target-dir");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

Fix compilation

Fix compilation


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

with Security.Permissions;

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Votes.Beans;
with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Votes.Models;

with ADO.SQL;
with ADO.Sessions;
with ADO.Statements;
with ADO.Sessions.Entities;

package body AWA.Votes.Modules is

   use AWA.Services;
   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Votes.Module");

   package Register is new AWA.Modules.Beans (Module => Vote_Module,
                                              Module_Access => Vote_Module_Access);

   --  ------------------------------
   --  Initialize the votes module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Vote_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the votes module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Votes.Beans.Votes_Bean",
                         Handler => AWA.Votes.Beans.Create_Vote_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the votes module.
   --  ------------------------------
   function Get_Vote_Module return Vote_Module_Access is
      function Get is new AWA.Modules.Get (Vote_Module, Vote_Module_Access, NAME);
   begin
      return Get;
   end Get_Vote_Module;

   --  ------------------------------
   --  Vote for the given element and return the total vote for that element.
   --  ------------------------------
   procedure Vote_For (Model       : in Vote_Module;
                       Id          : in ADO.Identifier;
                       Entity_Type : in String;
                       Permission  : in String;
                       Value       : in Integer;
                       Total       : out Integer) is
      pragma Unreferenced (Model);

      Ctx    : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User   : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB     : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Kind   : ADO.Entity_Type;
      Rating : AWA.Votes.Models.Rating_Ref;
      Vote   : AWA.Votes.Models.Vote_Ref;
      Query  : ADO.SQL.Query;
      Found  : Boolean;
      Ident  : constant String := Entity_Type & ADO.Identifier'Image (Id);
   begin
      Log.Info ("User {0} votes for {1} rating {2}",
                ADO.Identifier'Image (User.Get_Id), Ident,
                Integer'Image (Value));

      Ctx.Start;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type);

      --  Check that the user has the vote permission on the given object.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Id);

      --  Get the vote associated with the object for the user.
      Query.Set_Join ("INNER JOIN awa_rating r ON r.id = o.entity_id");
      Query.Set_Filter ("r.for_entity_id = :id and r.for_entity_type = :type "
                        & "and o.user_id = :user_id");
      Query.Bind_Param ("id", Id);
      Query.Bind_Param ("type", Kind);
      Query.Bind_Param ("user_id", User.Get_Id);
      Vote.Find (DB, Query, Found);
      if not Found then

         --  If the rating is 0, do not create any vote.
         if Value = 0 then
            return;
         end if;
         Query.Clear;

         --  Get the rating associated with the object.
         Query.Set_Filter ("for_entity_id = :id and for_entity_type = :type");
         Query.Bind_Param ("id", Id);
         Query.Bind_Param ("type", Kind);
         Rating.Find (DB, Query, Found);

         --  Create it if it does not exist.
         if not Found then
            Log.Info ("Creating rating for {0}", Ident);

            Rating.Set_For_Entity_Id (Id);
            Rating.Set_For_Entity_Type (Kind);
            Rating.Set_Rating (Value);
            Rating.Set_Vote_Count (1);
         else
            Rating.Set_Vote_Count (Rating.Get_Vote_Count + 1);
            Rating.Set_Rating (Value + Rating.Get_Rating);
         end if;
         Rating.Save (DB);

         Vote.Set_User (User);
         Vote.Set_Entity (Rating);
      else
         Rating := AWA.Votes.Models.Rating_Ref (Vote.Get_Entity);
         Rating.Set_Rating (Rating.Get_Rating + Value - Vote.Get_Rating);
         Rating.Save (DB);
      end if;
      Vote.Set_Rating (Value);
      Vote.Save (DB);

      --  Return the total rating for the element.
      Total := Rating.Get_Rating;
      Ctx.Commit;
   end Vote_For;

end AWA.Votes.Modules;

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

with Security.Permissions;

with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Votes.Beans;
with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Votes.Models;

with ADO.SQL;
with ADO.Sessions;
with ADO.Sessions.Entities;

package body AWA.Votes.Modules is

   use AWA.Services;
   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Votes.Module");

   package Register is new AWA.Modules.Beans (Module => Vote_Module,
                                              Module_Access => Vote_Module_Access);

   --  ------------------------------
   --  Initialize the votes module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Vote_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the votes module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Votes.Beans.Votes_Bean",
                         Handler => AWA.Votes.Beans.Create_Vote_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the votes module.
   --  ------------------------------
   function Get_Vote_Module return Vote_Module_Access is
      function Get is new AWA.Modules.Get (Vote_Module, Vote_Module_Access, NAME);
   begin
      return Get;
   end Get_Vote_Module;

   --  ------------------------------
   --  Vote for the given element and return the total vote for that element.
   --  ------------------------------
   procedure Vote_For (Model       : in Vote_Module;
                       Id          : in ADO.Identifier;
                       Entity_Type : in String;
                       Permission  : in String;
                       Value       : in Integer;
                       Total       : out Integer) is
      pragma Unreferenced (Model);

      Ctx    : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User   : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB     : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Kind   : ADO.Entity_Type;
      Rating : AWA.Votes.Models.Rating_Ref;
      Vote   : AWA.Votes.Models.Vote_Ref;
      Query  : ADO.SQL.Query;
      Found  : Boolean;
      Ident  : constant String := Entity_Type & ADO.Identifier'Image (Id);
   begin
      Log.Info ("User {0} votes for {1} rating {2}",
                ADO.Identifier'Image (User.Get_Id), Ident,
                Integer'Image (Value));

      Ctx.Start;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type);

      --  Check that the user has the vote permission on the given object.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Id);

      --  Get the vote associated with the object for the user.
      Query.Set_Join ("INNER JOIN awa_rating r ON r.id = o.entity_id");
      Query.Set_Filter ("r.for_entity_id = :id and r.for_entity_type = :type "
                        & "and o.user_id = :user_id");
      Query.Bind_Param ("id", Id);
      Query.Bind_Param ("type", Kind);
      Query.Bind_Param ("user_id", User.Get_Id);
      Vote.Find (DB, Query, Found);
      if not Found then
         Query.Clear;

         --  Get the rating associated with the object.
         Query.Set_Filter ("for_entity_id = :id and for_entity_type = :type");
         Query.Bind_Param ("id", Id);
         Query.Bind_Param ("type", Kind);
         Rating.Find (DB, Query, Found);

         --  Create it if it does not exist.
         if not Found then
            Log.Info ("Creating rating for {0}", Ident);

            Rating.Set_For_Entity_Id (Id);
            Rating.Set_For_Entity_Type (Kind);
            Rating.Set_Rating (Value);
            Rating.Set_Vote_Count (1);
         else
            Rating.Set_Vote_Count (Rating.Get_Vote_Count + 1);
            Rating.Set_Rating (Value + Rating.Get_Rating);
         end if;
         Rating.Save (DB);

         Vote.Set_User (User);
         Vote.Set_Entity (Rating);
      else
         Rating := AWA.Votes.Models.Rating_Ref (Vote.Get_Entity);
         Rating.Set_Rating (Rating.Get_Rating + Value - Vote.Get_Rating);
         Rating.Save (DB);
      end if;
      Vote.Set_Rating (Value);
      Vote.Save (DB);

      --  Return the total rating for the element.
      Total := Rating.Get_Rating;
      Ctx.Commit;
   end Vote_For;

end AWA.Votes.Modules;

Fix compilation warning

Fix compilation warning


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

--  The Util.Encodes.Base16 packages encodes and decodes streams
--  in hexadecimal.
package Util.Encoders.Base16 is

   pragma Preelaborate;

   --  ------------------------------
   --  Base16 encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an ascii hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  the a base16 (hexadecimal) output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  ------------------------------
   --  Base16 decoder
   --  ------------------------------
   --  The Decoder decodes an hexadecimal stream into a binary stream.
   type Decoder is new Util.Encoders.Transformer with private;

   --  Decodes the base16 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Util.Encoders.Transformer with null record;

   type Decoder is new Util.Encoders.Transformer with null record;

   generic
      type Input_Char is (<>);
      type Output_Char is (<>);
      type Index is range <>;
      type Output_Index is range <>;
      type Input is array (Index range <>) of Input_Char;
      type Output is array (Output_Index range <>) of Output_Char;
   package Encoding is
      procedure Encode (From : in Input;
                        Into : in out Output;
                        Last : out Output_Index;
                        Encoded : out Index);
      procedure Decode (From    : in Input;
                        Into    : in out Output;
                        Last    : out Output_Index;
                        Encoded : out Index);
   end Encoding;

end Util.Encoders.Base16;

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

--  The Util.Encodes.Base16 packages encodes and decodes streams
--  in hexadecimal.
package Util.Encoders.Base16 is

   pragma Preelaborate;

   --  ------------------------------
   --  Base16 encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an ascii hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  the a base16 (hexadecimal) output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  ------------------------------
   --  Base16 decoder
   --  ------------------------------
   --  The Decoder decodes an hexadecimal stream into a binary stream.
   type Decoder is new Util.Encoders.Transformer with private;

   --  Decodes the base16 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Util.Encoders.Transformer with null record;

   type Decoder is new Util.Encoders.Transformer with null record;

   generic
      type Input_Char is (<>);
      type Output_Char is (<>);
      type Index is range <>;
      type Output_Index is range <>;
      type Input is array (Index range <>) of Input_Char;
      type Output is array (Output_Index range <>) of Output_Char;
   package Encoding is
      procedure Encode (From : in Input;
                        Into : in out Output;
                        Last : out Output_Index;
                        Encoded : out Index);
      procedure Decode (From    : in Input;
                        Into    : in out Output;
                        Last    : out Output_Index;
                        Encoded : out Index);
   end Encoding;

end Util.Encoders.Base16;

Change the Transformer interface to accept in out parameter for the Transformer


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2013 Felix Krause <contact@flyx.org>
--
--  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 GL.Buffers;
with GL.Low_Level.Enums;
with GL.Objects.Textures;
with GL.Pixels.Extensions;
with GL.Types.Colors;

private with GL.Enums;

package GL.Objects.Framebuffers is
   pragma Preelaborate;

   use all type GL.Low_Level.Enums.Texture_Kind;

   type Framebuffer_Status is (Undefined, Complete, Incomplete_Attachment,
                               Incomplete_Missing_Attachment,
                               Incomplete_Draw_Buffer, Incomplete_Read_Buffer,
                               Unsupported, Incomplete_Multisample,
                               Incomplete_Layer_Targets);

   type Attachment_Point is (Depth_Stencil_Attachment,
                             Color_Attachment_0, Color_Attachment_1,
                             Color_Attachment_2, Color_Attachment_3,
                             Color_Attachment_4, Color_Attachment_5,
                             Color_Attachment_6, Color_Attachment_7,
                             Color_Attachment_8, Color_Attachment_9,
                             Color_Attachment_10, Color_Attachment_11,
                             Color_Attachment_12, Color_Attachment_13,
                             Color_Attachment_14, Color_Attachment_15,
                             Depth_Attachment, Stencil_Attachment);

   type Default_Attachment_Point is
     (Front_Left, Front_Right, Back_Left, Back_Right, Depth, Stencil);

   type Attachment_List is array (Positive range <>) of Attachment_Point;

   type Default_Attachment_List is array (Positive range <>) of Default_Attachment_Point;

   function Valid_Attachment
     (Attachment : Attachment_Point;
      Texture    : Textures.Texture) return Boolean
   with Pre => not Texture.Compressed and Texture.Allocated;

   type Framebuffer is new GL_Object with private;

   overriding
   procedure Initialize_Id (Object : in out Framebuffer);

   overriding
   procedure Delete_Id (Object : in out Framebuffer);

   overriding
   function Identifier (Object : Framebuffer) return Types.Debug.Identifier is
     (Types.Debug.Framebuffer);

   procedure Set_Draw_Buffer
     (Object   : Framebuffer;
      Selector : Buffers.Color_Buffer_Selector)
   with Pre => (if Object = Default_Framebuffer then
                  Selector in Buffers.Default_Color_Buffer_Selector | Buffers.None
                else
                  Selector in Buffers.Explicit_Color_Buffer_Selector | Buffers.None);

   procedure Set_Draw_Buffers
     (Object : Framebuffer;
      List   : Buffers.Color_Buffer_List)
   with Pre => (if Object = Default_Framebuffer then
                  (for all S of List =>
                     S in Buffers.Default_Color_Buffer_Selector | Buffers.None)
                else
                  (for all S of List =>
                     S in Buffers.Explicit_Color_Buffer_Selector | Buffers.None));

   procedure Set_Read_Buffer (Object : Framebuffer; Selector : Buffers.Color_Buffer_Selector)
     with Pre => (if Object = Default_Framebuffer then
                    Selector in Buffers.Default_Color_Buffer_Selector | Buffers.None
                  else
                    Selector in Buffers.Explicit_Color_Buffer_Selector | Buffers.None);

   procedure Attach_Texture
     (Object     : Framebuffer;
      Attachment : Attachment_Point;
      Texture    : Textures.Texture;
      Level      : Textures.Mipmap_Level)
   with Pre => Object /= Default_Framebuffer and
                 Valid_Attachment (Attachment, Texture) and
                 (if Texture.Kind in
                    Texture_2D_Multisample | Texture_2D_Multisample_Array
                  then Level = 0);

   procedure Attach_Texture_Layer
     (Object     : Framebuffer;
      Attachment : Attachment_Point;
      Texture    : Textures.Texture;
      Level      : Textures.Mipmap_Level;
      Layer      : Natural)
   with Pre => Object /= Default_Framebuffer and
                 Valid_Attachment (Attachment, Texture) and
                 Texture.Layered;

   procedure Detach (Object : Framebuffer; Attachment : Attachment_Point)
     with Pre => Object /= Default_Framebuffer;

   procedure Invalidate_Data
     (Object      : Framebuffer;
      Attachments : Attachment_List)
   with Pre => Object /= Default_Framebuffer;

   procedure Invalidate_Sub_Data
     (Object        : Framebuffer;
      Attachments   : Attachment_List;
      X, Y          : Int;
      Width, Height : Size)
   with Pre => Object /= Default_Framebuffer;

   procedure Invalidate_Data
     (Object      : Framebuffer;
      Attachments : Default_Attachment_List)
   with Pre => Object = Default_Framebuffer;

   procedure Invalidate_Sub_Data
     (Object        : Framebuffer;
      Attachments   : Default_Attachment_List;
      X, Y          : Int;
      Width, Height : Size)
   with Pre => Object = Default_Framebuffer;

   procedure Set_Default_Width   (Object : Framebuffer; Value : Size);
   procedure Set_Default_Height  (Object : Framebuffer; Value : Size);
   procedure Set_Default_Layers  (Object : Framebuffer; Value : Size);
   procedure Set_Default_Samples (Object : Framebuffer; Value : Size);

   procedure Set_Default_Fixed_Sample_Locations (Object : Framebuffer; Value : Boolean);

   function Default_Width   (Object : Framebuffer) return Size;
   function Default_Height  (Object : Framebuffer) return Size;
   function Default_Layers  (Object : Framebuffer) return Size;
   function Default_Samples (Object : Framebuffer) return Size;

   function Default_Fixed_Sample_Locations (Object : Framebuffer) return Boolean;

   function Max_Framebuffer_Width return Size
     with Post => Max_Framebuffer_Width'Result >= 16_384;

   function Max_Framebuffer_Height return Size
     with Post => Max_Framebuffer_Height'Result >= 16_384;

   function Max_Framebuffer_Layers return Size
     with Post => Max_Framebuffer_Layers'Result >= 2_048;

   function Max_Framebuffer_Samples return Size
     with Post => Max_Framebuffer_Samples'Result >= 4;

   procedure Blit (Read_Object, Draw_Object : Framebuffer;
                   Src_X0, Src_Y0, Src_X1, Src_Y1,
                   Dst_X0, Dst_Y0, Dst_X1, Dst_Y1 : Int;
                   Mask : Buffers.Buffer_Bits;
                   Filter : Textures.Magnifying_Function);
   --  Copy a rectangle of pixels in Read_Object framebuffer to a region
   --  in Draw_Object framebuffer

   procedure Clear_Color_Buffer
     (Object      : Framebuffer;
      Index       : Buffers.Draw_Buffer_Index;
      Format_Type : Pixels.Extensions.Format_Type;
      Value       : Colors.Color);

   procedure Clear_Depth_Buffer   (Object : Framebuffer; Value : Buffers.Depth);

   procedure Clear_Stencil_Buffer (Object : Framebuffer; Value : Buffers.Stencil_Index);

   procedure Clear_Depth_And_Stencil_Buffer (Object : Framebuffer;
                                             Depth_Value   : Buffers.Depth;
                                             Stencil_Value : Buffers.Stencil_Index);

   type Framebuffer_Target (<>) is tagged limited private;

   procedure Bind (Target : Framebuffer_Target;
                   Object : Framebuffer'Class);

   function Status
     (Object : Framebuffer;
      Target : Framebuffer_Target'Class) return Framebuffer_Status;

   Read_Target  : constant Framebuffer_Target;
   Draw_Target  : constant Framebuffer_Target;

   function Default_Framebuffer return Framebuffer;

private

   for Framebuffer_Status use (Undefined                     => 16#8219#,
                               Complete                      => 16#8CD5#,
                               Incomplete_Attachment         => 16#8CD6#,
                               Incomplete_Missing_Attachment => 16#8CD7#,
                               Incomplete_Draw_Buffer        => 16#8CDB#,
                               Incomplete_Read_Buffer        => 16#8CDC#,
                               Unsupported                   => 16#8CDD#,
                               Incomplete_Multisample        => 16#8D56#,
                               Incomplete_Layer_Targets      => 16#8DA8#);
   for Framebuffer_Status'Size use Low_Level.Enum'Size;

   for Attachment_Point use (Depth_Stencil_Attachment => 16#821A#,
                             Color_Attachment_0       => 16#8CE0#,
                             Color_Attachment_1       => 16#8CE1#,
                             Color_Attachment_2       => 16#8CE2#,
                             Color_Attachment_3       => 16#8CE3#,
                             Color_Attachment_4       => 16#8CE4#,
                             Color_Attachment_5       => 16#8CE5#,
                             Color_Attachment_6       => 16#8CE6#,
                             Color_Attachment_7       => 16#8CE7#,
                             Color_Attachment_8       => 16#8CE8#,
                             Color_Attachment_9       => 16#8CE9#,
                             Color_Attachment_10      => 16#8CEA#,
                             Color_Attachment_11      => 16#8CEB#,
                             Color_Attachment_12      => 16#8CEC#,
                             Color_Attachment_13      => 16#8CED#,
                             Color_Attachment_14      => 16#8CEE#,
                             Color_Attachment_15      => 16#8CEF#,
                             Depth_Attachment         => 16#8D00#,
                             Stencil_Attachment       => 16#8D20#);
   for Attachment_Point'Size use Low_Level.Enum'Size;

   for Default_Attachment_Point use
     (Front_Left  => 16#0400#,
      Front_Right => 16#0401#,
      Back_Left   => 16#0402#,
      Back_Right  => 16#0403#,
      Depth       => 16#1801#,
      Stencil     => 16#1802#);
   for Default_Attachment_Point'Size use Low_Level.Enum'Size;

   pragma Convention (C, Attachment_List);
   pragma Convention (C, Default_Attachment_List);

   type Framebuffer is new GL_Object with null record;

   type Framebuffer_Target (Kind : Enums.Framebuffer_Kind) is
     tagged limited null record;

   Read_Target  : constant Framebuffer_Target :=
     Framebuffer_Target'(Kind => Enums.Read);
   Draw_Target : constant Framebuffer_Target :=
     Framebuffer_Target'(Kind => Enums.Draw);

end GL.Objects.Framebuffers;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2013 Felix Krause <contact@flyx.org>
--
--  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 GL.Buffers;
with GL.Low_Level.Enums;
with GL.Objects.Textures;
with GL.Pixels.Extensions;
with GL.Types.Colors;

private with GL.Enums;

package GL.Objects.Framebuffers is
   pragma Preelaborate;

   use all type GL.Low_Level.Enums.Texture_Kind;

   type Framebuffer_Status is (Undefined, Complete, Incomplete_Attachment,
                               Incomplete_Missing_Attachment,
                               Incomplete_Draw_Buffer, Incomplete_Read_Buffer,
                               Unsupported, Incomplete_Multisample,
                               Incomplete_Layer_Targets);

   type Attachment_Point is (Depth_Stencil_Attachment,
                             Color_Attachment_0, Color_Attachment_1,
                             Color_Attachment_2, Color_Attachment_3,
                             Color_Attachment_4, Color_Attachment_5,
                             Color_Attachment_6, Color_Attachment_7,
                             Color_Attachment_8, Color_Attachment_9,
                             Color_Attachment_10, Color_Attachment_11,
                             Color_Attachment_12, Color_Attachment_13,
                             Color_Attachment_14, Color_Attachment_15,
                             Depth_Attachment, Stencil_Attachment);

   type Default_Attachment_Point is
     (Front_Left, Front_Right, Back_Left, Back_Right, Depth, Stencil);

   type Attachment_List is array (Positive range <>) of Attachment_Point;

   type Default_Attachment_List is array (Positive range <>) of Default_Attachment_Point;

   function Valid_Attachment
     (Attachment : Attachment_Point;
      Texture    : Textures.Texture) return Boolean
   with Pre => not Texture.Compressed and Texture.Allocated;

   type Framebuffer is new GL_Object with private;

   overriding
   procedure Initialize_Id (Object : in out Framebuffer);

   overriding
   procedure Delete_Id (Object : in out Framebuffer);

   overriding
   function Identifier (Object : Framebuffer) return Types.Debug.Identifier is
     (Types.Debug.Framebuffer);

   procedure Set_Draw_Buffer
     (Object   : Framebuffer;
      Selector : Buffers.Color_Buffer_Selector)
   with Pre => (if Object = Default_Framebuffer then
                  Selector in Buffers.Default_Color_Buffer_Selector | Buffers.None
                else
                  Selector in Buffers.Explicit_Color_Buffer_Selector | Buffers.None);

   procedure Set_Draw_Buffers
     (Object : Framebuffer;
      List   : Buffers.Color_Buffer_List)
   with Pre => (if Object = Default_Framebuffer then
                  (for all S of List =>
                     S in Buffers.Default_Color_Buffer_Selector | Buffers.None)
                else
                  (for all S of List =>
                     S in Buffers.Explicit_Color_Buffer_Selector | Buffers.None));

   procedure Set_Read_Buffer (Object : Framebuffer; Selector : Buffers.Color_Buffer_Selector)
     with Pre => (if Object = Default_Framebuffer then
                    Selector in Buffers.Default_Color_Buffer_Selector | Buffers.None
                  else
                    Selector in Buffers.Explicit_Color_Buffer_Selector | Buffers.None);

   procedure Attach_Texture
     (Object     : Framebuffer;
      Attachment : Attachment_Point;
      Texture    : Textures.Texture;
      Level      : Textures.Mipmap_Level)
   with Pre => Object /= Default_Framebuffer and
                 Valid_Attachment (Attachment, Texture) and
                 (if Texture.Kind in
                    Texture_2D_Multisample | Texture_2D_Multisample_Array
                  then Level = 0);

   procedure Attach_Texture_Layer
     (Object     : Framebuffer;
      Attachment : Attachment_Point;
      Texture    : Textures.Texture;
      Level      : Textures.Mipmap_Level;
      Layer      : Natural)
   with Pre => Object /= Default_Framebuffer and
                 Valid_Attachment (Attachment, Texture) and
                 Texture.Layered;

   procedure Detach (Object : Framebuffer; Attachment : Attachment_Point)
     with Pre => Object /= Default_Framebuffer;

   procedure Invalidate_Data
     (Object      : Framebuffer;
      Attachments : Attachment_List)
   with Pre => Object /= Default_Framebuffer;

   procedure Invalidate_Sub_Data
     (Object        : Framebuffer;
      Attachments   : Attachment_List;
      X, Y          : Int;
      Width, Height : Size)
   with Pre => Object /= Default_Framebuffer;

   procedure Invalidate_Data
     (Object      : Framebuffer;
      Attachments : Default_Attachment_List)
   with Pre => Object = Default_Framebuffer;

   procedure Invalidate_Sub_Data
     (Object        : Framebuffer;
      Attachments   : Default_Attachment_List;
      X, Y          : Int;
      Width, Height : Size)
   with Pre => Object = Default_Framebuffer;

   ----------------------------------------------------------------------------

   procedure Set_Default_Width   (Object : Framebuffer; Value : Size)
     with Pre => Object /= Default_Framebuffer;
   procedure Set_Default_Height  (Object : Framebuffer; Value : Size)
     with Pre => Object /= Default_Framebuffer;
   procedure Set_Default_Layers  (Object : Framebuffer; Value : Size)
     with Pre => Object /= Default_Framebuffer;
   procedure Set_Default_Samples (Object : Framebuffer; Value : Size)
     with Pre => Object /= Default_Framebuffer;

   procedure Set_Default_Fixed_Sample_Locations (Object : Framebuffer; Value : Boolean)
     with Pre => Object /= Default_Framebuffer;

   function Default_Width   (Object : Framebuffer) return Size
     with Pre => Object /= Default_Framebuffer;
   function Default_Height  (Object : Framebuffer) return Size
     with Pre => Object /= Default_Framebuffer;
   function Default_Layers  (Object : Framebuffer) return Size
     with Pre => Object /= Default_Framebuffer;
   function Default_Samples (Object : Framebuffer) return Size
     with Pre => Object /= Default_Framebuffer;

   function Default_Fixed_Sample_Locations (Object : Framebuffer) return Boolean
     with Pre => Object /= Default_Framebuffer;

   ----------------------------------------------------------------------------

   function Max_Framebuffer_Width return Size
     with Post => Max_Framebuffer_Width'Result >= 16_384;

   function Max_Framebuffer_Height return Size
     with Post => Max_Framebuffer_Height'Result >= 16_384;

   function Max_Framebuffer_Layers return Size
     with Post => Max_Framebuffer_Layers'Result >= 2_048;

   function Max_Framebuffer_Samples return Size
     with Post => Max_Framebuffer_Samples'Result >= 4;

   procedure Blit (Read_Object, Draw_Object : Framebuffer;
                   Src_X0, Src_Y0, Src_X1, Src_Y1,
                   Dst_X0, Dst_Y0, Dst_X1, Dst_Y1 : Int;
                   Mask : Buffers.Buffer_Bits;
                   Filter : Textures.Magnifying_Function);
   --  Copy a rectangle of pixels in Read_Object framebuffer to a region
   --  in Draw_Object framebuffer

   procedure Clear_Color_Buffer
     (Object      : Framebuffer;
      Index       : Buffers.Draw_Buffer_Index;
      Format_Type : Pixels.Extensions.Format_Type;
      Value       : Colors.Color);

   procedure Clear_Depth_Buffer   (Object : Framebuffer; Value : Buffers.Depth);

   procedure Clear_Stencil_Buffer (Object : Framebuffer; Value : Buffers.Stencil_Index);

   procedure Clear_Depth_And_Stencil_Buffer (Object : Framebuffer;
                                             Depth_Value   : Buffers.Depth;
                                             Stencil_Value : Buffers.Stencil_Index);

   type Framebuffer_Target (<>) is tagged limited private;

   procedure Bind (Target : Framebuffer_Target;
                   Object : Framebuffer'Class);

   function Status
     (Object : Framebuffer;
      Target : Framebuffer_Target'Class) return Framebuffer_Status;

   Read_Target  : constant Framebuffer_Target;
   Draw_Target  : constant Framebuffer_Target;

   function Default_Framebuffer return Framebuffer;

private

   for Framebuffer_Status use (Undefined                     => 16#8219#,
                               Complete                      => 16#8CD5#,
                               Incomplete_Attachment         => 16#8CD6#,
                               Incomplete_Missing_Attachment => 16#8CD7#,
                               Incomplete_Draw_Buffer        => 16#8CDB#,
                               Incomplete_Read_Buffer        => 16#8CDC#,
                               Unsupported                   => 16#8CDD#,
                               Incomplete_Multisample        => 16#8D56#,
                               Incomplete_Layer_Targets      => 16#8DA8#);
   for Framebuffer_Status'Size use Low_Level.Enum'Size;

   for Attachment_Point use (Depth_Stencil_Attachment => 16#821A#,
                             Color_Attachment_0       => 16#8CE0#,
                             Color_Attachment_1       => 16#8CE1#,
                             Color_Attachment_2       => 16#8CE2#,
                             Color_Attachment_3       => 16#8CE3#,
                             Color_Attachment_4       => 16#8CE4#,
                             Color_Attachment_5       => 16#8CE5#,
                             Color_Attachment_6       => 16#8CE6#,
                             Color_Attachment_7       => 16#8CE7#,
                             Color_Attachment_8       => 16#8CE8#,
                             Color_Attachment_9       => 16#8CE9#,
                             Color_Attachment_10      => 16#8CEA#,
                             Color_Attachment_11      => 16#8CEB#,
                             Color_Attachment_12      => 16#8CEC#,
                             Color_Attachment_13      => 16#8CED#,
                             Color_Attachment_14      => 16#8CEE#,
                             Color_Attachment_15      => 16#8CEF#,
                             Depth_Attachment         => 16#8D00#,
                             Stencil_Attachment       => 16#8D20#);
   for Attachment_Point'Size use Low_Level.Enum'Size;

   for Default_Attachment_Point use
     (Front_Left  => 16#0400#,
      Front_Right => 16#0401#,
      Back_Left   => 16#0402#,
      Back_Right  => 16#0403#,
      Depth       => 16#1801#,
      Stencil     => 16#1802#);
   for Default_Attachment_Point'Size use Low_Level.Enum'Size;

   pragma Convention (C, Attachment_List);
   pragma Convention (C, Default_Attachment_List);

   type Framebuffer is new GL_Object with null record;

   type Framebuffer_Target (Kind : Enums.Framebuffer_Kind) is
     tagged limited null record;

   Read_Target  : constant Framebuffer_Target :=
     Framebuffer_Target'(Kind => Enums.Read);
   Draw_Target : constant Framebuffer_Target :=
     Framebuffer_Target'(Kind => Enums.Draw);

end GL.Objects.Framebuffers;

gl: Add aspect Pre to setters/getters of default values of FBs

Setting or getting certain default values of framebuffers is not allowed
for the default framebuffer.

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  awa-images-modules-tests -- Unit tests for image service
--  Copyright (C) 2012, 2013, 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.Tests;
with AWA.Tests;
with ADO;
package AWA.Images.Modules.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new AWA.Tests.Test with record
      Id      : ADO.Identifier;
      Manager : AWA.Images.Modules.Image_Module_Access;
   end record;

   --  Test creation of a storage object
   procedure Test_Create_Image (T : in out Test);

end AWA.Images.Modules.Tests;

-----------------------------------------------------------------------
--  awa-images-modules-tests -- Unit tests for image service
--  Copyright (C) 2012, 2013, 2018, 2020 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.Tests;
with AWA.Tests;
with ADO;
package AWA.Images.Modules.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new AWA.Tests.Test with record
      Id      : ADO.Identifier;
      Manager : AWA.Images.Modules.Image_Module_Access;
   end record;

   --  Test creation of a storage object
   procedure Test_Create_Image (T : in out Test);

   --  Test the Get_Sizes operation.
   procedure Test_Get_Sizes (T : in out TesT);

end AWA.Images.Modules.Tests;

Add Test_Get_Sizes procedure

Add Test_Get_Sizes procedure