-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  Copyright (C) 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.Containers.Ordered_Maps;

with Util.Events;

with MAT.Frames;
with MAT.Readers;
with MAT.Memory.Events;
with MAT.Memory.Tools;
package MAT.Memory.Targets is

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  Copyright (C) 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.Containers.Ordered_Maps;

with Util.Events;

with MAT.Frames;
with MAT.Readers;
with MAT.Memory.Events;
with MAT.Memory.Tools;
package MAT.Memory.Targets is

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

      --  Find from the memory map the memory slots whose address intersects
      --  the region [From .. To] and add the memory slot in the <tt>Into</tt> list if
      --  it does not already contains the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Into   : in out MAT.Memory.Allocation_Map);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

Declare the protected operation Find

Declare the protected operation Find


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 onox <denkpadje@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 System.Multiprocessors;

with Orka.Jobs.Executors;
with Orka.Jobs.Queues;
with Orka.Jobs.Workers;

generic
   Maximum_Queued_Jobs : Positive;
   --  Maximum number of jobs that can be enqueued
   --
   --  Should be less than the largest width (number of jobs at a
   --  particular level) of any job graph.

   Maximum_Job_Graphs  : Positive;
   --  Maximum number of separate job graphs
   --
   --  For each job graph, a Future object is acquired. The number of
   --  concurrent acquired objects is bounded by this number.

   Maximum_Enqueued_By_Job : Positive;
   --  Maximum number of extra jobs that a job can enqueue
package Orka.Jobs.System is

   package Queues is new Jobs.Queues
     (Maximum_Graphs => Maximum_Job_Graphs,
      Capacity       => Maximum_Queued_Jobs);

   package Executors is new Jobs.Executors (Queues, Maximum_Enqueued_By_Job);

   Queue : aliased Queues.Queue;

   Number_Of_Workers : constant Standard.System.Multiprocessors.CPU;

   procedure Shutdown;

