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

with GNAT.Command_Line;

with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Strings.Transforms;

with Wiki.Strings;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Streams.Builders;
with Wiki.Streams.Html.Builders;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Render.Wiki;
with Wiki.Documents;
with Wiki.Parsers;

procedure Import is

   use GNAT.Command_Line;
   use Ada.Strings.Unbounded;
   use Ada.Strings.UTF_Encoding;

   procedure Usage;
   function Is_Url (Name : in String) return Boolean;
   procedure Parse_Url (Url : in String);
   procedure Parse (Content : in String);
   procedure Print (Item : in Wiki.Strings.WString);

   Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
   TOC         : aliased Wiki.Filters.TOC.TOC_Filter;
   Count       : Natural := 0;
   Html_Mode   : Boolean := True;
   Wiki_Mode   : Boolean := False;
   Syntax      : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Import HTML into a target Wiki format");
      Ada.Text_IO.Put_Line ("Usage: import [-t] [-m] [-M] [-d] [-c] {URL | file}");
      Ada.Text_IO.Put_Line ("  -t      Convert to text only");
      Ada.Text_IO.Put_Line ("  -m      Convert to Markdown");
      Ada.Text_IO.Put_Line ("  -M      Convert to Mediawiki");
      Ada.Text_IO.Put_Line ("  -d      Convert to Dotclear");
      Ada.Text_IO.Put_Line ("  -c      Convert to Creole");
   end Usage;

   procedure Print (Item : in Wiki.Strings.WString) is
   begin
      Ada.Wide_Wide_Text_IO.Put (Item);
   end Print;

   procedure Parse (Content : in String) is
      Doc    : Wiki.Documents.Document;
      Engine : Wiki.Parsers.Parser;
   begin
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Html_Filter'Unchecked_Access);
      if Wiki_Mode then
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Wiki.Wiki_Renderer;
         begin
            Engine.Set_Syntax (Wiki.SYNTAX_HTML);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access, Syntax);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      elsif Html_Mode then
         declare
            Stream   : aliased Wiki.Streams.Html.Builders.Html_Output_Stream;
            Renderer : aliased Wiki.Render.Html.Html_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      else
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Text.Text_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      end if;
      Ada.Wide_Wide_Text_IO.New_Line;
   end Parse;

   procedure Parse_Url (Url : in String) is
      Command : constant String := "wget -q -O - " & Url;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
      Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Pipe.Open (Command);
      Buffer.Initialize (Pipe'Unchecked_Access, 1024 * 1024);
      Buffer.Read (Content);
      Pipe.Close;
      if Pipe.Get_Exit_Status /= 0 then
         Ada.Text_IO.Put_Line (Command & " exited with status "
                               & Integer'Image (Pipe.Get_Exit_Status));
      else
         Parse (To_String (Content));
      end if;
   end Parse_Url;

   function Is_Url (Name : in String) return Boolean is
   begin
      if Name'Length <= 9 then
         return False;
      else
         return Name (Name'First .. Name'First + 6) = "http://"
           or Name (Name'First .. Name'First + 7) = "https://";
      end if;
   end Is_Url;

begin
   loop
      case Getopt ("m M d c t f:") is
         when 'm' =>
            Syntax := Wiki.SYNTAX_MARKDOWN;
            Wiki_Mode := True;

         when 'M' =>
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;
            Wiki_Mode := True;

         when 'c' =>
            Syntax := Wiki.SYNTAX_CREOLE;
            Wiki_Mode := True;

         when 'd' =>
            Syntax := Wiki.SYNTAX_DOTCLEAR;
            Wiki_Mode := True;

         when 't' =>
            Html_Mode := False;

         when 'f' =>
            declare
               Value : constant String := Util.Strings.Transforms.To_Upper_Case (Parameter);
            begin
               Html_Filter.Hide (Wiki.Html_Tag'Value (Value & "_TAG"));
            exception
               when Constraint_Error =>
                  Ada.Text_IO.Put_Line ("Invalid tag " & Value);
            end;

         when others =>
            exit;
      end case;
   end loop;

   loop
      declare
         Name : constant String := GNAT.Command_Line.Get_Argument;
         Data : Unbounded_String;
      begin
         if Name = "" then
            if Count = 0 then
               Usage;
            end if;
            return;
         end if;
         Count := Count + 1;
         if Is_Url (Name) then
            Parse_Url (Name);
         else
            Util.Files.Read_File (Name, Data);
            Parse (To_String (Data));
         end if;

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Ada.Text_IO.Put_Line ("Cannot read file '" & Name & "'");

      end;
   end loop;

exception
   when Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option.");
      Usage;

end Import;

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

with GNAT.Command_Line;

with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Strings.Transforms;

with Wiki.Strings;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Streams.Builders;
with Wiki.Streams.Html.Builders;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Render.Wiki;
with Wiki.Documents;
with Wiki.Parsers;

procedure Import is

   use GNAT.Command_Line;
   use Ada.Strings.Unbounded;
   use Ada.Strings.UTF_Encoding;

   procedure Usage;
   function Is_Url (Name : in String) return Boolean;
   procedure Parse_Url (Url : in String);
   procedure Parse (Content : in String);
   procedure Print (Item : in Wiki.Strings.WString);

   Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
   TOC         : aliased Wiki.Filters.TOC.TOC_Filter;
   Count       : Natural := 0;
   Html_Mode   : Boolean := True;
   Wiki_Mode   : Boolean := False;
   Syntax      : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Import HTML into a target Wiki format");
      Ada.Text_IO.Put_Line ("Usage: import [-t] [-m] [-M] [-H] [-d] [-c] {URL | file}");
      Ada.Text_IO.Put_Line ("  -t      Convert to text only");
      Ada.Text_IO.Put_Line ("  -m      Convert to Markdown");
      Ada.Text_IO.Put_Line ("  -M      Convert to Mediawiki");
      Ada.Text_IO.Put_Line ("  -H      Convert to HTML");
      Ada.Text_IO.Put_Line ("  -d      Convert to Dotclear");
      Ada.Text_IO.Put_Line ("  -c      Convert to Creole");
   end Usage;

   procedure Print (Item : in Wiki.Strings.WString) is
   begin
      Ada.Wide_Wide_Text_IO.Put (Item);
   end Print;

   procedure Parse (Content : in String) is
      Doc    : Wiki.Documents.Document;
      Engine : Wiki.Parsers.Parser;
   begin
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Html_Filter'Unchecked_Access);
      if Wiki_Mode then
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Wiki.Wiki_Renderer;
         begin
            Engine.Set_Syntax (Wiki.SYNTAX_HTML);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access, Syntax);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      elsif Html_Mode then
         declare
            Stream   : aliased Wiki.Streams.Html.Builders.Html_Output_Stream;
            Renderer : aliased Wiki.Render.Html.Html_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      else
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Text.Text_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      end if;
      Ada.Wide_Wide_Text_IO.New_Line;
   end Parse;

   procedure Parse_Url (Url : in String) is
      Command : constant String := "wget -q -O - " & Url;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
      Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Pipe.Open (Command);
      Buffer.Initialize (Pipe'Unchecked_Access, 1024 * 1024);
      Buffer.Read (Content);
      Pipe.Close;
      if Pipe.Get_Exit_Status /= 0 then
         Ada.Text_IO.Put_Line (Command & " exited with status "
                               & Integer'Image (Pipe.Get_Exit_Status));
      else
         Parse (To_String (Content));
      end if;
   end Parse_Url;

   function Is_Url (Name : in String) return Boolean is
   begin
      if Name'Length <= 9 then
         return False;
      else
         return Name (Name'First .. Name'First + 6) = "http://"
           or Name (Name'First .. Name'First + 7) = "https://";
      end if;
   end Is_Url;

begin
   loop
      case Getopt ("m M H d c t f:") is
         when 'm' =>
            Syntax := Wiki.SYNTAX_MARKDOWN;
            Wiki_Mode := True;

         when 'M' =>
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;
            Wiki_Mode := True;

         when 'H' =>
            Syntax := Wiki.SYNTAX_HTML;

         when 'c' =>
            Syntax := Wiki.SYNTAX_CREOLE;
            Wiki_Mode := True;

         when 'd' =>
            Syntax := Wiki.SYNTAX_DOTCLEAR;
            Wiki_Mode := True;

         when 't' =>
            Html_Mode := False;

         when 'f' =>
            declare
               Value : constant String := Util.Strings.Transforms.To_Upper_Case (Parameter);
            begin
               Html_Filter.Hide (Wiki.Html_Tag'Value (Value & "_TAG"));
            exception
               when Constraint_Error =>
                  Ada.Text_IO.Put_Line ("Invalid tag " & Value);
            end;

         when others =>
            exit;
      end case;
   end loop;

   loop
      declare
         Name : constant String := GNAT.Command_Line.Get_Argument;
         Data : Unbounded_String;
      begin
         if Name = "" then
            if Count = 0 then
               Usage;
            end if;
            return;
         end if;
         Count := Count + 1;
         if Is_Url (Name) then
            Parse_Url (Name);
         else
            Util.Files.Read_File (Name, Data);
            Parse (To_String (Data));
         end if;

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Ada.Text_IO.Put_Line ("Cannot read file '" & Name & "'");

      end;
   end loop;

exception
   when Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option.");
      Usage;

end Import;

Add -H option for HTML

Add -H option for HTML


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

with Util.Concurrent.Counters;

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

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

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

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

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file described File in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   File    : in AWA.Storages.Storage_File;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage instance stored in a folder and identified by a name.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Folder  : in ADO.Identifier;
                           Name    : in String;
                           Found   : out Boolean);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File);

   procedure Create_Local_File (Service : in out Storage_Service;
                                Into    : out AWA.Storages.Storage_File);

   --  Create a temporary file path.
   procedure Create_Local_File (Service : in out Storage_Service;
                                Into    : out AWA.Storages.Temporary_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
      Temp_Id        : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Storages.Services;

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

with Util.Concurrent.Counters;

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

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

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

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

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file described File in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   File    : in AWA.Storages.Storage_File;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage instance stored in a folder and identified by a name.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Folder  : in ADO.Identifier;
                           Name    : in String;
                           Found   : out Boolean);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File);

   procedure Create_Local_File (Service : in out Storage_Service;
                                Into    : in out AWA.Storages.Storage_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
      Temp_Id        : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Storages.Services;

Change Create_Local_File to use the Storage_File type


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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Tags.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Changelogs.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;
with AWA.Settings.Modules.Tests;
with AWA.Comments.Modules.Tests;
with AWA.Changelogs.Modules.Tests;
with AWA.Wikis.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Comments       : aliased AWA.Comments.Modules.Comment_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Tags           : aliased AWA.Tags.Modules.Tag_Module;

   Settings       : aliased AWA.Settings.Modules.Setting_Module;

   Changelogs     : aliased AWA.Changelogs.Modules.Changelog_Module;

   Wikis         : aliased AWA.Wikis.Modules.Wiki_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Settings.Modules.Tests.Add_Tests (Ret);
      AWA.Comments.Modules.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Changelogs.Modules.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Tags.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Comments.Modules.NAME,
                      URI    => "comments",
                      Module => Comments'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Settings.Modules.NAME,
                      URI    => "settings",
                      Module => Settings'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Changelogs.Modules.NAME,
                      URI    => "changelogs",
                      Module => Changelogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Tags.Modules.NAME,
                      URI    => "tags",
                      Module => Tags'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Wikis.Modules.NAME,
                      URI    => "wikis",
                      Module => Wikis'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Tags.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Counters.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Changelogs.Modules;
with AWA.Counters.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;
with AWA.Settings.Modules.Tests;
with AWA.Comments.Modules.Tests;
with AWA.Changelogs.Modules.Tests;
with AWA.Wikis.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Comments       : aliased AWA.Comments.Modules.Comment_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Tags           : aliased AWA.Tags.Modules.Tag_Module;

   Settings       : aliased AWA.Settings.Modules.Setting_Module;

   Changelogs     : aliased AWA.Changelogs.Modules.Changelog_Module;

   Wikis          : aliased AWA.Wikis.Modules.Wiki_Module;

   Counters       : aliased AWA.Counters.Modules.Counter_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Counters.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Settings.Modules.Tests.Add_Tests (Ret);
      AWA.Comments.Modules.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Changelogs.Modules.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Tags.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Counters.Modules.NAME,
                      URI    => "counters",
                      Module => Counters'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Comments.Modules.NAME,
                      URI    => "comments",
                      Module => Comments'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Settings.Modules.NAME,
                      URI    => "settings",
                      Module => Settings'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Changelogs.Modules.NAME,
                      URI    => "changelogs",
                      Module => Changelogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Tags.Modules.NAME,
                      URI    => "tags",
                      Module => Tags'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Wikis.Modules.NAME,
                      URI    => "wikis",
                      Module => Wikis'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

Add the unit tests for the AWA.Counters plugin


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

with AWA.Users.Models;
with AWA.Users.Principals;
with AWA.Modules;
with AWA.Events;
with Security.Auth;
with Security.Random;

with ADO;
with ADO.Sessions;

--  == Introduction ==
--  The *users* module provides a *users* service which controls the user data model.
--
--  == Events ==
--  The *users* module exposes a number of events which are posted when some action
--  are performed at the service level.
--
--  === user-register ===
--  This event is posted when a new user is registered in the application.
--  It can be used to send a registration email.
--
--  === user-create ===
--  This event is posted when a new user is created.  It can be used to trigger
--  the pre-initialization of the application for the new user.
--
--  === user-lost-password ===
--  This event is posted when a user asks for a password reset through an
--  anonymous form.  It is intended to be used to send the reset password email.
--
--  === user-reset-password ===
--  This event is posted when a user has successfully reset his password.
--  It can be used to send an email.
--
package AWA.Users.Services is

   use AWA.Users.Models;

   package User_Create_Event is new AWA.Events.Definition (Name => "user-create");
   package User_Register_Event is new AWA.Events.Definition (Name => "user-register");
   package User_Lost_Password_Event is new AWA.Events.Definition (Name => "user-lost-password");
   package User_Reset_Password_Event is new AWA.Events.Definition (Name => "user-reset-password");

   NAME : constant String := "User_Service";

   Not_Found  : exception;

   User_Exist : exception;

   --  The session is an authenticate session.  The user authenticated using password or OpenID.
   --  When the user logout, this session is closed as well as any connection session linked to
   --  the authenticate session.
   AUTH_SESSION_TYPE    : constant Integer := 1;

   --  The session is a connection session.  It is linked to an authenticate session.
   --  This session can be closed automatically due to a timeout or user's inactivity.
   --  The AID cookie refers to this connection session to create a new connection session.
   --  Once re-connecting is done, the connection session refered to by AID is marked
   --  as <b<USED_SESSION_TYPE and a new AID cookie with the new connection session is
   --  returned to the user.
   CONNECT_SESSION_TYPE : constant Integer := 0;

   --  The session is a connection session whose associated AID cookie has been used.
   --  This session cannot be used to re-connect a user through the AID cookie.
   USED_SESSION_TYPE    : constant Integer := 2;

   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   function Get_Name_From_Email (Email : in String) return String;

   type User_Service is new AWA.Modules.Module_Manager with private;
   type User_Service_Access is access all User_Service'Class;

   --  Build the authenticate cookie.  The cookie is signed using HMAC-SHA1 with a private key.
   function Get_Authenticate_Cookie (Model : in User_Service;
                                     Id    : in ADO.Identifier)
                                     return String;

   --  Get the authenticate identifier from the cookie.
   --  Verify that the cookie is valid, the signature is correct.
   --  Returns the identified or NO_IDENTIFIER
   function Get_Authenticate_Id (Model  : in User_Service;
                                 Cookie : in String) return ADO.Identifier;

   --  Get the password hash.  The password is signed using HMAC-SHA1 with the salt.
   function Get_Password_Hash (Model    : in User_Service;
                               Password : in String;
                               Salt     : in String)
                               return String;

   --  Create a user in the database with the given user information and
   --  the associated email address.  Verify that no such user already exist.
   --  Raises User_Exist exception if a user with such email is already registered.
   procedure Create_User (Model : in out User_Service;
                          User  : in out User_Ref'Class;
                          Email : in out Email_Ref'Class);

   --  Verify the access key and retrieve the user associated with that key.
   --  Starts a new session associated with the given IP address.
   --  The authenticated user is identified by a principal instance allocated
   --  and returned in Principal.
   --  Raises Not_Found if the access key does not exist.
   procedure Verify_User (Model     : in User_Service;
                          Key       : in String;
                          IpAddr    : in String;
                          Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his email address and his password.
   --  If the user is authenticated, return the user information and
   --  create a new session.  The IP address of the connection is saved
   --  in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Email     : in String;
                           Password  : in String;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his OpenID identifier.  The authentication process
   --  was made by an external OpenID provider.  If the user does not yet exists in
   --  the database, a record is created for him.  Create a new session for the user.
   --  The IP address of the connection is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Auth      : in Security.Auth.Authentication;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with the authenticate cookie generated from a previous authenticate
   --  session.  If the cookie has the correct signature, matches a valid session,
   --  return the user information and create a new session.  The IP address of the connection
   --  is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Cookie    : in String;
                           Ip_Addr   : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Start the lost password process for a user.  Find the user having
   --  the given email address and send that user a password reset key
   --  in an email.
   --  Raises Not_Found exception if no user with such email exist
   procedure Lost_Password (Model : in out User_Service;
                            Email : in String);

   --  Reset the password of the user associated with the secure key.
   --  Raises Not_Found if there is no key or if the user does not have any email
   procedure Reset_Password (Model    : in out User_Service;
                             Key      : in String;
                             Password : in String;
                             IpAddr   : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   --  Verify that the user session identified by Id is valid and still active.
   --  Returns the user and the session objects.
   --  Raises Not_Found if the session does not exist or was closed.
   procedure Verify_Session (Model   : in User_Service;
                             Id      : in ADO.Identifier;
                             User    : out User_Ref'Class;
                             Session : out Session_Ref'Class);

   --  Closes the session identified by Id.  The session identified should refer to
   --  a valid and not closed connection session.
   --  When Logout is set, the authenticate session is also closed.  The connection
   --  sessions associated with the authenticate session are also closed.
   --  Raises Not_Found if the session is invalid or already closed.
   procedure Close_Session (Model  : in User_Service;
                            Id     : in ADO.Identifier;
                            Logout : in Boolean := False);

   --  Create and generate a new access key for the user.  The access key is saved in the
   --  database and it will expire after the expiration delay.
   procedure Create_Access_Key (Model   : in out User_Service;
                                User    : in AWA.Users.Models.User_Ref'Class;
                                Key     : in out AWA.Users.Models.Access_Key_Ref;
                                Expire  : in Duration;
                                Session : in out ADO.Sessions.Master_Session);

   procedure Send_Alert (Model : in User_Service;
                         Kind  : in AWA.Events.Event_Index;
                         User  : in User_Ref'Class;
                         Props : in out AWA.Events.Module_Event);

   --  Initialize the user service.
   overriding
   procedure Initialize (Model  : in out User_Service;
                         Module : in AWA.Modules.Module'Class);

private

   function Create_Key (Model  : in out User_Service;
                        Number : in ADO.Identifier) return String;

   procedure Create_Session (Model   : in User_Service;
                             DB      : in out ADO.Sessions.Master_Session;
                             Session : out Session_Ref'Class;
                             User    : in User_Ref'Class;
                             Ip_Addr : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   type User_Service is new AWA.Modules.Module_Manager with record
      Server_Id : Integer := 0;
      Random    : Security.Random.Generator;
      Auth_Key  : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end AWA.Users.Services;

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

with AWA.Users.Models;
with AWA.Users.Principals;
with AWA.Modules;
with AWA.Events;
with Security.Auth;
with Security.Random;

with ADO;
with ADO.Sessions;

--  == Introduction ==
--  The *users* module provides a *users* service which controls the user data model.
--
--  == Events ==
--  The *users* module exposes a number of events which are posted when some action
--  are performed at the service level.
--
--  === user-register ===
--  This event is posted when a new user is registered in the application.
--  It can be used to send a registration email.
--
--  === user-create ===
--  This event is posted when a new user is created.  It can be used to trigger
--  the pre-initialization of the application for the new user.
--
--  === user-lost-password ===
--  This event is posted when a user asks for a password reset through an
--  anonymous form.  It is intended to be used to send the reset password email.
--
--  === user-reset-password ===
--  This event is posted when a user has successfully reset his password.
--  It can be used to send an email.
--
package AWA.Users.Services is

   use AWA.Users.Models;

   package User_Create_Event is new AWA.Events.Definition (Name => "user-create");
   package User_Register_Event is new AWA.Events.Definition (Name => "user-register");
   package User_Lost_Password_Event is new AWA.Events.Definition (Name => "user-lost-password");
   package User_Reset_Password_Event is new AWA.Events.Definition (Name => "user-reset-password");

   NAME : constant String := "User_Service";

   Not_Found  : exception;

   User_Exist : exception;

   --  The session is an authenticate session.  The user authenticated using password or OpenID.
   --  When the user logout, this session is closed as well as any connection session linked to
   --  the authenticate session.
   AUTH_SESSION_TYPE    : constant Integer := 1;

   --  The session is a connection session.  It is linked to an authenticate session.
   --  This session can be closed automatically due to a timeout or user's inactivity.
   --  The AID cookie refers to this connection session to create a new connection session.
   --  Once re-connecting is done, the connection session refered to by AID is marked
   --  as <b<USED_SESSION_TYPE and a new AID cookie with the new connection session is
   --  returned to the user.
   CONNECT_SESSION_TYPE : constant Integer := 0;

   --  The session is a connection session whose associated AID cookie has been used.
   --  This session cannot be used to re-connect a user through the AID cookie.
   USED_SESSION_TYPE    : constant Integer := 2;

   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   function Get_Name_From_Email (Email : in String) return String;

   type User_Service is new AWA.Modules.Module_Manager with private;
   type User_Service_Access is access all User_Service'Class;

   --  Build the authenticate cookie.  The cookie is signed using HMAC-SHA1 with a private key.
   function Get_Authenticate_Cookie (Model : in User_Service;
                                     Id    : in ADO.Identifier)
                                     return String;

   --  Get the authenticate identifier from the cookie.
   --  Verify that the cookie is valid, the signature is correct.
   --  Returns the identified or NO_IDENTIFIER
   function Get_Authenticate_Id (Model  : in User_Service;
                                 Cookie : in String) return ADO.Identifier;

   --  Get the password hash.  The password is signed using HMAC-SHA1 with the salt.
   function Get_Password_Hash (Model    : in User_Service;
                               Password : in String;
                               Salt     : in String)
                               return String;

   --  Create a user in the database with the given user information and
   --  the associated email address.  Verify that no such user already exist.
   --  Raises User_Exist exception if a user with such email is already registered.
   procedure Create_User (Model : in out User_Service;
                          User  : in out User_Ref'Class;
                          Email : in out Email_Ref'Class);

   --  Verify the access key and retrieve the user associated with that key.
   --  Starts a new session associated with the given IP address.
   --  The authenticated user is identified by a principal instance allocated
   --  and returned in Principal.
   --  Raises Not_Found if the access key does not exist.
   procedure Verify_User (Model     : in User_Service;
                          Key       : in String;
                          IpAddr    : in String;
                          Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his email address and his password.
   --  If the user is authenticated, return the user information and
   --  create a new session.  The IP address of the connection is saved
   --  in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Email     : in String;
                           Password  : in String;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his OpenID identifier.  The authentication process
   --  was made by an external OpenID provider.  If the user does not yet exists in
   --  the database, a record is created for him.  Create a new session for the user.
   --  The IP address of the connection is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Auth      : in Security.Auth.Authentication;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with the authenticate cookie generated from a previous authenticate
   --  session.  If the cookie has the correct signature, matches a valid session,
   --  return the user information and create a new session.  The IP address of the connection
   --  is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Cookie    : in String;
                           Ip_Addr   : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Start the lost password process for a user.  Find the user having
   --  the given email address and send that user a password reset key
   --  in an email.
   --  Raises Not_Found exception if no user with such email exist
   procedure Lost_Password (Model : in out User_Service;
                            Email : in String);

   --  Reset the password of the user associated with the secure key.
   --  Raises Not_Found if there is no key or if the user does not have any email
   procedure Reset_Password (Model    : in out User_Service;
                             Key      : in String;
                             Password : in String;
                             IpAddr   : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   --  Verify that the user session identified by Id is valid and still active.
   --  Returns the user and the session objects.
   --  Raises Not_Found if the session does not exist or was closed.
   procedure Verify_Session (Model   : in User_Service;
                             Id      : in ADO.Identifier;
                             User    : out User_Ref'Class;
                             Session : out Session_Ref'Class);

   --  Closes the session identified by Id.  The session identified should refer to
   --  a valid and not closed connection session.
   --  When Logout is set, the authenticate session is also closed.  The connection
   --  sessions associated with the authenticate session are also closed.
   --  Raises Not_Found if the session is invalid or already closed.
   procedure Close_Session (Model  : in User_Service;
                            Id     : in ADO.Identifier;
                            Logout : in Boolean := False);

   --  Create and generate a new access key for the user.  The access key is saved in the
   --  database and it will expire after the expiration delay.
   procedure Create_Access_Key (Model   : in out User_Service;
                                User    : in AWA.Users.Models.User_Ref'Class;
                                Key     : in out AWA.Users.Models.Access_Key_Ref;
                                Kind    : in AWA.Users.Models.Key_Type;
                                Expire  : in Duration;
                                Session : in out ADO.Sessions.Master_Session);

   procedure Send_Alert (Model : in User_Service;
                         Kind  : in AWA.Events.Event_Index;
                         User  : in User_Ref'Class;
                         Props : in out AWA.Events.Module_Event);

   --  Initialize the user service.
   overriding
   procedure Initialize (Model  : in out User_Service;
                         Module : in AWA.Modules.Module'Class);

private

   function Create_Key (Model  : in out User_Service;
                        Number : in ADO.Identifier) return String;

   procedure Create_Session (Model   : in User_Service;
                             DB      : in out ADO.Sessions.Master_Session;
                             Session : out Session_Ref'Class;
                             User    : in User_Ref'Class;
                             Ip_Addr : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   type User_Service is new AWA.Modules.Module_Manager with record
      Server_Id : Integer := 0;
      Random    : Security.Random.Generator;
      Auth_Key  : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end AWA.Users.Services;

Add the Kind : in AWA.Users.Models.Key_Type; parameter to the Create_Access_Key operation


-- Userdata_Example
-- A example of using the Ada values in Lua via UserData values

-- Copyright (c) 2015, James Humphry - see LICENSE for terms

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Long_Float_Text_IO; use Ada.Long_Float_Text_IO;

with Lua; use Lua;
with Lua.Util; use Lua.Util;

with Example_Userdata;
use Example_Userdata;

procedure Userdata_Example is
   L : Lua_State;
   Result : Boolean;
   Counter : Integer;
   Discard :Thread_Status;

   Example_Object : aliased Parent := (Flag => True);
   Child_Object : aliased Child := (Counter => 3, Flag => False);

begin

   Put_Line("Using Ada values as userdata in Lua");

   Put("Lua version: ");
   Put(Item => L.Version, Aft => 0, Exp => 0);
   New_Line;New_Line;

   Put_Line("There are three Ada types, Grandparent(abstract)->Parent->Child");
   Put_Line("Grandparent and descendants have a flag that can be toggled");
   Put_Line("Child has a counter that can be incremented");
   Put_Line("There are only two userdata types in Lua, Grandparent and Child.");
   New_Line;

   -- Register the "toggle" and "increment" operations in the metatables.
   Register_Operations(L);

   Put_Line("Pushing an 'Parent' value (Flag => True) to the stack as an Grandparent'Class userdata.");
   Grandparent_Userdata.Push_Class(L, Example_Object'Unchecked_Access);
   Put_Line("Saving a copy of the userdata in global variable 'foo'");
   L.PushValue(-1);
   L.SetGlobal("foo");
   Print_Stack(L);
   Put_Line("Retrieving the value of 'Flag' from the value at the top of the stack.");
   Result := Grandparent_Userdata.ToUserdata(L, -1).Flag;
   Put_Line((if Result then "Foo.Flag is now true"
            else "Foo.Flag is now false"));
   New_Line;

   Put_Line("Pushing an 'Child' value (Counter => 3, Flag => False) to the stack as an Child userdata.");
   Child_Userdata.Push(L, Child_Object'Unchecked_Access);
   Print_Stack(L);
   Put_Line("Saving the userdata at the top of the stack in global variable 'bar'");
   L.SetGlobal("bar");
   New_Line;

   Put_Line("Clearing the stack");
   L.SetTop(0);
   New_Line;

   Put_Line("Calling 'foo:toggle()' in Lua");
   Discard := L.LoadString_By_Copy("foo:toggle()");
   L.Call(nargs => 0, nresults => 0);
   New_Line;
   Put_Line("Calling 'bar:toggle()' in Lua");
   Discard := L.LoadString_By_Copy("bar:toggle()");
   L.Call(nargs => 0, nresults => 0);
   New_Line;
   Put_Line("Calling 'bar:increment()' in Lua");
   Discard := L.LoadString_By_Copy("bar:increment()");
   L.Call(nargs => 0, nresults => 0);
   New_Line;

   New_Line;

   Put_Line("Retrieving the value of 'Flag' from foo and bar, treating them as Grandparent values.");
   L.GetGlobal("foo");
   Result := Grandparent_Userdata.ToUserdata(L, -1).Flag;
   Put_Line((if Result then "foo.Flag is now true"
            else "foo.Flag is now false"));
   L.SetTop(0);
   L.GetGlobal("bar");
   Result := Grandparent_Userdata.ToUserdata(L, -1).Flag;
   Put_Line((if Result then "bar.Flag is now true"
            else "bar.Flag is now false"));

   Put_Line("Retrieving the value of 'Counter' from bar, treating it as an Child value.");
   Counter := Child_Userdata.ToUserdata(L, -1).Counter;
   Put_Line("bar.Counter = " & Integer'Image(Counter));
   New_Line;

end Userdata_Example;

-- Userdata_Example
-- A example of using the Ada values in Lua via UserData values

-- Copyright (c) 2015, James Humphry - see LICENSE for terms

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Long_Float_Text_IO; use Ada.Long_Float_Text_IO;

with Lua; use Lua;
with Lua.Util; use Lua.Util;

with Example_Userdata;
use Example_Userdata;

procedure Userdata_Example is
   L : Lua_State;
   Result : Boolean;
   Counter : Integer;
   Discard :Thread_Status;

   Parent_Object : aliased Parent := (Flag => True);
   Child_Object : aliased Child := (Counter => 3, Flag => False);

begin

   Put_Line("Using Ada values as userdata in Lua");

   Put("Lua version: ");
   Put(Item => L.Version, Aft => 0, Exp => 0);
   New_Line;New_Line;

   Put_Line("There are three Ada types, Grandparent(abstract)->Parent->Child");
   Put_Line("Grandparent and descendants have a flag that can be toggled");
   Put_Line("Child has a counter that can be incremented");
   Put_Line("There are only two userdata types in Lua, Grandparent and Child.");
   New_Line;

   -- Register the "toggle" and "increment" operations in the metatables.
   Register_Operations(L);

   Put_Line("Pushing an 'Parent' value (Flag => True) to the stack as a Grandparent'Class userdata.");
   Grandparent_Userdata.Push_Class(L, Parent_Object'Unchecked_Access);
   Put_Line("Saving a copy of the userdata in global variable 'parent_foo'");
   L.PushValue(-1);
   L.SetGlobal("parent_foo");
   Print_Stack(L);
   Put_Line("Retrieving the value of 'Flag' from the value at the top of the stack.");
   Result := Grandparent_Userdata.ToUserdata(L, -1).Flag;
   Put_Line((if Result then "parent_foo.Flag is now true"
            else "parent_foo.Flag is now false"));
   New_Line;

   Put_Line("Pushing an 'Child' value (Counter => 3, Flag => False) to the stack as a Child userdata.");
   Child_Userdata.Push(L, Child_Object'Unchecked_Access);
   Print_Stack(L);
   Put_Line("Saving the userdata at the top of the stack in global variable 'child_bar'");
   L.SetGlobal("child_bar");
   New_Line;

   Put_Line("Clearing the stack");
   L.SetTop(0);
   New_Line;

   Put_Line("Calling 'parent_foo:toggle()' in Lua");
   Discard := L.LoadString_By_Copy("parent_foo:toggle()");
   L.Call(nargs => 0, nresults => 0);
   New_Line;
   Put_Line("Calling 'child_bar:toggle()' in Lua");
   Discard := L.LoadString_By_Copy("child_bar:toggle()");
   L.Call(nargs => 0, nresults => 0);
   New_Line;
   Put_Line("Calling 'child_bar:increment()' in Lua");
   Discard := L.LoadString_By_Copy("child_bar:increment()");
   L.Call(nargs => 0, nresults => 0);
   New_Line;

   New_Line;

   Put_Line("Retrieving the value of 'Flag' from parent_foo and child_bar, " &
              "treating them as Grandparent values.");
   L.GetGlobal("parent_foo");
   Result := Grandparent_Userdata.ToUserdata(L, -1).Flag;
   Put_Line((if Result then "parent_foo.Flag is now true"
            else "parent_foo.Flag is now false"));
   L.SetTop(0);
   L.GetGlobal("child_bar");
   Result := Grandparent_Userdata.ToUserdata(L, -1).Flag;
   Put_Line((if Result then "child_bar.Flag is now true"
            else "child_bar.Flag is now false"));

   Put_Line("Retrieving the value of 'Counter' from child_bar, " &
              "treating it as a Child value.");
   Counter := Child_Userdata.ToUserdata(L, -1).Counter;
   Put_Line("child_bar.Counter = " & Integer'Image(Counter));
   New_Line;

end Userdata_Example;

Clarify parts of userdata_example.adb

Clarify parts of userdata_example.adb

Hopefully it is a little clearer now.


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

with Util.Log.Loggers;

with ADO.Sessions;
with ADO.Sessions.Entities;
with Security.Permissions;

with AWA.Users.Models;
with AWA.Permissions;
with AWA.Modules.Beans;
with AWA.Services.Contexts;
with AWA.Comments.Beans;

package body AWA.Comments.Modules is

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

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

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

      --  Setup the resource bundles.
      App.Register ("commentMsg", "comments");

      --  Register the comment list bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_List_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_List_Bean'Access);

      --  Register the comment bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_Bean'Access);

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

   --  ------------------------------
   --  Load the comment identified by the given identifier.
   --  ------------------------------
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Comment.Load (DB, Id, Found);
   end Load_Comment;

   --  ------------------------------
   --  Create a new comment for the associated database entity.
   --  ------------------------------
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Log.Info ("Creating new comment for {0}", ADO.Identifier'Image (Comment.Get_Entity_Id));

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment.Get_Entity_Id);

      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type));
      Comment.Set_Author (User);
      Comment.Set_Create_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
   end Create_Comment;

   --  ------------------------------
   --  Update the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Update_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      if not Comment.Is_Inserted then
         Log.Error ("The comment was not created");
         raise Not_Found with "The comment was not inserted";
      end if;
      Ctx.Start;
      Log.Info ("Updating the comment {0}", ADO.Identifier'Image (Comment.Get_Id));

      --  Check that the user has the update permission on the given comment.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);
      Comment.Save (DB);
      Ctx.Commit;
   end Update_Comment;

   --  ------------------------------
   --  Delete the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Delete_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);

      Comment.Delete (DB);
      Ctx.Commit;
   end Delete_Comment;

end AWA.Comments.Modules;

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

with Util.Log.Loggers;

with ADO.Sessions;
with ADO.Sessions.Entities;
with Security.Permissions;

with AWA.Users.Models;
with AWA.Permissions;
with AWA.Modules.Beans;
with AWA.Services.Contexts;
with AWA.Comments.Beans;

package body AWA.Comments.Modules is

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

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

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

      --  Setup the resource bundles.
      App.Register ("commentMsg", "comments");

      --  Register the comment list bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_List_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_List_Bean'Access);

      --  Register the comment bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_Bean'Access);

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

   --  ------------------------------
   --  Load the comment identified by the given identifier.
   --  ------------------------------
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Comment.Load (DB, Id, Found);
   end Load_Comment;

   --  ------------------------------
   --  Create a new comment for the associated database entity.
   --  ------------------------------
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Log.Info ("Creating new comment for {0}", ADO.Identifier'Image (Comment.Get_Entity_Id));

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment.Get_Entity_Id);

      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type));
      Comment.Set_Author (User);
      Comment.Set_Create_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
   end Create_Comment;

   --  ------------------------------
   --  Update the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Update_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      if not Comment.Is_Inserted then
         Log.Error ("The comment was not created");
         raise Not_Found with "The comment was not inserted";
      end if;
      Ctx.Start;
      Log.Info ("Updating the comment {0}", ADO.Identifier'Image (Comment.Get_Id));

      --  Check that the user has the update permission on the given comment.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);
      Comment.Save (DB);
      Ctx.Commit;
   end Update_Comment;

   --  ------------------------------
   --  Delete the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Delete_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);

      Comment.Delete (DB);
      Ctx.Commit;
   end Delete_Comment;

   --  ------------------------------
   --  Set the publication status of the comment represented by <tt>Comment</tt>
   --  if the current user has the permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Publish_Comment (Model       : in Comment_Module;
                              Permission  : in String;
                              Id          : in ADO.Identifier;
                              Status      : in AWA.Comments.Models.Status_Type;
                              Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the permission to publish for the given comment.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Id);

      Comment.Load (DB, Id);
      Comment.Set_Status (Status);
      Comment.Save (DB);
      Ctx.Commit;
   end Publish_Comment;

end AWA.Comments.Modules;

Implement the Publish_Comment operation, check the permission, load the comment, change the status and return the comment instance