-----------------------------------------------------------------------
--  mat-types -- Global types
--  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.IO_Exceptions;

with Util.Log.Loggers;

with GNAT.Sockets;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Streams.Sockets;
procedure Matp is
   Target  : MAT.Targets.Target_Type;
   Console : aliased MAT.Consoles.Text.Console_Type;
   Server  : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   Address : GNAT.Sockets.Sock_Addr_Type;
begin
   Util.Log.Loggers.Initialize ("matp.properties");
   Target.Console (Console'Unchecked_Access);
   Address.Addr := GNAT.Sockets.Any_Inet_Addr;
   Address.Port := 4096;
   Server.Start (Address);
   MAT.Commands.Interactive (Target);
   Server.Stop;

exception
   when Ada.IO_Exceptions.End_Error =>
      Server.Stop;
end Matp;

-----------------------------------------------------------------------
--  mat-types -- Global types
--  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.IO_Exceptions;

with Util.Log.Loggers;

with GNAT.Sockets;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Streams.Sockets;
procedure Matp is
   Target  : MAT.Targets.Target_Type;
   Options : MAT.Commands.Options_Type;
   Console : aliased MAT.Consoles.Text.Console_Type;
   Server  : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   Address : GNAT.Sockets.Sock_Addr_Type;
begin
   Util.Log.Loggers.Initialize ("matp.properties");
   Target.Console (Console'Unchecked_Access);
   MAT.Commands.Initialize_Options (Target, Options);
   Server.Start (Options.Address);
   MAT.Commands.Interactive (Target);
   Server.Stop;

exception
   when Ada.IO_Exceptions.End_Error =>
      Server.Stop;
end Matp;

Use the Initialize_Options procedure to configure


-----------------------------------------------------------------------
--  security-controllers -- Controllers to verify a security permission
--  Copyright (C) 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.
-----------------------------------------------------------------------

with Security.Contexts;

--  == Security Controller ==
--  The Security.Controllers package defines the security controller used to
--  verify that a given permission is granted.  A security controller uses the security
--  context and other controller specific and internal data to verify that the permission
--  is granted.
--
--  To implement a new security controller, one must:
--
--    * Define a type that implements the Controller interface with the
--      Has_Permission operation
--    * Write a function to allocate instances of the given Controller type
--    * Register the function under a unique name by using Register_Controller
--
--  Security controller instances are created when the security policy rules are parsed.
--  These instances are shared across possibly several concurrent requests.
package Security.Controllers is

   Invalid_Controller : exception;

   --  ------------------------------
   --  Security Controller interface
   --  ------------------------------
   type Controller is limited interface;
   type Controller_Access is access all Controller'Class;

   --  Checks whether the permission defined by the Handler controller data is granted
   --  by the security context passed in Context.
   --  Returns true if such permission is granted.
   function Has_Permission (Handler : in Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is abstract;

   type Controller_Factory is not null access function return Controller_Access;

   --  To keep this implementation simple, a maximum of 32 security controller factory
   --  can be registered.  ASF provides one based on roles.  AWA provides another one
   --  based on entity ACLs.
   MAX_CONTROLLER_FACTORY : constant Positive := 32;

   --  Register in a global table the controller factory under the name Name.
   --  When this factory is used, the Factory operation will be called to
   --  create new instances of the controller.
   procedure Register_Controller (Name    : in String;
                                  Factory : in Controller_Factory);

   --  Create a security controller by using the controller factory registered under
   --  the name Name.
   --  Raises Invalid_Controller if the name is not recognized.
   function Create_Controller (Name : in String) return Controller_Access;

end Security.Controllers;

-----------------------------------------------------------------------
--  security-controllers -- Controllers to verify a security permission
--  Copyright (C) 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.
-----------------------------------------------------------------------

with Security.Contexts;
with Security.Permissions;

--  == Security Controller ==
--  The Security.Controllers package defines the security controller used to
--  verify that a given permission is granted.  A security controller uses the security
--  context and other controller specific and internal data to verify that the permission
--  is granted.
--
--  To implement a new security controller, one must:
--
--    * Define a type that implements the Controller interface with the
--      Has_Permission operation
--    * Write a function to allocate instances of the given Controller type
--    * Register the function under a unique name by using Register_Controller
--
--  Security controller instances are created when the security policy rules are parsed.
--  These instances are shared across possibly several concurrent requests.
package Security.Controllers is

   Invalid_Controller : exception;

   --  ------------------------------
   --  Security Controller interface
   --  ------------------------------
   type Controller is limited interface;
   type Controller_Access is access all Controller'Class;

   --  Checks whether the permission defined by the Handler controller data is granted
   --  by the security context passed in Context.
   --  Returns true if such permission is granted.
   function Has_Permission (Handler : in Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is abstract;

   type Controller_Factory is not null access function return Controller_Access;

   --  To keep this implementation simple, a maximum of 32 security controller factory
   --  can be registered.  ASF provides one based on roles.  AWA provides another one
   --  based on entity ACLs.
   MAX_CONTROLLER_FACTORY : constant Positive := 32;

   --  Register in a global table the controller factory under the name Name.
   --  When this factory is used, the Factory operation will be called to
   --  create new instances of the controller.
   procedure Register_Controller (Name    : in String;
                                  Factory : in Controller_Factory);

   --  Create a security controller by using the controller factory registered under
   --  the name Name.
   --  Raises Invalid_Controller if the name is not recognized.
   function Create_Controller (Name : in String) return Controller_Access;

end Security.Controllers;

Fix compilation

Fix compilation


-----------------------------------------------------------------------
--  util-processes-tools -- System specific and low level operations
--  Copyright (C) 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.Systems.Os;
with Util.Streams.Texts;
with Util.Streams.Pipes;
package body Util.Processes.Tools is

   --  ------------------------------
   --  Execute the command and append the output in the vector array.
   --  The program output is read line by line and the standard input is closed.
   --  Return the program exit status.
   --  ------------------------------
   procedure Execute (Command : in String;
                      Output  : in out Util.Strings.Vectors.Vector;
                      Status  : out Integer) is
      Proc    : aliased Util.Streams.Pipes.Pipe_Stream;
      Text    : Util.Streams.Texts.Reader_Stream;
   begin
      Proc.Add_Close (Util.Systems.Os.STDIN_FILENO);
      Text.Initialize (Proc'Unchecked_Access);
      Proc.Open (Command, Util.Processes.READ);
      while not Text.Is_Eof loop
         declare
            Line : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Text.Read_Line (Line, Strip => True);
            exit when Ada.Strings.Unbounded.Length (Line) = 0;
            Output.Append (Ada.Strings.Unbounded.To_String (Line));
         end;
      end loop;
      Proc.Close;
      Status := Proc.Get_Exit_Status;
   end Execute;

end Util.Processes.Tools;

-----------------------------------------------------------------------
--  util-processes-tools -- System specific and low level operations
--  Copyright (C) 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.Systems.Os;
with Util.Streams.Texts;
package body Util.Processes.Tools is

   procedure Execute (Command : in String;
                      Process : in out Util.Streams.Pipes.Pipe_Stream;
                      Output  : in out Util.Strings.Vectors.Vector;
                      Status  : out Integer) is
      Text : Util.Streams.Texts.Reader_Stream;
   begin
      Text.Initialize (Process'Unchecked_Access);
      Process.Open (Command, Util.Processes.READ);
      while not Text.Is_Eof loop
         declare
            Line : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Text.Read_Line (Line, Strip => True);
            exit when Ada.Strings.Unbounded.Length (Line) = 0;
            Output.Append (Ada.Strings.Unbounded.To_String (Line));
         end;
      end loop;
      Process.Close;
      Status := Process.Get_Exit_Status;
   end Execute;

   --  ------------------------------
   --  Execute the command and append the output in the vector array.
   --  The program output is read line by line and the standard input is closed.
   --  Return the program exit status.
   --  ------------------------------
   procedure Execute (Command : in String;
                      Output  : in out Util.Strings.Vectors.Vector;
                      Status  : out Integer) is
      Proc : Util.Streams.Pipes.Pipe_Stream;
   begin
      Proc.Add_Close (Util.Systems.Os.STDIN_FILENO);
      Execute (Command, Proc, Output, Status);
   end Execute;

   procedure Execute (Command    : in String;
                      Input_Path : in String;
                      Output     : in out Util.Strings.Vectors.Vector;
                      Status     : out Integer) is
      Proc : Util.Streams.Pipes.Pipe_Stream;
   begin
      Proc.Set_Input_Stream (Input_Path);
      Execute (Command, Proc, Output, Status);
   end Execute;

end Util.Processes.Tools;

Implement more Execute procedures

Implement more Execute procedures


-----------------------------------------------------------------------
--  awa-questions-services -- Service services
--  Copyright (C) 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 ADO;

with Security.Permissions;

with AWA.Modules;
with AWA.Questions.Models;
package AWA.Questions.Services is

   --  Define the permissions.
   package ACL_Create_Questions is new Security.Permissions.Definition ("question-create");
   package ACL_Delete_Questions is new Security.Permissions.Definition ("question-delete");
   package ACL_Update_Questions is new Security.Permissions.Definition ("question-update");
   package ACL_Answer_Questions is new Security.Permissions.Definition ("answer-create");

   --  The maximum length for a short description.
   SHORT_DESCRIPTION_LENGTH : constant Positive := 200;

   --  ------------------------------
   --  Service services
   --  ------------------------------
   type Question_Service is new AWA.Modules.Module_Manager with private;
   type Question_Service_Access is access all Question_Service'Class;

   --  Create or save the question.
   procedure Save_Question (Model    : in Question_Service;
                            Question : in out AWA.Questions.Models.Question_Ref'Class);

   --  Delete the question.
   procedure Delete_Question (Model    : in Question_Service;
                              Question : in out AWA.Questions.Models.Question_Ref'Class);

   --  Load the question.
   procedure Load_Question (Model    : in Question_Service;
                            Question : in out AWA.Questions.Models.Question_Ref'Class;
                            Id       : in ADO.Identifier);

   --  Create or save the answer.
   procedure Save_Answer (Model    : in Question_Service;
                          Question : in AWA.Questions.Models.Question_Ref'Class;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class);

   --  Load the answer.
   procedure Load_Answer (Model  : in Question_Service;
                          Answer : in out AWA.Questions.Models.Answer_Ref'Class;
                          Id     : in ADO.Identifier);

private

   type Question_Service is new AWA.Modules.Module_Manager with null record;

end AWA.Questions.Services;

-----------------------------------------------------------------------
--  awa-questions-services -- Service services
--  Copyright (C) 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 ADO;

with Security.Permissions;

with AWA.Modules;
with AWA.Questions.Models;
package AWA.Questions.Services is

   --  Define the permissions.
   package ACL_Create_Questions is new Security.Permissions.Definition ("question-create");
   package ACL_Delete_Questions is new Security.Permissions.Definition ("question-delete");
   package ACL_Update_Questions is new Security.Permissions.Definition ("question-update");
   package ACL_Answer_Questions is new Security.Permissions.Definition ("answer-create");

   --  The maximum length for a short description.
   SHORT_DESCRIPTION_LENGTH : constant Positive := 200;

   --  ------------------------------
   --  Service services
   --  ------------------------------
   type Question_Service is new AWA.Modules.Module_Manager with private;
   type Question_Service_Access is access all Question_Service'Class;

   --  Create or save the question.
   procedure Save_Question (Model    : in Question_Service;
                            Question : in out AWA.Questions.Models.Question_Ref'Class);

   --  Delete the question.
   procedure Delete_Question (Model    : in Question_Service;
                              Question : in out AWA.Questions.Models.Question_Ref'Class);

   --  Load the question.
   procedure Load_Question (Model    : in Question_Service;
                            Question : in out AWA.Questions.Models.Question_Ref'Class;
                            Id       : in ADO.Identifier);

   --  Create or save the answer.
   procedure Save_Answer (Model    : in Question_Service;
                          Question : in AWA.Questions.Models.Question_Ref'Class;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class);

   --  Load the answer.
   procedure Load_Answer (Model    : in Question_Service;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class;
                          Question : in out AWA.Questions.Models.Question_Ref'Class;
                          Id       : in ADO.Identifier);

private

   type Question_Service is new AWA.Modules.Module_Manager with null record;

end AWA.Questions.Services;

Load the question associated with the answer


------------------------------------------------------------------------------
--                                                                          --
--                     Copyright (C) 2015-2016, AdaCore                     --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Unchecked_Conversion;
with Cortex_M.Cache; use Cortex_M.Cache;

with STM32.DMA2D;    use STM32.DMA2D;

package body STM32.DMA2D_Bitmap is

   function To_DMA2D_CM is new Ada.Unchecked_Conversion
     (HAL.Bitmap.Bitmap_Color_Mode, STM32.DMA2D.DMA2D_Color_Mode);

   function To_DMA2D_Color is new Ada.Unchecked_Conversion
     (HAL.Bitmap.Bitmap_Color, STM32.DMA2D.DMA2D_Color);

   ---------------------
   -- To_DMA2D_Buffer --
   ---------------------

   function To_DMA2D_Buffer
     (Buffer : HAL.Bitmap.Bitmap_Buffer'Class) return DMA2D_Buffer
   is
      Color_Mode : constant DMA2D_Color_Mode :=
        To_DMA2D_CM (Buffer.Color_Mode);
      Ret : DMA2D_Buffer (Color_Mode);
   begin
      Ret.Addr := Buffer.Addr;
      Ret.Width := (if Buffer.Swapped then Buffer.Height
                             else Buffer.Width);
      Ret.Height := (if Buffer.Swapped then Buffer.Width
                     else Buffer.Height);
      return Ret;
   end To_DMA2D_Buffer;

   ---------------
   -- Set_Pixel --
   ---------------

   overriding procedure Set_Pixel
     (Buffer : DMA2D_Bitmap_Buffer;
      X      : Natural;
      Y      : Natural;
      Value  : UInt32)
   is
   begin
      DMA2D_Wait_Transfer;
      HAL.Bitmap.Bitmap_Buffer (Buffer).Set_Pixel (X, Y, Value);
   end Set_Pixel;

   ---------------------
   -- Set_Pixel_Blend --
   ---------------------

   overriding procedure Set_Pixel_Blend
     (Buffer : DMA2D_Bitmap_Buffer;
      X      : Natural;
      Y      : Natural;
      Value  : HAL.Bitmap.Bitmap_Color)
   is
      DMA_Buf : constant DMA2D_Buffer := To_DMA2D_Buffer (Buffer);
   begin
      if To_DMA2D_CM (Buffer.Color_Mode) in DMA2D_Dst_Color_Mode then
         if not Buffer.Swapped then
            DMA2D_Set_Pixel_Blend
              (Buffer => DMA_Buf,
               X      => X,
               Y      => Y,
               Color  => To_DMA2D_Color (Value));
         else
            DMA2D_Set_Pixel_Blend
              (Buffer => DMA_Buf,
               X      => Y,
               Y      => Buffer.Width - X - 1,
               Color  => To_DMA2D_Color (Value));
         end if;
      else
         HAL.Bitmap.Bitmap_Buffer (Buffer).Set_Pixel_Blend (X, Y, Value);
      end if;
   end Set_Pixel_Blend;

   ---------------
   -- Get_Pixel --
   ---------------

   overriding function Get_Pixel
     (Buffer : DMA2D_Bitmap_Buffer;
      X      : Natural;
      Y      : Natural) return UInt32
   is
   begin
      DMA2D_Wait_Transfer;
      return HAL.Bitmap.Bitmap_Buffer (Buffer).Get_Pixel (X, Y);
   end Get_Pixel;

   ----------
   -- Fill --
   ----------

   overriding procedure Fill
     (Buffer : DMA2D_Bitmap_Buffer;
      Color  : UInt32)
   is
   begin
      if To_DMA2D_CM (Buffer.Color_Mode) in DMA2D_Dst_Color_Mode then
         DMA2D_Fill (To_DMA2D_Buffer (Buffer), Color, True);
      else
         HAL.Bitmap.Bitmap_Buffer (Buffer).Fill (Color);
      end if;
   end Fill;

   ---------------
   -- Fill_Rect --
   ---------------

   overriding procedure Fill_Rect
     (Buffer : DMA2D_Bitmap_Buffer;
      Color  : UInt32;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer)
   is
      DMA_Buf : constant DMA2D_Buffer := To_DMA2D_Buffer (Buffer);
      W, H    : Integer;
   begin
      if X >= Buffer.Width or else Y >= Buffer.Height then
         return;
      end if;

      if X + Width >= Buffer.Width then
         W := Buffer.Width - X - 1;
      else
         W := Width;
      end if;

      if Y + Height >= Buffer.Height then
         H := Buffer.Height - Y - 1;
      else
         H := Height;
      end if;

      if To_DMA2D_CM (Buffer.Color_Mode) in DMA2D_Dst_Color_Mode then
         if not Buffer.Swapped then
            DMA2D_Fill_Rect
              (DMA_Buf,
               Color  => Color,
               X      => X,
               Y      => Y,
               Width  => W,
               Height => H);
         else
            DMA2D_Fill_Rect
              (DMA_Buf,
               Color  => Color,
               X      => Y,
               Y      => Buffer.Width - X - W,
               Width  => H,
               Height => W);
         end if;
      else
         HAL.Bitmap.Bitmap_Buffer (Buffer).Fill_Rect
           (Color, X, Y, Width, Height);
      end if;
   end Fill_Rect;

   ---------------
   -- Copy_Rect --
   ---------------

   overriding procedure Copy_Rect
     (Src_Buffer  : HAL.Bitmap.Bitmap_Buffer'Class;
      X_Src       : Natural;
      Y_Src       : Natural;
      Dst_Buffer  : DMA2D_Bitmap_Buffer;
      X_Dst       : Natural;
      Y_Dst       : Natural;
      Bg_Buffer   : HAL.Bitmap.Bitmap_Buffer'Class;
      X_Bg        : Natural;
      Y_Bg        : Natural;
      Width       : Natural;
      Height      : Natural;
      Synchronous : Boolean)
   is
      use type System.Address;
      DMA_Buf_Src : constant DMA2D_Buffer := To_DMA2D_Buffer (Src_Buffer);
      DMA_Buf_Dst : constant DMA2D_Buffer := To_DMA2D_Buffer (Dst_Buffer);
      DMA_Buf_Bg  : DMA2D_Buffer := To_DMA2D_Buffer (Bg_Buffer);
      X0_Src      : Natural := X_Src;
      Y0_Src      : Natural := Y_Src;
      X0_Dst      : Natural := X_Dst;
      Y0_Dst      : Natural := Y_Dst;
      X0_Bg       : Natural := X_Bg;
      Y0_Bg       : Natural := Y_Bg;
      W           : Natural := Width;
      H           : Natural := Height;
   begin
      if Src_Buffer.Swapped then
         X0_Src := Y_Src;
         Y0_Src := Src_Buffer.Width - X_Src - Width;
      end if;

      if Dst_Buffer.Swapped then
         X0_Dst := Y_Dst;
         Y0_Dst := Dst_Buffer.Width - X_Dst - Width;
         W := Height;
         H := Width;
      end if;

      if Bg_Buffer.Addr = System.Null_Address then
         DMA_Buf_Bg := STM32.DMA2D.Null_Buffer;
         X0_Bg := 0;
         Y0_Bg := 0;
      elsif Bg_Buffer.Swapped then
         X0_Bg := Y_Bg;
         Y0_Bg := Bg_Buffer.Width - X_Bg - Width;
      end if;

      Cortex_M.Cache.Clean_DCache (Src_Buffer.Addr, Src_Buffer.Buffer_Size);

      DMA2D_Copy_Rect
        (DMA_Buf_Src, X0_Src, Y0_Src,
         DMA_Buf_Dst, X0_Dst, Y0_Dst,
         DMA_Buf_Bg, X0_Bg, Y0_Bg,
         W, H,
         Synchronous => Synchronous);
   end Copy_Rect;

   -------------------
   -- Wait_Transfer --
   -------------------

   overriding procedure Wait_Transfer (Buffer : DMA2D_Bitmap_Buffer)
   is
   begin
      DMA2D_Wait_Transfer;
      Cortex_M.Cache.Clean_Invalidate_DCache
        (Start => Buffer.Addr,
         Len   => Buffer.Buffer_Size);
   end Wait_Transfer;

end STM32.DMA2D_Bitmap;

------------------------------------------------------------------------------
--                                                                          --
--                     Copyright (C) 2015-2016, AdaCore                     --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Unchecked_Conversion;
with Cortex_M.Cache; use Cortex_M.Cache;

with STM32.DMA2D;    use STM32.DMA2D;

package body STM32.DMA2D_Bitmap is

   function To_DMA2D_CM is new Ada.Unchecked_Conversion
     (HAL.Bitmap.Bitmap_Color_Mode, STM32.DMA2D.DMA2D_Color_Mode);

   function To_DMA2D_Color is new Ada.Unchecked_Conversion
     (HAL.Bitmap.Bitmap_Color, STM32.DMA2D.DMA2D_Color);

   ---------------------
   -- To_DMA2D_Buffer --
   ---------------------

   function To_DMA2D_Buffer
     (Buffer : HAL.Bitmap.Bitmap_Buffer'Class) return DMA2D_Buffer
   is
      Color_Mode : constant DMA2D_Color_Mode :=
        To_DMA2D_CM (Buffer.Color_Mode);
      Ret : DMA2D_Buffer (Color_Mode);
   begin
      Ret.Addr := Buffer.Addr;
      Ret.Width := (if Buffer.Swapped then Buffer.Height
                             else Buffer.Width);
      Ret.Height := (if Buffer.Swapped then Buffer.Width
                     else Buffer.Height);
      return Ret;
   end To_DMA2D_Buffer;

   ---------------
   -- Set_Pixel --
   ---------------

   overriding procedure Set_Pixel
     (Buffer : DMA2D_Bitmap_Buffer;
      X      : Natural;
      Y      : Natural;
      Value  : UInt32)
   is
   begin
      DMA2D_Wait_Transfer;
      HAL.Bitmap.Bitmap_Buffer (Buffer).Set_Pixel (X, Y, Value);
   end Set_Pixel;

   ---------------------
   -- Set_Pixel_Blend --
   ---------------------

   overriding procedure Set_Pixel_Blend
     (Buffer : DMA2D_Bitmap_Buffer;
      X      : Natural;
      Y      : Natural;
      Value  : HAL.Bitmap.Bitmap_Color)
   is
      DMA_Buf : constant DMA2D_Buffer := To_DMA2D_Buffer (Buffer);
   begin
      if To_DMA2D_CM (Buffer.Color_Mode) in DMA2D_Dst_Color_Mode then
         if not Buffer.Swapped then
            DMA2D_Set_Pixel_Blend
              (Buffer => DMA_Buf,
               X      => X,
               Y      => Y,
               Color  => To_DMA2D_Color (Value));
         else
            DMA2D_Set_Pixel_Blend
              (Buffer => DMA_Buf,
               X      => Y,
               Y      => Buffer.Width - X - 1,
               Color  => To_DMA2D_Color (Value));
         end if;
      else
         HAL.Bitmap.Bitmap_Buffer (Buffer).Set_Pixel_Blend (X, Y, Value);
      end if;
   end Set_Pixel_Blend;

   ---------------
   -- Get_Pixel --
   ---------------

   overriding function Get_Pixel
     (Buffer : DMA2D_Bitmap_Buffer;
      X      : Natural;
      Y      : Natural) return UInt32
   is
   begin
      DMA2D_Wait_Transfer;
      return HAL.Bitmap.Bitmap_Buffer (Buffer).Get_Pixel (X, Y);
   end Get_Pixel;

   ----------
   -- Fill --
   ----------

   overriding procedure Fill
     (Buffer : DMA2D_Bitmap_Buffer;
      Color  : UInt32)
   is
   begin
      if To_DMA2D_CM (Buffer.Color_Mode) in DMA2D_Dst_Color_Mode then
         DMA2D_Fill (To_DMA2D_Buffer (Buffer), Color, True);
      else
         HAL.Bitmap.Bitmap_Buffer (Buffer).Fill (Color);
      end if;
   end Fill;

   ---------------
   -- Fill_Rect --
   ---------------

   overriding procedure Fill_Rect
     (Buffer : DMA2D_Bitmap_Buffer;
      Color  : UInt32;
      X      : Integer;
      Y      : Integer;
      Width  : Integer;
      Height : Integer)
   is
      DMA_Buf : constant DMA2D_Buffer := To_DMA2D_Buffer (Buffer);
      W, H    : Integer;
   begin
      if X >= Buffer.Width or else Y >= Buffer.Height then
         return;
      end if;

      if X + Width > Buffer.Width then
         W := Buffer.Width - X;
      else
         W := Width;
      end if;

      if Y + Height > Buffer.Height then
         H := Buffer.Height - Y;
      else
         H := Height;
      end if;

      if To_DMA2D_CM (Buffer.Color_Mode) in DMA2D_Dst_Color_Mode then
         if not Buffer.Swapped then
            DMA2D_Fill_Rect
              (DMA_Buf,
               Color  => Color,
               X      => X,
               Y      => Y,
               Width  => W,
               Height => H);
         else
            DMA2D_Fill_Rect
              (DMA_Buf,
               Color  => Color,
               X      => Y,
               Y      => Buffer.Width - X - W,
               Width  => H,
               Height => W);
         end if;
      else
         HAL.Bitmap.Bitmap_Buffer (Buffer).Fill_Rect
           (Color, X, Y, Width, Height);
      end if;
   end Fill_Rect;

   ---------------
   -- Copy_Rect --
   ---------------

   overriding procedure Copy_Rect
     (Src_Buffer  : HAL.Bitmap.Bitmap_Buffer'Class;
      X_Src       : Natural;
      Y_Src       : Natural;
      Dst_Buffer  : DMA2D_Bitmap_Buffer;
      X_Dst       : Natural;
      Y_Dst       : Natural;
      Bg_Buffer   : HAL.Bitmap.Bitmap_Buffer'Class;
      X_Bg        : Natural;
      Y_Bg        : Natural;
      Width       : Natural;
      Height      : Natural;
      Synchronous : Boolean)
   is
      use type System.Address;
      DMA_Buf_Src : constant DMA2D_Buffer := To_DMA2D_Buffer (Src_Buffer);
      DMA_Buf_Dst : constant DMA2D_Buffer := To_DMA2D_Buffer (Dst_Buffer);
      DMA_Buf_Bg  : DMA2D_Buffer := To_DMA2D_Buffer (Bg_Buffer);
      X0_Src      : Natural := X_Src;
      Y0_Src      : Natural := Y_Src;
      X0_Dst      : Natural := X_Dst;
      Y0_Dst      : Natural := Y_Dst;
      X0_Bg       : Natural := X_Bg;
      Y0_Bg       : Natural := Y_Bg;
      W           : Natural := Width;
      H           : Natural := Height;
   begin
      if Src_Buffer.Swapped then
         X0_Src := Y_Src;
         Y0_Src := Src_Buffer.Width - X_Src - Width;
      end if;

      if Dst_Buffer.Swapped then
         X0_Dst := Y_Dst;
         Y0_Dst := Dst_Buffer.Width - X_Dst - Width;
         W := Height;
         H := Width;
      end if;

      if Bg_Buffer.Addr = System.Null_Address then
         DMA_Buf_Bg := STM32.DMA2D.Null_Buffer;
         X0_Bg := 0;
         Y0_Bg := 0;
      elsif Bg_Buffer.Swapped then
         X0_Bg := Y_Bg;
         Y0_Bg := Bg_Buffer.Width - X_Bg - Width;
      end if;

      Cortex_M.Cache.Clean_DCache (Src_Buffer.Addr, Src_Buffer.Buffer_Size);

      DMA2D_Copy_Rect
        (DMA_Buf_Src, X0_Src, Y0_Src,
         DMA_Buf_Dst, X0_Dst, Y0_Dst,
         DMA_Buf_Bg, X0_Bg, Y0_Bg,
         W, H,
         Synchronous => Synchronous);
   end Copy_Rect;

   -------------------
   -- Wait_Transfer --
   -------------------

   overriding procedure Wait_Transfer (Buffer : DMA2D_Bitmap_Buffer)
   is
   begin
      DMA2D_Wait_Transfer;
      Cortex_M.Cache.Clean_Invalidate_DCache
        (Start => Buffer.Addr,
         Len   => Buffer.Buffer_Size);
   end Wait_Transfer;

end STM32.DMA2D_Bitmap;

Fix check for overflow in the DMA2D driver (FillRect).


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

with Util.Log.Loggers;

with AWS.Config.Set;
with ASF.Server.Web;
with AWA.Setup.Applications;

with Atlas.Applications;
procedure Atlas.Server is

   procedure Configure (Config : in out AWS.Config.Object);

   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;
   WS      : ASF.Server.Web.AWS_Container;

   procedure Setup is
     new AWA.Setup.Applications.Configure (Atlas.Applications.Application'Class,
                                           Atlas.Applications.Application_Access,
                                           Atlas.Applications.Initialize);

   procedure Configure (Config : in out AWS.Config.Object) is
   begin
      AWS.Config.Set.Input_Line_Size_Limit (1_000_000);
      AWS.Config.Set.Max_Connection (Config, 2);
      AWS.Config.Set.Accept_Queue_Size (Config, 100);
      AWS.Config.Set.Send_Buffer_Size (Config, 128 * 1024);
      AWS.Config.Set.Upload_Size_Limit (Config, 100_000_000);
   end Configure;

begin
   WS.Configure (Configure'Access);
   WS.Start;
   Log.Info ("Connect you browser to: http://localhost:8080{0}/index.html",
             Atlas.Applications.CONTEXT_PATH);
   Setup (WS, App, "atlas", Atlas.Applications.CONTEXT_PATH);
   delay 365.0 * 24.0 * 3600.0;
   App.Close;
exception
   when E : others =>
      Log.Error ("Exception in server: " &
                 Ada.Exceptions.Exception_Name (E) & ": " &
                 Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

-----------------------------------------------------------------------
--  atlas-server -- Application server
--  Copyright (C) 2011, 2012, 2013, 2016, 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.Exceptions;

with Util.Log.Loggers;

with AWS.Net.SSL;
with AWS.Config.Set;
with ASF.Server.Web;
with AWA.Setup.Applications;

with Atlas.Applications;
procedure Atlas.Server is

   procedure Configure (Config : in out AWS.Config.Object);

   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;
   WS      : ASF.Server.Web.AWS_Container;

   procedure Setup is
     new AWA.Setup.Applications.Configure (Atlas.Applications.Application'Class,
                                           Atlas.Applications.Application_Access,
                                           Atlas.Applications.Initialize);

   procedure Configure (Config : in out AWS.Config.Object) is
   begin
      AWS.Config.Set.Input_Line_Size_Limit (1_000_000);
      AWS.Config.Set.Max_Connection (Config, 2);
      AWS.Config.Set.Accept_Queue_Size (Config, 100);
      AWS.Config.Set.Send_Buffer_Size (Config, 128 * 1024);
      AWS.Config.Set.Upload_Size_Limit (Config, 100_000_000);
   end Configure;

begin
   WS.Configure (Configure'Access);
   WS.Start;
   Log.Info ("Connect you browser to: http://localhost:8080{0}/index.html",
             Atlas.Applications.CONTEXT_PATH);
   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OAuth2/OpenID connector to "
                 & "connect to OAuth2/OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
   end if;
   Setup (WS, App, "atlas", Atlas.Applications.CONTEXT_PATH);
   delay 365.0 * 24.0 * 3600.0;
   App.Close;
exception
   when E : others =>
      Log.Error ("Exception in server: " &
                 Ada.Exceptions.Exception_Name (E) & ": " &
                 Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

Check that AWS supports SSL and report an error message if this is not the case


-----------------------------------------------------------------------
--  Util.Streams -- Stream utilities
--  Copyright (C) 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 Util.Streams is

   use Ada.Streams;

   --  ------------------------------
   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   --  ------------------------------
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class) is
      Buffer : Stream_Element_Array (0 .. 4_096);
      Last   : Stream_Element_Offset;
   begin
      loop
         From.Read (Buffer, Last);
         if Last > Buffer'First then
            Into.Write (Buffer (Buffer'First .. Last));
         end if;
         exit when Last < Buffer'Last;
      end loop;
   end Copy;

end Util.Streams;

-----------------------------------------------------------------------
--  Util.Streams -- Stream utilities
--  Copyright (C) 2010, 2011, 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.
-----------------------------------------------------------------------

package body Util.Streams is

   use Ada.Streams;

   --  ------------------------------
   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   --  ------------------------------
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class) is
      Buffer : Stream_Element_Array (0 .. 4_096);
      Last   : Stream_Element_Offset;
   begin
      loop
         From.Read (Buffer, Last);
         if Last > Buffer'First then
            Into.Write (Buffer (Buffer'First .. Last));
         end if;
         exit when Last < Buffer'Last;
      end loop;
   end Copy;

   --  ------------------------------
   --  Copy the stream array to the string.
   --  The string must be large enough to hold the stream array
   --  or a Constraint_Error exception is raised.
   --  ------------------------------
   procedure Copy (From : in Ada.Streams.Stream_Element_Array;
                   Into : in out String) is
      Pos : Positive := Into'First;
   begin
      for I in From'Range loop
         Into (Pos) := Character'Val (From (I));
         Pos := Pos + 1;
      end loop;
   end Copy;

   --  ------------------------------
   --  Copy the string to the stream array.
   --  The stream array must be large enough to hold the string
   --  or a Constraint_Error exception is raised.
   --  ------------------------------
   procedure Copy (From : in String;
                   Into : in out Ada.Streams.Stream_Element_Array) is
      Pos : Ada.Streams.Stream_Element_Offset := Into'First;
   begin
      for I in From'Range loop
         Into (Pos) := Character'Pos (From (I));
         Pos := Pos + 1;
      end loop;
   end Copy;

end Util.Streams;

Implement Copy procedure to copy a String to a Stream_Element_Array


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

with Wiki.Documents;
with Wiki.Attributes;

--  == Wiki Parsers ==
--  The Wikis.Parsers package implements a parser for several well known wiki formats.
--  The parser works with the Document_Reader interface type which defines several
--  procedures that are called by the parser when the wiki text is scanned.
package Wiki.Parsers is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax_Type
     is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  A mix of the above
         SYNTAX_MIX);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  specified in Syntax and invoke the document reader procedures defined
   --  by into.
   procedure Parse (Into   : in Wiki.Documents.Document_Reader_Access;
                    Text   : in Wide_Wide_String;
                    Syntax : in Wiki_Syntax_Type := SYNTAX_MIX);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);
   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   CR : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0D#);

   type Input is interface;
   type Input_Access is access all Input'Class;
   procedure Read_Char (From : in out Input;
                        Token : out Wide_Wide_Character;
                        Eof   : out Boolean) is abstract;

   type Parser is limited record
      Pending             : Wide_Wide_Character;
      Has_Pending         : Boolean;
      Document            : Wiki.Documents.Document_Reader_Access;
      Format              : Wiki.Documents.Format_Map;
      Text                : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Token               : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wide_Wide_Character;
      List_Level          : Natural := 0;
      Reader              : Input_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List_Type;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wide_Wide_Character);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access Parser_Table;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wide_Wide_Character);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wide_Wide_Character);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   procedure Start_Element (P          : in out Parser;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (P    : in out Parser;
                          Name : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

end Wiki.Parsers;

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

with Wiki.Documents;
with Wiki.Attributes;

--  == Wiki Parsers ==
--  The Wikis.Parsers package implements a parser for several well known wiki formats.
--  The parser works with the Document_Reader interface type which defines several
--  procedures that are called by the parser when the wiki text is scanned.
package Wiki.Parsers is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax_Type
     is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  A mix of the above
         SYNTAX_MIX,

         --  The input is plain possibly incorrect HTML.
         SYNTAX_HTML);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  specified in Syntax and invoke the document reader procedures defined
   --  by into.
   procedure Parse (Into   : in Wiki.Documents.Document_Reader_Access;
                    Text   : in Wide_Wide_String;
                    Syntax : in Wiki_Syntax_Type := SYNTAX_MIX);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);
   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   CR : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0D#);

   type Input is interface;
   type Input_Access is access all Input'Class;
   procedure Read_Char (From : in out Input;
                        Token : out Wide_Wide_Character;
                        Eof   : out Boolean) is abstract;

   type Parser is limited record
      Pending             : Wide_Wide_Character;
      Has_Pending         : Boolean;
      Document            : Wiki.Documents.Document_Reader_Access;
      Format              : Wiki.Documents.Format_Map;
      Text                : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Token               : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wide_Wide_Character;
      List_Level          : Natural := 0;
      Reader              : Input_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List_Type;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wide_Wide_Character);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access Parser_Table;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wide_Wide_Character);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wide_Wide_Character);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   procedure Start_Element (P          : in out Parser;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (P    : in out Parser;
                          Name : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

end Wiki.Parsers;

Add SYNTAX_HTML to parse HTML

Add SYNTAX_HTML to parse HTML


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

with ASF.Applications;

package body ASF.Servlets.Faces is

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Faces_Servlet;
                         Context : in Servlet_Registry'Class) is
      pragma Unreferenced (Context);

      Ctx : constant Servlet_Registry_Access := Server.Get_Servlet_Context;
   begin
      if Ctx.all in ASF.Applications.Main.Application'Class then
         Server.App := ASF.Applications.Main.Application'Class (Ctx.all)'Unchecked_Access;
      end if;
   end Initialize;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   --  ------------------------------
   procedure Do_Get (Server   : in Faces_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Servlet_Path;
   begin
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Get;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a POST request. The HTTP POST method allows the client to send data of unlimited
   --  length to the Web server a single time and is useful when posting information
   --  such as credit card numbers.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding. When using
   --  a PrintWriter object to return the response, set the content type before
   --  accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container to use
   --  a persistent connection to return its response to the client, improving
   --  performance. The content length is automatically set if the entire response
   --  fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  This method does not need to be either safe or idempotent. Operations
   --  requested through POST can have side effects for which the user can be held
   --  accountable, for example, updating stored data or buying items online.
   --
   --  If the HTTP POST request is incorrectly formatted, doPost returns
   --  an HTTP "Bad Request" message.
   --  ------------------------------
   procedure Do_Post (Server   : in Faces_Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Servlet_Path;
   begin
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Post;

end ASF.Servlets.Faces;

-----------------------------------------------------------------------
--  asf.servlets.faces -- Faces servlet
--  Copyright (C) 2010, 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 Util.Log.Loggers;
with ASF.Applications;

package body ASF.Servlets.Faces is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Servlets.Faces");

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Faces_Servlet;
                         Context : in Servlet_Registry'Class) is
      pragma Unreferenced (Context);

      Ctx : constant Servlet_Registry_Access := Server.Get_Servlet_Context;
   begin
      if Ctx.all in ASF.Applications.Main.Application'Class then
         Server.App := ASF.Applications.Main.Application'Class (Ctx.all)'Unchecked_Access;
      end if;
   end Initialize;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   --  ------------------------------
   procedure Do_Get (Server   : in Faces_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Servlet_Path;
   begin
      Log.Info ("GET {0}", URI);
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Get;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a POST request. The HTTP POST method allows the client to send data of unlimited
   --  length to the Web server a single time and is useful when posting information
   --  such as credit card numbers.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding. When using
   --  a PrintWriter object to return the response, set the content type before
   --  accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container to use
   --  a persistent connection to return its response to the client, improving
   --  performance. The content length is automatically set if the entire response
   --  fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  This method does not need to be either safe or idempotent. Operations
   --  requested through POST can have side effects for which the user can be held
   --  accountable, for example, updating stored data or buying items online.
   --
   --  If the HTTP POST request is incorrectly formatted, doPost returns
   --  an HTTP "Bad Request" message.
   --  ------------------------------
   procedure Do_Post (Server   : in Faces_Servlet;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class) is
      URI    : constant String := Request.Get_Servlet_Path;
   begin
      Log.Info ("POST {0}", URI);
      Server.App.Dispatch (Page     => URI,
                           Request  => Request,
                           Response => Response);
   end Do_Post;

end ASF.Servlets.Faces;

Add a Log.Info for each GET and POST request to help trouble shoting web issues


-----------------------------------------------------------------------
--  awa-workspaces-beans -- Beans for module workspaces
--  Copyright (C) 2011, 2012, 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 ASF.Events.Faces.Actions;

with ADO.Utils;
with ADO.Sessions.Entities;
with ADO.Sessions;
with ADO.Queries;
with ADO.Datasets;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;
package body AWA.Workspaces.Beans is

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Member_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Workspaces.Models.Member_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name
   --  ------------------------------
   overriding
   procedure Set_Value (Item  : in out Member_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         Item.Set_Id (ADO.Utils.To_Identifier (Value));
      else
         AWA.Workspaces.Models.Member_Bean (Item).Set_Value (Name, Value);
      end if;
   end Set_Value;

   overriding
   procedure Load (Bean : in out Member_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Load;

   overriding
   procedure Delete (Bean : in out Member_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Delete_Member (Bean.Get_Id);
   end Delete;

   --  ------------------------------
   --  Create the Member_Bean bean instance.
   --  ------------------------------
   function Create_Member_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_Bean_Access := new Member_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Member_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Invitation_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "inviter" then
         return From.Inviter.Get_Value ("name");
      else
         return AWA.Workspaces.Models.Invitation_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Load_Invitation (Key        => Ada.Strings.Unbounded.To_String (Bean.Key),
                                   Invitation => Bean,
                                   Inviter    => Bean.Inviter);

   exception
      when others =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
   end Load;

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Accept_Invitation (Key => Ada.Strings.Unbounded.To_String (Bean.Key));
   end Accept_Invitation;

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Send_Invitation (Bean);
   end Send;

   --  ------------------------------
   --  Create the Invitation_Bean bean instance.
   --  ------------------------------
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Invitation_Bean_Access := new Invitation_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Invitation_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Action;

   --  ------------------------------
   --  Event action called to create the workspace when the given event is posted.
   --  ------------------------------
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Bean, Event);

      WS  : AWA.Workspaces.Models.Workspace_Ref;
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (Session   => DB,
                                            Context   => Ctx,
                                            Workspace => WS);
      Ctx.Commit;
   end Create;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Workspaces_Bean,
                                                      Method => Action,
                                                      Name   => "action");

   package Create_Binding is
      new AWA.Events.Action_Method.Bind (Name   => "create",
                                         Bean   => Workspaces_Bean,
                                         Method => Create);

   Workspaces_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (Value);
      end if;
   end Set_Value;

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

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Workspaces_Bean_Access := new Workspaces_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Workspaces_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Member_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" then
         return Util.Beans.Objects.To_Object (Value   => From.Members_Bean,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return AWA.Workspaces.Models.Member_List_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Load the list of members.
   --  ------------------------------
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session     : ADO.Sessions.Session := Into.Module.Get_Session;
      Query       : ADO.Queries.Context;
      Count_Query : ADO.Queries.Context;
      First       : constant Natural  := (Into.Page - 1) * Into.Page_Size;
   begin
      Query.Set_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
      Count_Query.Set_Count_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
--        ADO.Sessions.Entities.Bind_Param (Params  => Query,
--                                          Name    => "page_table",
--                                          Table   => AWA.Wikis.Models.WIKI_PAGE_TABLE,
--                                          Session => Session);
      Query.Bind_Param (Name => "user_id", Value => User);
      Count_Query.Bind_Param (Name => "user_id", Value => User);
      AWA.Workspaces.Models.List (Into.Members, Session, Query);
      Into.Count := ADO.Datasets.Get_Count (Session, Count_Query);
   end Load;

   --  ------------------------------
   --  Create the Member_List_Bean bean instance.
   --  ------------------------------
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_List_Bean_Access := new Member_List_Bean;
   begin
      Object.Module     := Module;
      Object.Members_Bean := Object.Members'Access;
      Object.Page_Size  := 20;
      Object.Page       := 1;
      Object.Count      := 0;
      return Object.all'Access;
   end Create_Member_List_Bean;

end AWA.Workspaces.Beans;

-----------------------------------------------------------------------
--  awa-workspaces-beans -- Beans for module workspaces
--  Copyright (C) 2011, 2012, 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 ASF.Events.Faces.Actions;
with ASF.Contexts.Flash;
with ASF.Contexts.Faces;
with ASF.Applications.Messages.Factory;

with ADO.Utils;
with ADO.Sessions;
with ADO.Queries;
with ADO.Datasets;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;
package body AWA.Workspaces.Beans is

   use ASF.Applications;

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Member_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Workspaces.Models.Member_Bean (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name
   --  ------------------------------
   overriding
   procedure Set_Value (Item  : in out Member_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         Item.Set_Id (ADO.Utils.To_Identifier (Value));
      else
         AWA.Workspaces.Models.Member_Bean (Item).Set_Value (Name, Value);
      end if;
   end Set_Value;

   overriding
   procedure Load (Bean : in out Member_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Load;

   overriding
   procedure Delete (Bean : in out Member_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Delete_Member (Bean.Get_Id);
   end Delete;

   --  ------------------------------
   --  Create the Member_Bean bean instance.
   --  ------------------------------
   function Create_Member_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_Bean_Access := new Member_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Member_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Invitation_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "inviter" then
         return From.Inviter.Get_Value ("name");
      else
         return AWA.Workspaces.Models.Invitation_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Load_Invitation (Key        => Ada.Strings.Unbounded.To_String (Bean.Key),
                                   Invitation => Bean,
                                   Inviter    => Bean.Inviter);

   exception
      when others =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
   end Load;

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Bean.Module.Accept_Invitation (Key => Ada.Strings.Unbounded.To_String (Bean.Key));
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "workspaces.workspace_welcome_message",
                                    Messages.INFO);
   end Accept_Invitation;

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Bean.Module.Send_Invitation (Bean);
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "workspaces.workspace_invitation_sent",
                                    Messages.INFO);
   end Send;

   --  ------------------------------
   --  Create the Invitation_Bean bean instance.
   --  ------------------------------
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Invitation_Bean_Access := new Invitation_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Invitation_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Action;

   --  ------------------------------
   --  Event action called to create the workspace when the given event is posted.
   --  ------------------------------
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Bean, Event);

      WS  : AWA.Workspaces.Models.Workspace_Ref;
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (Session   => DB,
                                            Context   => Ctx,
                                            Workspace => WS);
      Ctx.Commit;
   end Create;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Workspaces_Bean,
                                                      Method => Action,
                                                      Name   => "action");

   package Create_Binding is
      new AWA.Events.Action_Method.Bind (Name   => "create",
                                         Bean   => Workspaces_Bean,
                                         Method => Create);

   Workspaces_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (Value);
      end if;
   end Set_Value;

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

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Workspaces_Bean_Access := new Workspaces_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Workspaces_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Member_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" then
         return Util.Beans.Objects.To_Object (Value   => From.Members_Bean,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return AWA.Workspaces.Models.Member_List_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Load the list of members.
   --  ------------------------------
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session     : ADO.Sessions.Session := Into.Module.Get_Session;
      Query       : ADO.Queries.Context;
      Count_Query : ADO.Queries.Context;
      First       : constant Natural  := (Into.Page - 1) * Into.Page_Size;
   begin
      Query.Set_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
      Count_Query.Set_Count_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
      Query.Bind_Param (Name => "user_id", Value => User);
      Count_Query.Bind_Param (Name => "user_id", Value => User);
      AWA.Workspaces.Models.List (Into.Members, Session, Query);
      Into.Count := ADO.Datasets.Get_Count (Session, Count_Query);
   end Load;

   --  ------------------------------
   --  Create the Member_List_Bean bean instance.
   --  ------------------------------
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_List_Bean_Access := new Member_List_Bean;
   begin
      Object.Module     := Module;
      Object.Members_Bean := Object.Members'Access;
      Object.Page_Size  := 20;
      Object.Page       := 1;
      Object.Count      := 0;
      return Object.all'Access;
   end Create_Member_List_Bean;

end AWA.Workspaces.Beans;

Add a flash message after the invitation is sent and accepted