private

   package SM renames Standard.System.Multiprocessors;

   use type SM.CPU;

   Number_Of_Workers : constant SM.CPU := SM.Number_Of_CPUs - 1;
   --  For n logical CPU's we spawn n - 1 workers (1 CPU is dedicated
   --  to rendering)

   package Workers is new Jobs.Workers
     (Executors, Queue'Access, "Worker", Number_Of_Workers);

   procedure Shutdown renames Workers.Shutdown;

end Orka.Jobs.System;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 onox <denkpadje@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 System.Multiprocessors;

with Orka.Jobs.Executors;
with Orka.Jobs.Queues;
with Orka.Jobs.Workers;

generic
   Maximum_Queued_Jobs : Positive;
   --  Maximum number of jobs that can be enqueued
   --
   --  Should be no less than the largest width (number of jobs at a
   --  particular level) of any job graph.

   Maximum_Job_Graphs  : Positive;
   --  Maximum number of separate job graphs
   --
   --  For each job graph, a Future object is acquired. The number of
   --  concurrent acquired objects is bounded by this number.
package Orka.Jobs.System is

   package Queues is new Jobs.Queues
     (Maximum_Graphs => Maximum_Job_Graphs,
      Capacity       => Maximum_Queued_Jobs);

   package Executors is new Jobs.Executors
     (Queues, Maximum_Enqueued_By_Job => Maximum_Queued_Jobs);

   Queue : aliased Queues.Queue;

   Number_Of_Workers : constant Standard.System.Multiprocessors.CPU;

   procedure Shutdown;

private

   package SM renames Standard.System.Multiprocessors;

   use type SM.CPU;

   Number_Of_Workers : constant SM.CPU := SM.Number_Of_CPUs - 1;
   --  For n logical CPU's we spawn n - 1 workers (1 CPU is dedicated
   --  to rendering)

   package Workers is new Jobs.Workers
     (Executors, Queue'Access, "Worker", Number_Of_Workers);

   procedure Shutdown renames Workers.Shutdown;

end Orka.Jobs.System;

orka: Remove generic parameter from Orka.Jobs.System

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


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2018 onox <denkpadje@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.Real_Time;
with Ada.Text_IO;

with GL.Barriers;
with GL.Compute;
with GL.Types.Compute;

with Orka.Contexts.AWT;
with Orka.Debug;
with Orka.Rendering.Buffers;
with Orka.Rendering.Programs.Modules;
with Orka.Rendering.Programs.Uniforms;
with Orka.Resources.Locations.Directories;
with Orka.Types;

procedure Orka_10_Compute is
   Context : constant Orka.Contexts.Context'Class := Orka.Contexts.AWT.Create_Context
     (Version => (4, 2), Flags  => (Debug => True, others => False));

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

   use Ada.Text_IO;
   use type GL.Types.Int;
   use GL.Types;

   Numbers : constant Int_Array
     := (10, 1, 8, -1, 0, -2, 3, 5, -2, -3, 2, 7, 0, 11, 0, 2);
begin
   Orka.Debug.Set_Log_Messages (Enable => True);

   declare
      use Orka.Rendering.Buffers;
      use Orka.Rendering.Programs;
      use Orka.Resources;

      Location_Shaders : constant Locations.Location_Ptr
        := Locations.Directories.Create_Location ("data/shaders");

      Program_1 : Program := Create_Program (Modules.Create_Module
        (Location_Shaders, CS => "test-10-module-1.comp"));

      Uniform_1 : constant Uniforms.Uniform := Program_1.Uniform ("maxNumbers");

      Max_Work_Groups, Local_Size : Size;
   begin
      Program_1.Use_Program;

      --  Print some limits about compute shaders
      Put_Line ("Maximum shared size:" &
        Size'Image (GL.Compute.Max_Compute_Shared_Memory_Size));
      Put_Line ("Maximum invocations:" &
        Size'Image (GL.Compute.Max_Compute_Work_Group_Invocations));

      declare
         R : GL.Types.Compute.Dimension_Size_Array;

         use all type Orka.Index_Homogeneous;
      begin
         R := GL.Compute.Max_Compute_Work_Group_Count;
         Put_Line ("Maximum count:" & R (X)'Image & R (Y)'Image & R (Z)'Image);
         Max_Work_Groups := R (X);

         R := GL.Compute.Max_Compute_Work_Group_Size;
         Put_Line ("Maximum size: " & R (X)'Image & R (Y)'Image & R (Z)'Image);

         R := Program_1.Compute_Work_Group_Size;
         Put_Line ("Local size:   " & R (X)'Image & R (Y)'Image & R (Z)'Image);
         Local_Size := R (X);
      end;

      declare
         use all type Orka.Types.Element_Type;
         use type Ada.Real_Time.Time;

         Factor : constant Size := (Max_Work_Groups * Local_Size) / Numbers'Length;

         Buffer_1 : constant Buffer := Create_Buffer
           (Flags  => (Dynamic_Storage => True, others => False),
            Kind   => Int_Type,
            Length => Numbers'Length * Natural (Factor));

         A, B : Ada.Real_Time.Time;

         procedure Memory_Barrier is
         begin
            GL.Barriers.Memory_Barrier ((Shader_Storage | Buffer_Update => True, others => False));
         end Memory_Barrier;
      begin
         Put_Line ("Factor:" & Factor'Image);

         --  Upload numbers to SSBO
         for Index in 0 .. Factor - 1 loop
            Buffer_1.Set_Data (Data => Numbers, Offset => Numbers'Length * Natural (Index));
         end loop;

         Buffer_1.Bind (Shader_Storage, 0);

         A := Ada.Real_Time.Clock;
         declare
            Count : constant Size := Size (Buffer_1.Length);

            Ceiling : Size := Count + (Count rem Local_Size);
            Groups  : Size := Ceiling / Local_Size;
         begin
            Put_Line ("Numbers:" & Count'Image);
            Put_Line ("Groups: " & Groups'Image);
            pragma Assert (Groups <= Max_Work_Groups);

            --  The uniform is used to set how many numbers need to be
            --  summed. If a work group has more threads than there are
            --  numbers to be summed (happens in the last iteration),
            --  then these threads will use the number 0 in the shader.
            Uniform_1.Set_UInt (UInt (Count));

            while Groups > 0 loop
               --  Add an SSBO barrier for the next iteration
               --  and then dispatch the compute shader
               Memory_Barrier;
               GL.Compute.Dispatch_Compute (X => UInt (Groups));

               Uniform_1.Set_UInt (UInt (Groups));
               Ceiling := Groups + (Groups rem Local_Size);
               Groups  := Ceiling / Local_Size;
            end loop;

            --  Perform last iteration. Work groups in X dimension needs
            --  to be at least one.
            Memory_Barrier;
            GL.Compute.Dispatch_Compute (X => UInt (Size'Max (1, Groups)));
         end;

         Memory_Barrier;

         declare
            Output : Int_Array (1 .. 2) := (others => 0);
         begin
            Buffer_1.Get_Data (Output);
            Put_Line ("Expected Sum:" & Size'Image (Factor * 41));
            Put_Line ("Computed sum:" & Output (Output'First)'Image);

            --  Print the number of shader invocations that execute in
            --  lockstep. This requires the extension ARB_shader_ballot
            --  in the shader.
            Put_Line ("Sub-group size:" & Output (Output'Last)'Image);
         end;
         B := Ada.Real_Time.Clock;
         Put_Line (Duration'Image (1e3 * Ada.Real_Time.To_Duration (B - A)) & " ms");
      end;
   end;
end Orka_10_Compute;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2018 onox <denkpadje@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.Real_Time;
with Ada.Text_IO;

with GL.Barriers;
with GL.Compute;
with GL.Types.Compute;

with Orka.Contexts.AWT;
with Orka.Debug;
with Orka.Rendering.Buffers;
with Orka.Rendering.Programs.Modules;
with Orka.Rendering.Programs.Uniforms;
with Orka.Resources.Locations.Directories;
with Orka.Types;

procedure Orka_10_Compute is
   Context : constant Orka.Contexts.Context'Class := Orka.Contexts.AWT.Create_Context
     (Version => (4, 2), Flags  => (Debug => True, others => False));

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

   use Ada.Text_IO;
   use type GL.Types.Int;
   use GL.Types;

   Numbers : constant Int_Array
     := (10, 1, 8, -1, 0, -2, 3, 5, -2, -3, 2, 7, 0, 11, 0, 2);
begin
   Orka.Debug.Set_Log_Messages (Enable => True);

   declare
      use Orka.Rendering.Buffers;
      use Orka.Rendering.Programs;
      use Orka.Resources;

      Location_Shaders : constant Locations.Location_Ptr
        := Locations.Directories.Create_Location ("data/shaders");

      Program_1 : Program := Create_Program (Modules.Create_Module
        (Location_Shaders, CS => "test-10-module-1.comp"));

      Uniform_1 : constant Uniforms.Uniform := Program_1.Uniform ("maxNumbers");

      Max_Work_Groups, Local_Size : Size;
   begin
      Program_1.Use_Program;

      --  Print some limits about compute shaders
      Put_Line ("Maximum shared size:" &
        Size'Image (GL.Compute.Max_Compute_Shared_Memory_Size));
      Put_Line ("Maximum invocations:" &
        Size'Image (GL.Compute.Max_Compute_Work_Group_Invocations));

      declare
         R : GL.Types.Compute.Dimension_Size_Array;

         use all type Orka.Index_4D;
      begin
         R := GL.Compute.Max_Compute_Work_Group_Count;
         Put_Line ("Maximum count:" & R (X)'Image & R (Y)'Image & R (Z)'Image);
         Max_Work_Groups := R (X);

         R := GL.Compute.Max_Compute_Work_Group_Size;
         Put_Line ("Maximum size: " & R (X)'Image & R (Y)'Image & R (Z)'Image);

         R := Program_1.Compute_Work_Group_Size;
         Put_Line ("Local size:   " & R (X)'Image & R (Y)'Image & R (Z)'Image);
         Local_Size := R (X);
      end;

      declare
         use all type Orka.Types.Element_Type;
         use type Ada.Real_Time.Time;

         Factor : constant Size := (Max_Work_Groups * Local_Size) / Numbers'Length;

         Buffer_1 : constant Buffer := Create_Buffer
           (Flags  => (Dynamic_Storage => True, others => False),
            Kind   => Int_Type,
            Length => Numbers'Length * Natural (Factor));

         A, B : Ada.Real_Time.Time;

         procedure Memory_Barrier is
         begin
            GL.Barriers.Memory_Barrier ((Shader_Storage | Buffer_Update => True, others => False));
         end Memory_Barrier;
      begin
         Put_Line ("Factor:" & Factor'Image);

         --  Upload numbers to SSBO
         for Index in 0 .. Factor - 1 loop
            Buffer_1.Set_Data (Data => Numbers, Offset => Numbers'Length * Natural (Index));
         end loop;

         Buffer_1.Bind (Shader_Storage, 0);

         A := Ada.Real_Time.Clock;
         declare
            Count : constant Size := Size (Buffer_1.Length);

            Ceiling : Size := Count + (Count rem Local_Size);
            Groups  : Size := Ceiling / Local_Size;
         begin
            Put_Line ("Numbers:" & Count'Image);
            Put_Line ("Groups: " & Groups'Image);
            pragma Assert (Groups <= Max_Work_Groups);

            --  The uniform is used to set how many numbers need to be
            --  summed. If a work group has more threads than there are
            --  numbers to be summed (happens in the last iteration),
            --  then these threads will use the number 0 in the shader.
            Uniform_1.Set_UInt (UInt (Count));

            while Groups > 0 loop
               --  Add an SSBO barrier for the next iteration
               --  and then dispatch the compute shader
               Memory_Barrier;
               GL.Compute.Dispatch_Compute (X => UInt (Groups));

               Uniform_1.Set_UInt (UInt (Groups));
               Ceiling := Groups + (Groups rem Local_Size);
               Groups  := Ceiling / Local_Size;
            end loop;

            --  Perform last iteration. Work groups in X dimension needs
            --  to be at least one.
            Memory_Barrier;
            GL.Compute.Dispatch_Compute (X => UInt (Size'Max (1, Groups)));
         end;

         Memory_Barrier;

         declare
            Output : Int_Array (1 .. 2) := (others => 0);
         begin
            Buffer_1.Get_Data (Output);
            Put_Line ("Expected Sum:" & Size'Image (Factor * 41));
            Put_Line ("Computed sum:" & Output (Output'First)'Image);

            --  Print the number of shader invocations that execute in
            --  lockstep. This requires the extension ARB_shader_ballot
            --  in the shader.
            Put_Line ("Sub-group size:" & Output (Output'Last)'Image);
         end;
         B := Ada.Real_Time.Clock;
         Put_Line (Duration'Image (1e3 * Ada.Real_Time.To_Duration (B - A)) & " ms");
      end;
   end;
end Orka_10_Compute;

examples: Rename occurrences of Index_Homogeneous to Index_4D

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


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

with Util.Processes;
with Util.Beans.Objects;
with Util.Log.Loggers;
with Util.Streams.Pipes;
with Util.Streams.Texts;

with ADO;
with ADO.Sessions;

with AWA.Images.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
with AWA.Storages.Modules;
with Ada.Strings.Unbounded;

with EL.Variables.Default;
with EL.Contexts.Default;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
package body AWA.Images.Services is

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Image Service
   --  ------------------------------

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

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Image_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);

      Service.Thumbnail_Command := Module.Get_Config (PARAM_THUMBNAIL_COMMAND);
   end Initialize;

   procedure Create_Thumbnail (Service : in Image_Service;
                               Source  : in String;
                               Into    : in String;
                               Width   : out Natural;
                               Height  : out Natural) is
      Ctx       : EL.Contexts.Default.Default_Context;
      Variables : aliased EL.Variables.Default.Default_Variable_Mapper;

      Proc    : Util.Processes.Process;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      Variables.Bind ("src", Util.Beans.Objects.To_Object (Source));
      Variables.Bind ("dst", Util.Beans.Objects.To_Object (Into));
      Ctx.Set_Variable_Mapper (Variables'Unchecked_Access);
      declare
         Cmd     : constant Util.Beans.Objects.Object := Service.Thumbnail_Command.Get_Value (Ctx);
         Command : constant String := Util.Beans.Objects.To_String (Cmd);
         Input   : Util.Streams.Texts.Reader_Stream;
      begin
         Width  := 0;
         Height := 0;
         Pipe.Open (Command, Util.Processes.READ_ALL);
         Input.Initialize (null, Pipe'Unchecked_Access, 1024);
         while not Input.Is_Eof loop
            declare
               use Ada.Strings;

               Line : Ada.Strings.Unbounded.Unbounded_String;
               Pos  : Natural;
               Sep  : Natural;
               Last : Natural;
            begin
               Input.Read_Line (Into  => Line, Strip => False);
               exit when Ada.Strings.Unbounded.Length (Line) = 0;
               Log.Info ("Received: {0}", Line);

               --  The '-verbose' option of ImageMagick reports information about the original
               --  image.  Extract the picture width and height.
               --  image.png PNG 120x282 120x282+0+0 8-bit DirectClass 34.4KB 0.000u 0:00.018
               Pos := Ada.Strings.Unbounded.Index (Line, " ");
               if Pos > 0 and Width = 0 then
                  Pos := Ada.Strings.Unbounded.Index (Line, " ", Pos + 1);
                  if Pos > 0 then
                     Sep := Ada.Strings.Unbounded.Index (Line, "x", Pos + 1);
                     Last := Ada.Strings.Unbounded.Index (Line, "=", Pos + 1);
                     if Sep > 0 and Sep < Last then
                        Log.Info ("Dimension {0} - {1}..{2}",
                                  Ada.Strings.Unbounded.Slice (Line, Pos, Last),
                                  Natural'Image (Pos), Natural'Image (Last));
                        Width := Natural'Value (Unbounded.Slice (Line, Pos + 1, Sep - 1));
                        Height := Natural'Value (Unbounded.Slice (Line, Sep + 1, Last - 1));
                     end if;
                  end if;
               end if;
            end;
         end loop;
         Pipe.Close;

         Util.Processes.Wait (Proc);
         if Pipe.Get_Exit_Status /= 0 then
            Log.Error ("Command {0} exited with status {1}", Command,
                       Integer'Image (Pipe.Get_Exit_Status));
         end if;
      end;
   end Create_Thumbnail;

   --  Build a thumbnail for the image identified by the Id.
   procedure Build_Thumbnail (Service : in Image_Service;
                              Id      : in ADO.Identifier) is
      Storage_Service : constant AWA.Storages.Services.Storage_Service_Access
        := AWA.Storages.Modules.Get_Storage_Manager;
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      DB          : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Img         : AWA.Images.Models.Image_Ref;
      Thumb       : AWA.Images.Models.Image_Ref;
      Target_File : AWA.Storages.Storage_File;
      Local_File  : AWA.Storages.Storage_File;
      Thumbnail   : AWA.Storages.Models.Storage_Ref;
      Width       : Natural;
      Height      : Natural;
      Name        : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Img.Load (DB, Id);
      declare
         Image_File : constant AWA.Storages.Models.Storage_Ref'Class := Img.Get_Storage;
      begin
         Storage_Service.Get_Local_File (From => Image_File.Get_Id, Into => Local_File);
         Storage_Service.Create_Local_File (Target_File);

         Service.Create_Thumbnail (AWA.Storages.Get_Path (Local_File),
                                   AWA.Storages.Get_Path (Target_File), Width, Height);
         Thumbnail.Set_Mime_Type ("image/jpeg");
         Thumbnail.Set_Original (Image_File);
         Thumbnail.Set_Workspace (Image_File.Get_Workspace);
         Thumbnail.Set_Folder (Image_File.Get_Folder);
         Thumbnail.Set_Owner (Image_File.Get_Owner);
         Thumbnail.Set_Name (String '(Image_File.Get_Name));
         Storage_Service.Save (Thumbnail, Target_File, AWA.Storages.Models.DATABASE);
         Thumb.Set_Width (64);
         Thumb.Set_Height (64);
         Thumb.Set_Owner (Image_File.Get_Owner);
         Thumb.Set_Folder (Image_File.Get_Folder);
         Thumb.Set_Storage (Thumbnail);
         Img.Set_Width (Width);
         Img.Set_Height (Height);
         Img.Set_Thumb_Width (64);
         Img.Set_Thumb_Height (64);
         Img.Set_Thumbnail (Thumbnail);
         Ctx.Start;
         Img.Save (DB);
         Thumb.Save (DB);
         Ctx.Commit;
      end;
   end Build_Thumbnail;

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Create_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Img : AWA.Images.Models.Image_Ref;
   begin
      Ctx.Start;
      Img.Set_Width (0);
      Img.Set_Height (0);
      Img.Set_Thumb_Height (0);
      Img.Set_Thumb_Width (0);
      Img.Set_Storage (File);
      Img.Set_Folder (File.Get_Folder);
      Img.Set_Owner (File.Get_Owner);
      Img.Save (DB);
      Ctx.Commit;
   end Create_Image;

   --  Deletes the storage instance.
   procedure Delete_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      null;
   end Delete_Image;

end AWA.Images.Services;

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

with Util.Processes;
with Util.Beans.Objects;
with Util.Log.Loggers;
with Util.Streams.Pipes;
with Util.Streams.Texts;
with Util.Strings;

with ADO;
with ADO.Sessions;

with AWA.Images.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
with AWA.Storages.Modules;
with Ada.Strings.Unbounded;

with EL.Variables.Default;
with EL.Contexts.Default;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
package body AWA.Images.Services is

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Image Service
   --  ------------------------------

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

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Image_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);

      Service.Thumbnail_Command := Module.Get_Config (PARAM_THUMBNAIL_COMMAND);
   end Initialize;

   procedure Create_Thumbnail (Service : in Image_Service;
                               Source  : in String;
                               Into    : in String;
                               Width   : in out Natural;
                               Height  : in out Natural) is
      Ctx       : EL.Contexts.Default.Default_Context;
      Variables : aliased EL.Variables.Default.Default_Variable_Mapper;

      Proc    : Util.Processes.Process;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      Variables.Bind ("src", Util.Beans.Objects.To_Object (Source));
      Variables.Bind ("dst", Util.Beans.Objects.To_Object (Into));
      Variables.Bind ("width", Util.Beans.Objects.To_Object (Width));
      Variables.Bind ("height", Util.Beans.Objects.To_Object (Height));
      Ctx.Set_Variable_Mapper (Variables'Unchecked_Access);
      declare
         Cmd     : constant Util.Beans.Objects.Object := Service.Thumbnail_Command.Get_Value (Ctx);
         Command : constant String := Util.Beans.Objects.To_String (Cmd);
         Input   : Util.Streams.Texts.Reader_Stream;
      begin
         Width  := 0;
         Height := 0;
         Pipe.Open (Command, Util.Processes.READ_ALL);
         Input.Initialize (null, Pipe'Unchecked_Access, 1024);
         while not Input.Is_Eof loop
            declare
               use Ada.Strings;

               Line : Ada.Strings.Unbounded.Unbounded_String;
               Pos  : Natural;
               Sep  : Natural;
               Last : Natural;
            begin
               Input.Read_Line (Into  => Line, Strip => False);
               exit when Ada.Strings.Unbounded.Length (Line) = 0;
               Log.Info ("Received: {0}", Line);

               --  The '-verbose' option of ImageMagick reports information about the original
               --  image.  Extract the picture width and height.
               --  image.png PNG 120x282 120x282+0+0 8-bit DirectClass 34.4KB 0.000u 0:00.018
               Pos := Ada.Strings.Unbounded.Index (Line, " ");
               if Pos > 0 and Width = 0 then
                  Pos := Ada.Strings.Unbounded.Index (Line, " ", Pos + 1);
                  if Pos > 0 then
                     Sep := Ada.Strings.Unbounded.Index (Line, "x", Pos + 1);
                     Last := Ada.Strings.Unbounded.Index (Line, "=", Pos + 1);
                     if Sep > 0 and Sep < Last then
                        Log.Info ("Dimension {0} - {1}..{2}",
                                  Ada.Strings.Unbounded.Slice (Line, Pos, Last),
                                  Natural'Image (Pos), Natural'Image (Last));
                        Width := Natural'Value (Unbounded.Slice (Line, Pos + 1, Sep - 1));
                        Height := Natural'Value (Unbounded.Slice (Line, Sep + 1, Last - 1));
                     end if;
                  end if;
               end if;
            end;
         end loop;
         Pipe.Close;

         Util.Processes.Wait (Proc);
         if Pipe.Get_Exit_Status /= 0 then
            Log.Error ("Command {0} exited with status {1}", Command,
                       Integer'Image (Pipe.Get_Exit_Status));
         end if;
      end;
   end Create_Thumbnail;

   --  Build a thumbnail for the image identified by the Id.
   procedure Build_Thumbnail (Service : in Image_Service;
                              Id      : in ADO.Identifier) is
      Storage_Service : constant AWA.Storages.Services.Storage_Service_Access
        := AWA.Storages.Modules.Get_Storage_Manager;
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      DB          : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Img         : AWA.Images.Models.Image_Ref;
      Thumb       : AWA.Images.Models.Image_Ref;
      Target_File : AWA.Storages.Storage_File (AWA.Storages.TMP);
      Local_File  : AWA.Storages.Storage_File (AWA.Storages.CACHE);
      Thumbnail   : AWA.Storages.Models.Storage_Ref;
      Width       : Natural := 64;
      Height      : Natural := 64;
      Name        : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Img.Load (DB, Id);
      declare
         Image_File : constant AWA.Storages.Models.Storage_Ref'Class := Img.Get_Storage;
      begin
         Storage_Service.Get_Local_File (From => Image_File.Get_Id, Into => Local_File);
         Storage_Service.Create_Local_File (Target_File);

         Service.Create_Thumbnail (AWA.Storages.Get_Path (Local_File),
                                   AWA.Storages.Get_Path (Target_File), Width, Height);
         Thumbnail.Set_Mime_Type ("image/jpeg");
         Thumbnail.Set_Original (Image_File);
         Thumbnail.Set_Workspace (Image_File.Get_Workspace);
         Thumbnail.Set_Folder (Image_File.Get_Folder);
         Thumbnail.Set_Owner (Image_File.Get_Owner);
         Thumbnail.Set_Name (String '(Image_File.Get_Name));
         Storage_Service.Save (Thumbnail, AWA.Storages.Get_Path (Target_File),
                               AWA.Storages.Models.DATABASE);
         Thumb.Set_Width (64);
         Thumb.Set_Height (64);
         Thumb.Set_Owner (Image_File.Get_Owner);
         Thumb.Set_Folder (Image_File.Get_Folder);
         Thumb.Set_Storage (Thumbnail);
         Img.Set_Width (Width);
         Img.Set_Height (Height);
         Img.Set_Thumb_Width (64);
         Img.Set_Thumb_Height (64);
         Img.Set_Thumbnail (Thumbnail);
         Ctx.Start;
         Img.Save (DB);
         Thumb.Save (DB);
         Ctx.Commit;
      end;
   end Build_Thumbnail;

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Create_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Img : AWA.Images.Models.Image_Ref;
   begin
      Ctx.Start;
      Img.Set_Width (0);
      Img.Set_Height (0);
      Img.Set_Thumb_Height (0);
      Img.Set_Thumb_Width (0);
      Img.Set_Storage (File);
      Img.Set_Folder (File.Get_Folder);
      Img.Set_Owner (File.Get_Owner);
      Img.Save (DB);
      Ctx.Commit;
   end Create_Image;

   --  Deletes the storage instance.
   procedure Delete_Image (Service : in Image_Service;
                           File    : in AWA.Storages.Models.Storage_Ref'Class) is
   begin
      null;
   end Delete_Image;

   --  ------------------------------
   --  Scale the image dimension.
   --  ------------------------------
   procedure Scale (Width     : in Natural;
                    Height    : in Natural;
                    To_Width  : in out Natural;
                    To_Height : in out Natural) is
   begin
      if To_Width = Natural'Last or To_Height = Natural'Last
        or (To_Width = 0 and To_Height = 0)
      then
         To_Width  := Width;
         To_Height := Height;
      elsif To_Width = 0 then
         To_Width := (Width * To_Height) / Height;
      elsif To_Height = 0 then
         To_Height := (Height * To_Width) / Width;
      end if;
   end Scale;

   --  ------------------------------
   --  Get the dimension represented by the string.  The string has one of the following
   --  formats:
   --    original          -> Width, Height := Natural'Last
   --    default           -> Width, Height := 0
   --    <width>x          -> Width := <width>, Height := 0
   --    x<height>         -> Width := 0, Height := <height>
   --    <width>x<height>  -> Width := <width>, Height := <height>
   --  ------------------------------
   procedure Get_Sizes (Dimension : in String;
                        Width     : out Natural;
                        Height    : out Natural) is
      Pos : Natural;
   begin
      if Dimension = "original" then
         Width  := Natural'Last;
         Height := Natural'Last;
      elsif Dimension = "default" then
         Width  := 800;
         Height := 0;
      else
         Pos := Util.Strings.Index (Dimension, 'x');
         if Pos > Dimension'First then
            Width := Natural'Value (Dimension (Dimension'First .. Pos - 1));
         else
            Width := 0;
         end if;
         if Pos < Dimension'Last then
            Height := Natural'Value (Dimension (Pos + 1 .. Dimension'Last));
         else
            Height := 0;
         end if;
      end if;
   end Get_Sizes;

end AWA.Images.Services;

Implement the Get_Size and Scale operation Update the thumbnail operation to allow scaling to any target width/height


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

with Util.Dates.ISO8601;
with ASF.Contexts.Faces;
package body AWA.Helpers.Requests is

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as an identifier.
   --  Returns NO_IDENTIFIER if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name : in String) return ADO.Identifier is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier'Value (P);
      end if;
   exception
      when others =>
         return ADO.NO_IDENTIFIER;
   end Get_Parameter;

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as an integer.
   --  Returns the default value if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name    : in String;
                           Default : in Integer) return Integer is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return Default;
      else
         return Integer'Value (P);
      end if;
   exception
      when others =>
         return Default;
   end Get_Parameter;

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as a string.
   --  Returns the default value if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name    : in String;
                           Default : in String) return String is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return Default;
      else
         return P;
      end if;
   exception
      when others =>
         return Default;
   end Get_Parameter;

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as a date.
   --  Returns the default value if the parameter does not exist or is not a valid date.
   --  The date is assumed to be in ISO8601 format.
   --  ------------------------------
   function Get_Parameter (Name    : in String;
                           Default : in String) return Ada.Calendar.Time is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return Util.Dates.ISO8601.Value (Default);
      else
         return Util.Dates.ISO8601.Value (P);
      end if;
   exception
      when others =>
         return Util.Dates.ISO8601.Value (Default);
   end Get_Parameter;

end AWA.Helpers.Requests;

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

with Util.Dates.ISO8601;
with ASF.Contexts.Faces;
package body AWA.Helpers.Requests is

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as an identifier.
   --  Returns NO_IDENTIFIER if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name : in String) return ADO.Identifier is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier'Value (P);
      end if;
   exception
      when others =>
         return ADO.NO_IDENTIFIER;
   end Get_Parameter;

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as an integer.
   --  Returns the default value if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name    : in String;
                           Default : in Integer) return Integer is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return Default;
      else
         return Integer'Value (P);
      end if;
   exception
      when others =>
         return Default;
   end Get_Parameter;

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as a string.
   --  Returns the default value if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name    : in String;
                           Default : in String) return String is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return Default;
      else
         return P;
      end if;
   exception
      when others =>
         return Default;
   end Get_Parameter;

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as a date.
   --  Returns the default value if the parameter does not exist or is not a valid date.
   --  The date is assumed to be in ISO8601 format.
   --  ------------------------------
   function Get_Parameter (Name    : in String;
                           Default : in String) return Ada.Calendar.Time is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return Util.Dates.ISO8601.Value (Default);
      else
         return Util.Dates.ISO8601.Value (P);
      end if;
   exception
      when others =>
         return Util.Dates.ISO8601.Value (Default);
   end Get_Parameter;

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as an Object.
   --  Returns the NULL object value if the parameter does not exist.
   --  ------------------------------
   function Get_Parameter (Name    : in String) return Util.Beans.Objects.Object is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      return Util.Beans.Objects.To_Object (P);

   exception
      when others =>
         return Util.Beans.Objects.Null_Object;
   end Get_Parameter;

end AWA.Helpers.Requests;

Implement the new Get_Parameter operation


-----------------------------------------------------------------------
--  ado-statements-sqlite -- SQLite database statements
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 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 Sqlite3_H;
with ADO.Drivers.Connections.Sqlite;
package ADO.Statements.Sqlite is

   type Handle is null record;

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Sqlite_Delete_Statement is new Delete_Statement with private;
   type Sqlite_Delete_Statement_Access is access all Sqlite_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Sqlite_Update_Statement is new Update_Statement with private;
   type Sqlite_Update_Statement_Access is access all Sqlite_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Sqlite_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Update_Statement;
                      Result : out Integer);

   --  Create an update statement
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Sqlite_Insert_Statement is new Insert_Statement with private;
   type Sqlite_Insert_Statement_Access is access all Sqlite_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for SQLite
   --  ------------------------------
   type Sqlite_Query_Statement is new Query_Statement with private;
   type Sqlite_Query_Statement_Access is access all Sqlite_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Query : in out Sqlite_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Sqlite_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Sqlite_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Sqlite_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Sqlite_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Sqlite_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Sqlite_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Sqlite_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Sqlite_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Sqlite_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Sqlite_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   --  Get the column name.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Name (Query  : in Sqlite_Query_Statement;
                             Column : in Natural)
                             return String;

   --  Get the number of columns in the result.
   overriding
   function Get_Column_Count (Query  : in Sqlite_Query_Statement)
                              return Natural;

   --  Deletes the query statement.
   overriding
   procedure Finalize (Query : in out Sqlite_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   --  Create the query statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Query    : in String)
                              return Query_Statement_Access;

   --  Execute SQL statement.
   procedure Execute (Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                      SQL        : in String);

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Sqlite_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      Stmt       : access Sqlite3_H.sqlite3_stmt;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Max_Column : Natural;
   end record;

   type Sqlite_Delete_Statement is new Delete_Statement with record
      Connection   : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Sqlite_Update_Statement is new Update_Statement with record
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Sqlite_Insert_Statement is new Insert_Statement with record
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   --  Check for an error after executing a sqlite statement.
   procedure Check_Error (Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                          Result     : in Interfaces.C.int);

end ADO.Statements.Sqlite;

-----------------------------------------------------------------------
--  ado-statements-sqlite -- SQLite database statements
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 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 Sqlite3_H;
with ADO.Drivers.Connections.Sqlite;
package ADO.Statements.Sqlite is

   type Handle is null record;

   --  ------------------------------
   --  Delete statement
   --  ------------------------------
   type Sqlite_Delete_Statement is new Delete_Statement with private;
   type Sqlite_Delete_Statement_Access is access all Sqlite_Delete_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Delete_Statement;
                      Result : out Natural);

   --  Create the delete statement
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  ------------------------------
   --  Update statement
   --  ------------------------------
   type Sqlite_Update_Statement is new Update_Statement with private;
   type Sqlite_Update_Statement_Access is access all Sqlite_Update_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt : in out Sqlite_Update_Statement);

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Update_Statement;
                      Result : out Integer);

   --  Create an update statement
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  ------------------------------
   --  Insert statement
   --  ------------------------------
   type Sqlite_Insert_Statement is new Insert_Statement with private;
   type Sqlite_Insert_Statement_Access is access all Sqlite_Insert_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Stmt   : in out Sqlite_Insert_Statement;
                      Result : out Integer);

   --  Create an insert statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  ------------------------------
   --  Query statement for SQLite
   --  ------------------------------
   type Sqlite_Query_Statement is new Query_Statement with private;
   type Sqlite_Query_Statement_Access is access all Sqlite_Query_Statement'Class;

   --  Execute the query
   overriding
   procedure Execute (Query : in out Sqlite_Query_Statement);

   --  Get the number of rows returned by the query
   overriding
   function Get_Row_Count (Query : in Sqlite_Query_Statement) return Natural;

   --  Returns True if there is more data (row) to fetch
   overriding
   function Has_Elements (Query : in Sqlite_Query_Statement) return Boolean;

   --  Fetch the next row
   overriding
   procedure Next (Query : in out Sqlite_Query_Statement);

   --  Returns true if the column Column is null.
   overriding
   function Is_Null (Query  : in Sqlite_Query_Statement;
                     Column : in Natural) return Boolean;

   --  Get the column value at position Column and
   --  return it as an Int64.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Int64 (Query  : Sqlite_Query_Statement;
                       Column : Natural) return Int64;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Unbounded_String (Query  : Sqlite_Query_Statement;
                                  Column : Natural) return Unbounded_String;

   --  Get the column value at position Column and
   --  return it as an Unbounded_String.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_String (Query  : Sqlite_Query_Statement;
                        Column : Natural) return String;

   --  Get the column value at position Column and
   --  return it as a Blob reference.
   overriding
   function Get_Blob (Query  : in Sqlite_Query_Statement;
                      Column : in Natural) return ADO.Blob_Ref;

   --  Get the column value at position Column and
   --  return it as an Time.
   --  Raises Invalid_Type if the value cannot be converted.
   --  Raises Invalid_Column if the column does not exist.
   function Get_Time (Query  : Sqlite_Query_Statement;
                      Column : Natural) return Ada.Calendar.Time;

   --  Get the column type
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Type (Query  : Sqlite_Query_Statement;
                             Column : Natural)
                             return ADO.Schemas.Column_Type;

   --  Get the column name.
   --  Raises Invalid_Column if the column does not exist.
   overriding
   function Get_Column_Name (Query  : in Sqlite_Query_Statement;
                             Column : in Natural)
                             return String;

   --  Get the number of columns in the result.
   overriding
   function Get_Column_Count (Query  : in Sqlite_Query_Statement)
                              return Natural;

   --  Deletes the query statement.
   overriding
   procedure Finalize (Query : in out Sqlite_Query_Statement);

   --  Create the query statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   --  Create the query statement.
   function Create_Statement (Database : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                              Query    : in String)
                              return Query_Statement_Access;

   --  Execute SQL statement.
   procedure Execute (Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                      SQL        : in String);

private
   type State is (HAS_ROW, HAS_MORE, DONE, ERROR);

   type Sqlite_Query_Statement is new Query_Statement with record
      This_Query : aliased ADO.SQL.Query;
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      Stmt       : access Sqlite3_H.sqlite3_stmt;
      Counter    : Natural := 1;
      Status     : State := DONE;
      Max_Column : Natural;
   end record;

   type Sqlite_Delete_Statement is new Delete_Statement with record
      Connection   : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      Table        : ADO.Schemas.Class_Mapping_Access;
      Delete_Query : aliased ADO.SQL.Query;
   end record;

   type Sqlite_Update_Statement is new Update_Statement with record
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   type Sqlite_Insert_Statement is new Insert_Statement with record
      Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
      This_Query : aliased ADO.SQL.Update_Query;
      Table      : ADO.Schemas.Class_Mapping_Access;
   end record;

   --  Check for an error after executing a sqlite statement.
   procedure Check_Error (Connection : access ADO.Drivers.Connections.Sqlite.Sqlite3;
                          SQL        : in String;
                          Result     : in Interfaces.C.int);

end ADO.Statements.Sqlite;

Add the SQL parameter to the Check_Error procedure


-----------------------------------------------------------------------
--  asf.server -- ASF Server
--  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.
-----------------------------------------------------------------------

package body ASF.Server.Tests is

   procedure Set_Context (Context : in ASF.Servlets.Servlet_Registry_Access) is
      C : Request_Context;
   begin
      C.Application := Context;
      C.Process     := null;
      ASF.Server.Set_Context (C);
   end Set_Context;

end ASF.Server.Tests;

-----------------------------------------------------------------------
--  asf.server -- ASF Server
--  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.
-----------------------------------------------------------------------

package body ASF.Server.Tests is

   procedure Set_Context (Context : in ASF.Servlets.Servlet_Registry_Access) is
      C : Request_Context;
   begin
      C.Application := Context;
      C.Request     := null;
      C.Response    := null;
      ASF.Server.Set_Context (C);
   end Set_Context;

end ASF.Server.Tests;

Fix compilation of asfunit

Fix compilation of asfunit


-----------------------------------------------------------------------
--  ADO Tests -- Database sequence generator
--  Copyright (C) 2009, 2010 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.Databases;
with ADO.Sessions;

package Regtests is

   --  ------------------------------
   --  Get the database manager to be used for the unit tests
   --  ------------------------------
   function Get_Controller return ADO.Databases.DataSource'Class;

   --  ------------------------------
   --  Get the readonly connection database to be used for the unit tests
   --  ------------------------------
   function Get_Database return ADO.Sessions.Session;

   --  ------------------------------
   --  Get the writeable connection database to be used for the unit tests
   --  ------------------------------
   function Get_Master_Database return ADO.Sessions.Master_Session;

   -- ------------------------------
   --  Initialize the test database
   -- ------------------------------
   procedure Initialize (Name : in String);

end Regtests;

-----------------------------------------------------------------------
--  ADO Tests -- Database sequence generator
--  Copyright (C) 2009, 2010, 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.Sessions;
with ADO.Sessions.Sources;
package Regtests is

   --  ------------------------------
   --  Get the database manager to be used for the unit tests
   --  ------------------------------
   function Get_Controller return ADO.Sessions.Sources.Data_Source'Class;

   --  ------------------------------
   --  Get the readonly connection database to be used for the unit tests
   --  ------------------------------
   function Get_Database return ADO.Sessions.Session;

   --  ------------------------------
   --  Get the writeable connection database to be used for the unit tests
   --  ------------------------------
   function Get_Master_Database return ADO.Sessions.Master_Session;

   -- ------------------------------
   --  Initialize the test database
   -- ------------------------------
   procedure Initialize (Name : in String);

end Regtests;

Update the unit test declaration

Update the unit test declaration


-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 2010, 2011, 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 <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies.  The framework defines a simple role based security policy and an URL security
--  policy intended to provide security in web applications.  The security policy manager reads
--  some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components (yellow) are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a <tt>Principal</tt>
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth.
--
--  [http://ada-security.googlecode.com/svn/wiki/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  <tt>Principal</tt> instance.  Additional security policy context can be added depending on
--  the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  The framework allows an application to plug its own security policy, its own policy context,
--  its own principal and authentication mechanism.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 2010, 2011, 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 <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies.  The framework defines a simple role based security policy and an URL security
--  policy intended to provide security in web applications.  The security policy manager reads
--  some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components (yellow) are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a <tt>Principal</tt>
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth.
--
--  [http://ada-security.googlecode.com/svn/wiki/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  <tt>Principal</tt> instance.  Additional security policy context can be added depending on
--  the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  The framework allows an application to plug its own security policy, its own policy context,
--  its own principal and authentication mechanism.
--
--  @include security-permissions.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

Make the OAuth and OpenID a separate wiki page