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

with ASF.Sessions;
with ASF.Events.Actions;
with ASF.Contexts.Faces;

with AWA.Users.Principals;
package body AWA.Users.Beans is

   use AWA.Users.Models;

   --  ------------------------------
   --  Action to register a user
   --  ------------------------------
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");
   end Register_User;

   --  ------------------------------
   --  Action to verify the user after the registration
   --  ------------------------------
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                User    => User,
                                IpAddr  => "",
                                Session => Session);

      Outcome := To_Unbounded_String ("success");
   end Verify_User;

   --  ------------------------------
   --  Action to trigger the lost password email process.
   --  ------------------------------
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");
   end Lost_Password;

   --  ------------------------------
   --  Action to validate the reset password key and set a new password.
   --  ------------------------------
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Reset_Password (Key      => To_String (Data.Access_Key),
                                   Password => To_String (Data.Password),
                                   IpAddr   => "",
                                   User     => User,
                                   Session  => Session);
      Outcome := To_Unbounded_String ("success");
   end Reset_Password;

   procedure Set_Session_Principal (Data : in Authenticate_Bean;
                                    User : in AWA.Users.Models.User_Ref;
									Sess : in AWA.Users.Models.Session_Ref) is
      Principal : constant Principals.Principal_Access := Principals.Create (User, Sess);
      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
      Name      : constant String := "User: " & User.Get_Name;
   begin
      Session.Set_Principal (Principal.all'Access);
   end Set_Session_Principal;

   --  ------------------------------
   --  Action to authenticate a user (password authentication).
   --  ------------------------------
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      User      : User_Ref;
      Session   : Session_Ref;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 User     => User,
                                 Session  => Session);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (User, Session);
   end Authenticate_User;

   --  ------------------------------
   --  Create an authenticate bean.
   --  ------------------------------
   function Create_Authenticate_Bean (Module : in AWA.Users.Module.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Module.Get_User_Manager;
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Authenticate_User,
                                                Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Register_User,
                                                Name   => "register");

   package Verify_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Verify_User,
                                                Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Lost_Password,
                                                Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Reset_Password,
                                                Name   => "resetPassword");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Access,
         Register_Binding.Proxy'Access,
         Verify_Binding.Proxy'Access,
         Lost_Password_Binding.Proxy'Access,
         Reset_Password_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "email" then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = "password" then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = "key" then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      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 Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "email" then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "password" then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "key" then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (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 Authenticate_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

end AWA.Users.Beans;

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

with ASF.Sessions;
with ASF.Events.Actions;
with ASF.Contexts.Faces;

with AWA.Users.Principals;
package body AWA.Users.Beans is

   use AWA.Users.Models;

   --  ------------------------------
   --  Action to register a user
   --  ------------------------------
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");
   end Register_User;

   --  ------------------------------
   --  Action to verify the user after the registration
   --  ------------------------------
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                User    => User,
                                IpAddr  => "",
                                Session => Session);

      Data.Set_Session_Principal (User, Session);
      Outcome := To_Unbounded_String ("success");
   end Verify_User;

   --  ------------------------------
   --  Action to trigger the lost password email process.
   --  ------------------------------
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");
   end Lost_Password;

   --  ------------------------------
   --  Action to validate the reset password key and set a new password.
   --  ------------------------------
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Reset_Password (Key      => To_String (Data.Access_Key),
                                   Password => To_String (Data.Password),
                                   IpAddr   => "",
                                   User     => User,
                                   Session  => Session);
      Outcome := To_Unbounded_String ("success");
   end Reset_Password;

   procedure Set_Session_Principal (Data : in Authenticate_Bean;
                                    User : in AWA.Users.Models.User_Ref;
									Sess : in AWA.Users.Models.Session_Ref) is
      Principal : constant Principals.Principal_Access := Principals.Create (User, Sess);
      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
      Name      : constant String := "User: " & User.Get_Name;
   begin
      Session.Set_Principal (Principal.all'Access);
   end Set_Session_Principal;

   --  ------------------------------
   --  Action to authenticate a user (password authentication).
   --  ------------------------------
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      User      : User_Ref;
      Session   : Session_Ref;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 User     => User,
                                 Session  => Session);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (User, Session);
   end Authenticate_User;

   --  ------------------------------
   --  Create an authenticate bean.
   --  ------------------------------
   function Create_Authenticate_Bean (Module : in AWA.Users.Module.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Module.Get_User_Manager;
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Authenticate_User,
                                                Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Register_User,
                                                Name   => "register");

   package Verify_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Verify_User,
                                                Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Lost_Password,
                                                Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Reset_Password,
                                                Name   => "resetPassword");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Access,
         Register_Binding.Proxy'Access,
         Verify_Binding.Proxy'Access,
         Lost_Password_Binding.Proxy'Access,
         Reset_Password_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "email" then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = "password" then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = "key" then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      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 Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "email" then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "password" then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "key" then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (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 Authenticate_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

end AWA.Users.Beans;

Set the user principal after the verification key is valid


-----------------------------------------------------------------------
--  gen-artifacts-docs -- Artifact for documentation
--  Copyright (C) 2012, 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.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;

with Gen.Model.Packages;

--  with Asis;
--  with Asis.Text;
--  with Asis.Elements;
--  with Asis.Exceptions;
--  with Asis.Errors;
--  with Asis.Implementation;
--  with Asis.Elements;
--  with Asis.Declarations;
--  The Gen.Artifacts.Docs package is an artifact for the generation of
--  application documentation.  Its purpose is to scan the project source files
--  and extract some interesting information for a developer's guide.  The artifact
--  scans the Ada source files, the XML configuration files, the XHTML files.
--
--  The generated documentation is intended to be published on a web site.
--  The Google Wiki style is generated by default.
--
--  1/ In the first step, the project files are scanned and the useful
--     documentation is extracted.
--
--  2/ In the second step, the documentation is merged and reconciled.  Links to
--     documentation pages and references are setup and the final pages are generated.
--
--  Ada
--  ---
--  The documentation starts at the first '== TITLE ==' marker and finishes before the
--  package specification.
--
--  XHTML
--  -----
--  Same as Ada.
--
--  XML Files
--  ----------
--  The documentation is part of the XML and the documentation or description
--  tags are extracted.
package Gen.Artifacts.Docs is

   --  Tag marker (same as Java).
   TAG_CHAR     : constant Character := '@';

   --  Specific tags recognized when analyzing the documentation.
   TAG_AUTHOR   : constant String := "author";
   TAG_TITLE    : constant String := "title";
   TAG_INCLUDE  : constant String := "include";
   TAG_SEE      : constant String := "see";

   type Doc_Format is (DOC_MARKDOWN, DOC_WIKI_GOOGLE);

   --  ------------------------------
   --  Documentation artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Set the output document format to generate.
   procedure Set_Format (Handler : in out Artifact;
                         Format  : in Doc_Format);

private

   type Line_Kind is (L_TEXT, L_LIST, L_LIST_ITEM, L_SEE, L_INCLUDE);

   type Line_Type (Len : Natural) is record
      Kind    : Line_Kind := L_TEXT;
      Content : String (1 .. Len);
   end record;

   package Line_Vectors is
      new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                             Element_Type => Line_Type);

   type Doc_State is (IN_PARA, IN_SEPARATOR, IN_CODE, IN_CODE_SEPARATOR, IN_LIST);

   type Document_Formatter is abstract tagged null record;
   type Document_Formatter_Access is access all Document_Formatter'Class;

   type File_Document is record
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Title        : Ada.Strings.Unbounded.Unbounded_String;
      State        : Doc_State := IN_PARA;
      Line_Number  : Natural := 0;
      Lines        : Line_Vectors.Vector;
      Was_Included : Boolean := False;
      Formatter    : Document_Formatter_Access;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is abstract;

   package Doc_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => File_Document,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Include the document extract represented by Name into the document Into.
   --  The included document is marked so that it will not be generated.
   procedure Include (Docs     : in out Doc_Maps.Map;
                      Into     : in out File_Document;
                      Name     : in String;
                      Position : in Natural);

   --  Generate the project documentation that was collected in Docs.
   --  The documentation is merged so that the @include tags are replaced by the matching
   --  document extracts.
   procedure Generate (Docs : in out Doc_Maps.Map;
                       Dir  : in String);

   --  Returns True if the line indicates a bullet or numbered list.
   function Is_List (Line : in String) return Boolean;

   --  Returns True if the line indicates a code sample.
   function Is_Code (Line : in String) return Boolean;

   --  Append a raw text line to the document.
   procedure Append_Line (Doc  : in out File_Document;
                          Line : in String);

   --  Look and analyze the tag defined on the line.
   procedure Append_Tag (Doc : in out File_Document;
                         Tag : in String);

   --  Analyse the documentation line and collect the documentation text.
   procedure Append (Doc   : in out File_Document;
                     Line  : in String);

   --  After having collected the documentation, terminate the document by making sure
   --  the opened elements are closed.
   procedure Finish (Doc : in out File_Document);

   --  Set the name associated with the document extract.
   procedure Set_Name (Doc  : in out File_Document;
                       Name : in String);

   --  Set the title associated with the document extract.
   procedure Set_Title (Doc   : in out File_Document;
                        Title : in String);

   --  Scan the files in the directory refered to by Path and collect the documentation
   --  in the Docs hashed map.
   procedure Scan_Files (Handler : in out Artifact;
                         Path    : in String;
                         Docs    : in out Doc_Maps.Map);

   --  Read the Ada specification file and collect the useful documentation.
   --  To keep the implementation simple, we don't use the ASIS packages to scan and extract
   --  the documentation.  We don't need to look at the Ada specification itself.  Instead,
   --  we assume that the Ada source follows some Ada style guidelines.
   procedure Read_Ada_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   procedure Read_Xml_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   type Artifact is new Gen.Artifacts.Artifact with record
      Xslt_Command : Ada.Strings.Unbounded.Unbounded_String;
      Format       : Doc_Format := DOC_WIKI_GOOGLE;
   end record;

end Gen.Artifacts.Docs;

-----------------------------------------------------------------------
--  gen-artifacts-docs -- Artifact for documentation
--  Copyright (C) 2012, 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.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with Gen.Model.Packages;

--  with Asis;
--  with Asis.Text;
--  with Asis.Elements;
--  with Asis.Exceptions;
--  with Asis.Errors;
--  with Asis.Implementation;
--  with Asis.Elements;
--  with Asis.Declarations;
--  The Gen.Artifacts.Docs package is an artifact for the generation of
--  application documentation.  Its purpose is to scan the project source files
--  and extract some interesting information for a developer's guide.  The artifact
--  scans the Ada source files, the XML configuration files, the XHTML files.
--
--  The generated documentation is intended to be published on a web site.
--  The Google Wiki style is generated by default.
--
--  1/ In the first step, the project files are scanned and the useful
--     documentation is extracted.
--
--  2/ In the second step, the documentation is merged and reconciled.  Links to
--     documentation pages and references are setup and the final pages are generated.
--
--  Ada
--  ---
--  The documentation starts at the first '== TITLE ==' marker and finishes before the
--  package specification.
--
--  XHTML
--  -----
--  Same as Ada.
--
--  XML Files
--  ----------
--  The documentation is part of the XML and the documentation or description
--  tags are extracted.
package Gen.Artifacts.Docs is

   --  Tag marker (same as Java).
   TAG_CHAR     : constant Character := '@';

   --  Specific tags recognized when analyzing the documentation.
   TAG_AUTHOR   : constant String := "author";
   TAG_TITLE    : constant String := "title";
   TAG_INCLUDE  : constant String := "include";
   TAG_SEE      : constant String := "see";

   type Doc_Format is (DOC_MARKDOWN, DOC_WIKI_GOOGLE);

   --  ------------------------------
   --  Documentation artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Set the output document format to generate.
   procedure Set_Format (Handler : in out Artifact;
                         Format  : in Doc_Format);

private

   type Line_Kind is (L_TEXT, L_LIST, L_LIST_ITEM, L_SEE, L_INCLUDE);

   type Line_Type (Len : Natural) is record
      Kind    : Line_Kind := L_TEXT;
      Content : String (1 .. Len);
   end record;

   package Line_Vectors is
      new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                             Element_Type => Line_Type);

   type Doc_State is (IN_PARA, IN_SEPARATOR, IN_CODE, IN_CODE_SEPARATOR, IN_LIST);

   type Document_Formatter is abstract tagged null record;
   type Document_Formatter_Access is access all Document_Formatter'Class;

   type File_Document is record
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Title        : Ada.Strings.Unbounded.Unbounded_String;
      State        : Doc_State := IN_PARA;
      Line_Number  : Natural := 0;
      Lines        : Line_Vectors.Vector;
      Was_Included : Boolean := False;
      Formatter    : Document_Formatter_Access;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is abstract;

   --  Write a line in the target document formatting the line if necessary.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is abstract;

   package Doc_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => File_Document,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Include the document extract represented by Name into the document Into.
   --  The included document is marked so that it will not be generated.
   procedure Include (Docs     : in out Doc_Maps.Map;
                      Into     : in out File_Document;
                      Name     : in String;
                      Position : in Natural);

   --  Generate the project documentation that was collected in Docs.
   --  The documentation is merged so that the @include tags are replaced by the matching
   --  document extracts.
   procedure Generate (Docs : in out Doc_Maps.Map;
                       Dir  : in String);

   --  Returns True if the line indicates a bullet or numbered list.
   function Is_List (Line : in String) return Boolean;

   --  Returns True if the line indicates a code sample.
   function Is_Code (Line : in String) return Boolean;

   --  Append a raw text line to the document.
   procedure Append_Line (Doc  : in out File_Document;
                          Line : in String);

   --  Look and analyze the tag defined on the line.
   procedure Append_Tag (Doc : in out File_Document;
                         Tag : in String);

   --  Analyse the documentation line and collect the documentation text.
   procedure Append (Doc   : in out File_Document;
                     Line  : in String);

   --  After having collected the documentation, terminate the document by making sure
   --  the opened elements are closed.
   procedure Finish (Doc : in out File_Document);

   --  Set the name associated with the document extract.
   procedure Set_Name (Doc  : in out File_Document;
                       Name : in String);

   --  Set the title associated with the document extract.
   procedure Set_Title (Doc   : in out File_Document;
                        Title : in String);

   --  Scan the files in the directory refered to by Path and collect the documentation
   --  in the Docs hashed map.
   procedure Scan_Files (Handler : in out Artifact;
                         Path    : in String;
                         Docs    : in out Doc_Maps.Map);

   --  Read the Ada specification file and collect the useful documentation.
   --  To keep the implementation simple, we don't use the ASIS packages to scan and extract
   --  the documentation.  We don't need to look at the Ada specification itself.  Instead,
   --  we assume that the Ada source follows some Ada style guidelines.
   procedure Read_Ada_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   procedure Read_Xml_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   type Artifact is new Gen.Artifacts.Artifact with record
      Xslt_Command : Ada.Strings.Unbounded.Unbounded_String;
      Format       : Doc_Format := DOC_WIKI_GOOGLE;
   end record;

end Gen.Artifacts.Docs;

Declare the Write_Line procedure on the Document_Formatter


-----------------------------------------------------------------------
--  gen-artifacts-docs -- Artifact for documentation
--  Copyright (C) 2012, 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.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with Gen.Model.Packages;

--  with Asis;
--  with Asis.Text;
--  with Asis.Elements;
--  with Asis.Exceptions;
--  with Asis.Errors;
--  with Asis.Implementation;
--  with Asis.Elements;
--  with Asis.Declarations;
--  The Gen.Artifacts.Docs package is an artifact for the generation of
--  application documentation.  Its purpose is to scan the project source files
--  and extract some interesting information for a developer's guide.  The artifact
--  scans the Ada source files, the XML configuration files, the XHTML files.
--
--  The generated documentation is intended to be published on a web site.
--  The Google Wiki style is generated by default.
--
--  1/ In the first step, the project files are scanned and the useful
--     documentation is extracted.
--
--  2/ In the second step, the documentation is merged and reconciled.  Links to
--     documentation pages and references are setup and the final pages are generated.
--
--  Ada
--  ---
--  The documentation starts at the first '== TITLE ==' marker and finishes before the
--  package specification.
--
--  XHTML
--  -----
--  Same as Ada.
--
--  XML Files
--  ----------
--  The documentation is part of the XML and the documentation or description
--  tags are extracted.
package Gen.Artifacts.Docs is

   --  Tag marker (same as Java).
   TAG_CHAR     : constant Character := '@';

   --  Specific tags recognized when analyzing the documentation.
   TAG_AUTHOR   : constant String := "author";
   TAG_TITLE    : constant String := "title";
   TAG_INCLUDE  : constant String := "include";
   TAG_SEE      : constant String := "see";

   type Doc_Format is (DOC_MARKDOWN, DOC_WIKI_GOOGLE);

   --  ------------------------------
   --  Documentation artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Set the output document format to generate.
   procedure Set_Format (Handler : in out Artifact;
                         Format  : in Doc_Format);

private

   type Line_Kind is (L_TEXT, L_LIST, L_LIST_ITEM, L_SEE, L_INCLUDE);

   type Line_Type (Len : Natural) is record
      Kind    : Line_Kind := L_TEXT;
      Content : String (1 .. Len);
   end record;

   package Line_Vectors is
      new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                             Element_Type => Line_Type);

   type Doc_State is (IN_PARA, IN_SEPARATOR, IN_CODE, IN_CODE_SEPARATOR, IN_LIST);

   type Document_Formatter is abstract tagged null record;
   type Document_Formatter_Access is access all Document_Formatter'Class;

   type File_Document is record
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Title        : Ada.Strings.Unbounded.Unbounded_String;
      State        : Doc_State := IN_PARA;
      Line_Number  : Natural := 0;
      Lines        : Line_Vectors.Vector;
      Was_Included : Boolean := False;
      Formatter    : Document_Formatter_Access;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is abstract;

   --  Write a line in the target document formatting the line if necessary.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is abstract;

   package Doc_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => File_Document,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Include the document extract represented by Name into the document Into.
   --  The included document is marked so that it will not be generated.
   procedure Include (Docs     : in out Doc_Maps.Map;
                      Into     : in out File_Document;
                      Name     : in String;
                      Position : in Natural);

   --  Generate the project documentation that was collected in Docs.
   --  The documentation is merged so that the @include tags are replaced by the matching
   --  document extracts.
   procedure Generate (Docs : in out Doc_Maps.Map;
                       Dir  : in String);

   --  Returns True if the line indicates a bullet or numbered list.
   function Is_List (Line : in String) return Boolean;

   --  Returns True if the line indicates a code sample.
   function Is_Code (Line : in String) return Boolean;

   --  Append a raw text line to the document.
   procedure Append_Line (Doc  : in out File_Document;
                          Line : in String);

   --  Look and analyze the tag defined on the line.
   procedure Append_Tag (Doc : in out File_Document;
                         Tag : in String);

   --  Analyse the documentation line and collect the documentation text.
   procedure Append (Doc   : in out File_Document;
                     Line  : in String);

   --  After having collected the documentation, terminate the document by making sure
   --  the opened elements are closed.
   procedure Finish (Doc : in out File_Document);

   --  Set the name associated with the document extract.
   procedure Set_Name (Doc  : in out File_Document;
                       Name : in String);

   --  Set the title associated with the document extract.
   procedure Set_Title (Doc   : in out File_Document;
                        Title : in String);

   --  Scan the files in the directory refered to by Path and collect the documentation
   --  in the Docs hashed map.
   procedure Scan_Files (Handler : in out Artifact;
                         Path    : in String;
                         Docs    : in out Doc_Maps.Map);

   --  Read the Ada specification file and collect the useful documentation.
   --  To keep the implementation simple, we don't use the ASIS packages to scan and extract
   --  the documentation.  We don't need to look at the Ada specification itself.  Instead,
   --  we assume that the Ada source follows some Ada style guidelines.
   procedure Read_Ada_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   procedure Read_Xml_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   type Artifact is new Gen.Artifacts.Artifact with record
      Xslt_Command : Ada.Strings.Unbounded.Unbounded_String;
      Format       : Doc_Format := DOC_WIKI_GOOGLE;
   end record;

end Gen.Artifacts.Docs;

-----------------------------------------------------------------------
--  gen-artifacts-docs -- Artifact for documentation
--  Copyright (C) 2012, 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.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with Gen.Model.Packages;

--  with Asis;
--  with Asis.Text;
--  with Asis.Elements;
--  with Asis.Exceptions;
--  with Asis.Errors;
--  with Asis.Implementation;
--  with Asis.Elements;
--  with Asis.Declarations;
--  The Gen.Artifacts.Docs package is an artifact for the generation of
--  application documentation.  Its purpose is to scan the project source files
--  and extract some interesting information for a developer's guide.  The artifact
--  scans the Ada source files, the XML configuration files, the XHTML files.
--
--  The generated documentation is intended to be published on a web site.
--  The Google Wiki style is generated by default.
--
--  1/ In the first step, the project files are scanned and the useful
--     documentation is extracted.
--
--  2/ In the second step, the documentation is merged and reconciled.  Links to
--     documentation pages and references are setup and the final pages are generated.
--
--  Ada
--  ---
--  The documentation starts at the first '== TITLE ==' marker and finishes before the
--  package specification.
--
--  XHTML
--  -----
--  Same as Ada.
--
--  XML Files
--  ----------
--  The documentation is part of the XML and the documentation or description
--  tags are extracted.
package Gen.Artifacts.Docs is

   --  Tag marker (same as Java).
   TAG_CHAR     : constant Character := '@';

   --  Specific tags recognized when analyzing the documentation.
   TAG_AUTHOR   : constant String := "author";
   TAG_TITLE    : constant String := "title";
   TAG_INCLUDE  : constant String := "include";
   TAG_SEE      : constant String := "see";

   type Doc_Format is (DOC_MARKDOWN, DOC_WIKI_GOOGLE);

   --  ------------------------------
   --  Documentation artifact
   --  ------------------------------
   type Artifact is new Gen.Artifacts.Artifact with private;

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class);

   --  Set the output document format to generate.
   procedure Set_Format (Handler : in out Artifact;
                         Format  : in Doc_Format);

private

   type Line_Kind is (L_TEXT, L_LIST, L_LIST_ITEM, L_SEE, L_INCLUDE);

   type Line_Type (Len : Natural) is record
      Kind    : Line_Kind := L_TEXT;
      Content : String (1 .. Len);
   end record;

   package Line_Vectors is
      new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                             Element_Type => Line_Type);

   type Doc_State is (IN_PARA, IN_SEPARATOR, IN_CODE, IN_CODE_SEPARATOR, IN_LIST);

   type Document_Formatter is abstract tagged null record;
   type Document_Formatter_Access is access all Document_Formatter'Class;

   type File_Document is record
      Name         : Ada.Strings.Unbounded.Unbounded_String;
      Title        : Ada.Strings.Unbounded.Unbounded_String;
      State        : Doc_State := IN_PARA;
      Line_Number  : Natural := 0;
      Lines        : Line_Vectors.Vector;
      Was_Included : Boolean := False;
      Formatter    : Document_Formatter_Access;
   end record;

   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is abstract;

   --  Start a new document.
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is abstract;

   --  Write a line in the target document formatting the line if necessary.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is abstract;

   package Doc_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => File_Document,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Include the document extract represented by Name into the document Into.
   --  The included document is marked so that it will not be generated.
   procedure Include (Docs     : in out Doc_Maps.Map;
                      Into     : in out File_Document;
                      Name     : in String;
                      Position : in Natural);

   --  Generate the project documentation that was collected in Docs.
   --  The documentation is merged so that the @include tags are replaced by the matching
   --  document extracts.
   procedure Generate (Docs : in out Doc_Maps.Map;
                       Dir  : in String);

   --  Returns True if the line indicates a bullet or numbered list.
   function Is_List (Line : in String) return Boolean;

   --  Returns True if the line indicates a code sample.
   function Is_Code (Line : in String) return Boolean;

   --  Append a raw text line to the document.
   procedure Append_Line (Doc  : in out File_Document;
                          Line : in String);

   --  Look and analyze the tag defined on the line.
   procedure Append_Tag (Doc : in out File_Document;
                         Tag : in String);

   --  Analyse the documentation line and collect the documentation text.
   procedure Append (Doc   : in out File_Document;
                     Line  : in String);

   --  After having collected the documentation, terminate the document by making sure
   --  the opened elements are closed.
   procedure Finish (Doc : in out File_Document);

   --  Set the name associated with the document extract.
   procedure Set_Name (Doc  : in out File_Document;
                       Name : in String);

   --  Set the title associated with the document extract.
   procedure Set_Title (Doc   : in out File_Document;
                        Title : in String);

   --  Scan the files in the directory refered to by Path and collect the documentation
   --  in the Docs hashed map.
   procedure Scan_Files (Handler : in out Artifact;
                         Path    : in String;
                         Docs    : in out Doc_Maps.Map);

   --  Read the Ada specification file and collect the useful documentation.
   --  To keep the implementation simple, we don't use the ASIS packages to scan and extract
   --  the documentation.  We don't need to look at the Ada specification itself.  Instead,
   --  we assume that the Ada source follows some Ada style guidelines.
   procedure Read_Ada_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   procedure Read_Xml_File (Handler : in out Artifact;
                            File    : in String;
                            Result  : in out File_Document);

   type Artifact is new Gen.Artifacts.Artifact with record
      Xslt_Command : Ada.Strings.Unbounded.Unbounded_String;
      Format       : Doc_Format := DOC_WIKI_GOOGLE;
   end record;

end Gen.Artifacts.Docs;

Declare the Start_Document procedure

Declare the Start_Document procedure


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

with Util.Encoders;

--  == Encoding Streams ==
--  The <tt>Encoding_Stream</tt> tagged record represents a stream with encoding capabilities.
--  The stream passes the data to be written to the <tt>Transformer</tt> interface that
--  allows to make transformations on the data before being written.
--
--     Encode : Util.Streams.Buffered.Encoders.Encoding_Stream;
--
--  The encoding stream manages a buffer that is used to hold the encoded data before it is
--  written to the target stream.  The <tt>Initialize</tt> procedure must be called to indicate
--  the target stream, the size of the buffer and the encoding format to be used.
--
--     Encode.Initialize (Output => File'Access, Size => 4096, Format => "base64");
--
generic
   type Encoder is limited new Util.Encoders.Transformer with private;
package Util.Streams.Buffered.Encoders is

   --  -----------------------
   --  Encoding stream
   --  -----------------------
   --  The <b>Encoding_Stream</b> is an output stream which uses an encoder to
   --  transform the data before writing it to the output.  The transformer can
   --  change the data by encoding it in Base64, Base16 or encrypting it.
   type Encoder_Stream is limited new Util.Streams.Buffered.Output_Buffer_Stream with record
      Transform   : Encoder;
      Flushed     : Boolean := False;
   end record;

   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   overriding
   procedure Initialize (Stream  : in out Encoder_Stream;
                         Output  : access Output_Stream'Class;
                         Size    : in Positive);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Encoder_Stream);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Encoder_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Encoder_Stream);

   overriding
   procedure Finalize (Stream : in out Encoder_Stream);

end Util.Streams.Buffered.Encoders;

-----------------------------------------------------------------------
--  util-streams-encoders -- Streams with encoding and decoding capabilities
--  Copyright (C) 2017, 2019, 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 Util.Encoders;

--  == Encoding Streams ==
--  The <tt>Encoding_Stream</tt> tagged record represents a stream with encoding capabilities.
--  The stream passes the data to be written to the <tt>Transformer</tt> interface that
--  allows to make transformations on the data before being written.
--
--     Encode : Util.Streams.Buffered.Encoders.Encoding_Stream;
--
--  The encoding stream manages a buffer that is used to hold the encoded data before it is
--  written to the target stream.  The <tt>Initialize</tt> procedure must be called to indicate
--  the target stream, the size of the buffer and the encoding format to be used.
--
--     Encode.Initialize (Output => File'Access, Size => 4096, Format => "base64");
--
generic
   type Encoder is limited new Util.Encoders.Transformer with private;
package Util.Streams.Buffered.Encoders is

   --  -----------------------
   --  Encoding stream
   --  -----------------------
   --  The Encoding_Stream is an output stream which uses an encoder to
   --  transform the data before writing it to the output.  The transformer can
   --  change the data by encoding it in Base64, Base16 or encrypting it.
   type Encoder_Stream is limited new Util.Streams.Buffered.Input_Output_Buffer_Stream
     with record
      Transform   : Encoder;
      Flushed     : Boolean := False;
   end record;

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Encoder_Stream;
                         Size    : in Positive);

   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   procedure Produces (Stream  : in out Encoder_Stream;
                       Output  : access Output_Stream'Class;
                       Size    : in Positive);

   --  Initialize the stream to read the given streams.
   procedure Consumes (Stream  : in out Encoder_Stream;
                       Input   : access Input_Stream'Class;
                       Size    : in Positive);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Encoder_Stream);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Encoder_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Read into the buffer as many bytes as possible and return in
   --  `last` the position of the last byte read.
   overriding
   procedure Read (Stream : in out Encoder_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Encoder_Stream);

   overriding
   procedure Finalize (Stream : in out Encoder_Stream);

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Encoder_Stream);

end Util.Streams.Buffered.Encoders;

Refactor the Util.Stream.Buffered stream - allow to use the target stream with Read (pull model) and Write (push model)


-----------------------------------------------------------------------
--  awa-sysadmin-modules -- Module sysadmin
--  Copyright (C) 2019, 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 AWA.Applications;
with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Sysadmin.Models;
with Util.Log.Loggers;
with ADO.Sessions;
with ADO.Statements;
with ADO.Queries;
with ADO.Utils.Serialize;
with Servlet.Rest;
with Swagger.Servers.Operation;
with AWA.Sysadmin.Beans;
package body AWA.Sysadmin.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Sysadmin.Module");

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

   procedure List_Users
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type);

   procedure List_Sessions
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type);

   procedure List_Jobs
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type);

   package API_List_Users is
     new Swagger.Servers.Operation (Handler => List_Users,
                                    Method  => Swagger.Servers.GET,
                                    URI     => "/sysadmin/api/v1/users");

   package API_List_Sessions is
     new Swagger.Servers.Operation (Handler => List_Sessions,
                                    Method  => Swagger.Servers.GET,
                                    URI     => "/sysadmin/api/v1/sessions");

   package API_List_Jobs is
     new Swagger.Servers.Operation (Handler => List_Jobs,
                                    Method  => Swagger.Servers.GET,
                                    URI     => "/sysadmin/api/v1/jobs");

   procedure List_Users
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type) is
      pragma Unreferenced (Req, Reply);

      Module  : constant Sysadmin_Module_Access := Get_Sysadmin_Module;
      Session : constant ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;

      Stmt : ADO.Statements.Query_Statement;
   begin
      Log.Info ("List users");

      Query.Set_Query (AWA.Sysadmin.Models.Query_Sysadmin_User_List);
      Stmt := Session.Create_Statement (Query);
      Stmt.Execute;

      Stream.Start_Document;
      ADO.Utils.Serialize.Write_Query (Stream, "", Stmt);
      Stream.End_Document;
      Context.Set_Status (200);
   end List_Users;

   procedure List_Sessions
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type) is
      pragma Unreferenced (Req, Reply);

      Module  : constant Sysadmin_Module_Access := Get_Sysadmin_Module;
      Session : constant ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;

      Stmt : ADO.Statements.Query_Statement;
   begin
      Log.Info ("List sessions");

      Query.Set_Query (AWA.Sysadmin.Models.Query_Sysadmin_Session_List);
      Stmt := Session.Create_Statement (Query);
      Stmt.Execute;

      Stream.Start_Document;
      ADO.Utils.Serialize.Write_Query (Stream, "", Stmt);
      Stream.End_Document;
      Context.Set_Status (200);
   end List_Sessions;

   procedure List_Jobs
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type) is
      pragma Unreferenced (Req, Reply);

      Module  : constant Sysadmin_Module_Access := Get_Sysadmin_Module;
      Session : constant ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;

      Stmt : ADO.Statements.Query_Statement;
   begin
      Log.Info ("List jobs");

      Query.Set_Query (AWA.Sysadmin.Models.Query_Sysadmin_Job_List);
      Stmt := Session.Create_Statement (Query);
      Stmt.Execute;

      Stream.Start_Document;
      ADO.Utils.Serialize.Write_Query (Stream, "", Stmt);
      Stream.End_Document;
      Context.Set_Status (200);
   end List_Jobs;

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

      App.Add_Servlet ("sysadmin", Plugin.API_Servlet'Unchecked_Access);
      App.Add_Filter ("sysadmin-filter", Plugin.API_Filter'Unchecked_Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Sysadmin.Beans.Authenticate_Bean",
                         Handler => AWA.Sysadmin.Beans.Create_Authenticate_Bean'Access);

      App.Add_Mapping (Name => "sysadmin", Pattern => "/sysadmin/api/*");

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

      Servlet.Rest.Register (App.all, API_List_Users.Definition);
      Servlet.Rest.Register (App.all, API_List_Sessions.Definition);
      Servlet.Rest.Register (App.all, API_List_Jobs.Definition);
   end Initialize;

   --  ------------------------------
   --  Get the sysadmin module.
   --  ------------------------------
   function Get_Sysadmin_Module return Sysadmin_Module_Access is
      function Get is new AWA.Modules.Get (Sysadmin_Module, Sysadmin_Module_Access, NAME);
   begin
      return Get;
   end Get_Sysadmin_Module;

end AWA.Sysadmin.Modules;

-----------------------------------------------------------------------
--  awa-sysadmin-modules -- Module sysadmin
--  Copyright (C) 2019, 2020, 2022 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.Applications;
with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Sysadmin.Models;
with Util.Log.Loggers;
with ADO.Sessions;
with ADO.Statements;
with ADO.Queries;
with ADO.Utils.Serialize;
with Servlet.Rest;
with Swagger.Servers.Operation;
with AWA.Sysadmin.Beans;
package body AWA.Sysadmin.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Sysadmin.Module");

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

   Mimes : aliased constant Swagger.Servers.Mime_List :=
     (1 => Swagger.Servers.Mime_Json,
      2 => Swagger.Servers.Mime_Xml);

   procedure List_Users
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type);

   procedure List_Sessions
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type);

   procedure List_Jobs
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type);

   package API_List_Users is
     new Swagger.Servers.Operation (Handler => List_Users,
                                    Method  => Swagger.Servers.GET,
                                    URI     => "/sysadmin/api/v1/users",
                                    Mimes   => Mimes'Access);

   package API_List_Sessions is
     new Swagger.Servers.Operation (Handler => List_Sessions,
                                    Method  => Swagger.Servers.GET,
                                    URI     => "/sysadmin/api/v1/sessions",
                                    Mimes   => Mimes'Access);

   package API_List_Jobs is
     new Swagger.Servers.Operation (Handler => List_Jobs,
                                    Method  => Swagger.Servers.GET,
                                    URI     => "/sysadmin/api/v1/jobs",
                                    Mimes   => Mimes'Access);

   procedure List_Users
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type) is
      pragma Unreferenced (Req, Reply);

      Module  : constant Sysadmin_Module_Access := Get_Sysadmin_Module;
      Session : constant ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;

      Stmt : ADO.Statements.Query_Statement;
   begin
      Log.Info ("List users");

      Query.Set_Query (AWA.Sysadmin.Models.Query_Sysadmin_User_List);
      Stmt := Session.Create_Statement (Query);
      Stmt.Execute;

      Stream.Start_Document;
      ADO.Utils.Serialize.Write_Query (Stream, "", Stmt);
      Stream.End_Document;
      Context.Set_Status (200);
   end List_Users;

   procedure List_Sessions
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type) is
      pragma Unreferenced (Req, Reply);

      Module  : constant Sysadmin_Module_Access := Get_Sysadmin_Module;
      Session : constant ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;

      Stmt : ADO.Statements.Query_Statement;
   begin
      Log.Info ("List sessions");

      Query.Set_Query (AWA.Sysadmin.Models.Query_Sysadmin_Session_List);
      Stmt := Session.Create_Statement (Query);
      Stmt.Execute;

      Stream.Start_Document;
      ADO.Utils.Serialize.Write_Query (Stream, "", Stmt);
      Stream.End_Document;
      Context.Set_Status (200);
   end List_Sessions;

   procedure List_Jobs
     (Req     : in out Swagger.Servers.Request'Class;
      Reply   : in out Swagger.Servers.Response'Class;
      Stream  : in out Swagger.Servers.Output_Stream'Class;
      Context : in out Swagger.Servers.Context_Type) is
      pragma Unreferenced (Req, Reply);

      Module  : constant Sysadmin_Module_Access := Get_Sysadmin_Module;
      Session : constant ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;

      Stmt : ADO.Statements.Query_Statement;
   begin
      Log.Info ("List jobs");

      Query.Set_Query (AWA.Sysadmin.Models.Query_Sysadmin_Job_List);
      Stmt := Session.Create_Statement (Query);
      Stmt.Execute;

      Stream.Start_Document;
      ADO.Utils.Serialize.Write_Query (Stream, "", Stmt);
      Stream.End_Document;
      Context.Set_Status (200);
   end List_Jobs;

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

      App.Add_Servlet ("sysadmin", Plugin.API_Servlet'Unchecked_Access);
      App.Add_Filter ("sysadmin-filter", Plugin.API_Filter'Unchecked_Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Sysadmin.Beans.Authenticate_Bean",
                         Handler => AWA.Sysadmin.Beans.Create_Authenticate_Bean'Access);

      App.Add_Mapping (Name => "sysadmin", Pattern => "/sysadmin/api/*");

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

      Servlet.Rest.Register (App.all, API_List_Users.Definition);
      Servlet.Rest.Register (App.all, API_List_Sessions.Definition);
      Servlet.Rest.Register (App.all, API_List_Jobs.Definition);
   end Initialize;

   --  ------------------------------
   --  Get the sysadmin module.
   --  ------------------------------
   function Get_Sysadmin_Module return Sysadmin_Module_Access is
      function Get is new AWA.Modules.Get (Sysadmin_Module, Sysadmin_Module_Access, NAME);
   begin
      return Get;
   end Get_Sysadmin_Module;

end AWA.Sysadmin.Modules;

Update to define the supported response mime types


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

with Ada.Finalization;

with ADO.Statements;
with ADO.Schemas;
with ADO.Drivers.Connections;

package ADO.Databases is

   use ADO.Statements;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   --  Raised if the database connection is not open.
   NOT_OPEN : exception;

   NOT_FOUND : exception;

   NO_DATABASE : exception;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  The database connection status
   type Connection_Status is (OPEN, CLOSED);

   --  ---------
   --  Database connection
   --  ---------
   --  Read-only database connection (or slave connection).
   --
   type Connection is tagged private;

   --  Get the database connection status.
   function Get_Status (Database : in Connection) return Connection_Status;

   --  Close the database connection
   procedure Close (Database : in out Connection);

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Connection;
                              Query    : in String)
                              return Query_Statement;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Connection;
                          Schema   : out ADO.Schemas.Schema_Definition);

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Connection) return ADO.Drivers.Connections.Driver_Access;

   --  Get the database driver index.
   function Get_Driver_Index (Database : in Connection) return ADO.Drivers.Driver_Index;

   --  Get a database connection identifier.
   function Get_Ident (Database : in Connection) return String;

   --  ---------
   --  Master Database connection
   --  ---------
   --  Read-write database connection.
   type Master_Connection is new Connection with private;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Master_Connection);

   --  Commit the current transaction.
   procedure Commit (Database : in out Master_Connection);

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Master_Connection);

   --  Execute an SQL statement
--     procedure Execute (Database : in Master_Connection;
--                        SQL      : in Query_String);

   --  Execute an SQL statement
--     procedure Execute (Database : in Master_Connection;
--                        SQL      : in Query_String;
--                        Id       : out Identifier);

   --  Create a delete statement.
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement;

   --  Create an insert statement.
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement;

   --  Create an update statement.
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement;

   --  ------------------------------
   --  The database connection source
   --  ------------------------------
   --  The <b>DataSource</b> is the factory for getting a connection to the database.
   --  It contains the configuration properties to define which database driver must
   --  be used and which connection parameters the driver has to use to establish
   --  the connection.
   type DataSource is new ADO.Drivers.Connections.Configuration with private;
   type DataSource_Access is access all DataSource'Class;

   --  Attempts to establish a connection with the data source
   --  that this DataSource object represents.
   function Get_Connection (Controller : in DataSource)
                         return Master_Connection'Class;

   --  ------------------------------
   --  Replicated Data Source
   --  ------------------------------
   --  The replicated data source supports a Master/Slave database configuration.
   --  When using this data source, the master is used to execute
   --  update, insert, delete and also query statements.  The slave is used
   --  to execute query statements.  The master and slave are represented by
   --  two separate data sources.  This allows to have a master on one server,
   --  use a specific user/password and get a slave on another server with other
   --  credentials.
   type Replicated_DataSource is new DataSource with private;
   type Replicated_DataSource_Access is access all Replicated_DataSource'Class;

   --  Set the master data source
   procedure Set_Master (Controller : in out Replicated_DataSource;
                         Master     : in DataSource_Access);

   --  Get the master data source
   function Get_Master (Controller : in Replicated_DataSource)
                       return DataSource_Access;

   --  Set the slave data source
   procedure Set_Slave (Controller : in out Replicated_DataSource;
                        Slave      : in DataSource_Access);

   --  Get the slace data source
   function Get_Slave (Controller : in Replicated_DataSource)
                      return DataSource_Access;

   --  Get a slave database connection
   function Get_Slave_Connection (Controller : in Replicated_DataSource)
                                 return Connection'Class;

private

   type Connection is new Ada.Finalization.Controlled with record
      Impl : ADO.Drivers.Connections.Database_Connection_Access := null;
   end record;

   --  Adjust the connection reference counter
   overriding
   procedure Adjust (Object : in out Connection);

   --  Releases the connection reference counter
   overriding
   procedure Finalize (Object : in out Connection);

   type Master_Connection is new Connection with null record;

   type DataSource is new ADO.Drivers.Connections.Configuration with null record;

   type Replicated_DataSource is new DataSource with record
      Master : DataSource_Access := null;
      Slave  : DataSource_Access := null;
   end record;

end ADO.Databases;

-----------------------------------------------------------------------
--  ADO Databases -- Database Connections
--  Copyright (C) 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 ADO.Statements;
with ADO.Schemas;
with ADO.Drivers.Connections;

package ADO.Databases is

   use ADO.Statements;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   --  Raised if the database connection is not open.
   NOT_OPEN : exception;

   NOT_FOUND : exception;

   NO_DATABASE : exception;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  The database connection status
   type Connection_Status is (OPEN, CLOSED);

   --  ---------
   --  Database connection
   --  ---------
   --  Read-only database connection (or slave connection).
   --
   type Connection is tagged private;

   --  Get the database connection status.
   function Get_Status (Database : in Connection) return Connection_Status;

   --  Close the database connection
   procedure Close (Database : in out Connection);

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Connection;
                              Query    : in String)
                              return Query_Statement;

   --  Load the database schema definition for the current database.
   procedure Load_Schema (Database : in Connection;
                          Schema   : out ADO.Schemas.Schema_Definition);

   --  Get the database driver which manages this connection.
   function Get_Driver (Database : in Connection) return ADO.Drivers.Connections.Driver_Access;

   --  Get the database driver index.
   function Get_Driver_Index (Database : in Connection) return ADO.Drivers.Driver_Index;

   --  Get a database connection identifier.
   function Get_Ident (Database : in Connection) return String;

   --  ---------
   --  Master Database connection
   --  ---------
   --  Read-write database connection.
   type Master_Connection is new Connection with private;

   --  Start a transaction.
   procedure Begin_Transaction (Database : in out Master_Connection);

   --  Commit the current transaction.
   procedure Commit (Database : in out Master_Connection);

   --  Rollback the current transaction.
   procedure Rollback (Database : in out Master_Connection);

   --  Execute an SQL statement
--     procedure Execute (Database : in Master_Connection;
--                        SQL      : in Query_String);

   --  Execute an SQL statement
--     procedure Execute (Database : in Master_Connection;
--                        SQL      : in Query_String;
--                        Id       : out Identifier);

   --  Create a delete statement.
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement;

   --  Create an insert statement.
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement;

   --  Create an update statement.
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement;

   --  ------------------------------
   --  The database connection source
   --  ------------------------------
   --  The <b>DataSource</b> is the factory for getting a connection to the database.
   --  It contains the configuration properties to define which database driver must
   --  be used and which connection parameters the driver has to use to establish
   --  the connection.
   type DataSource is new ADO.Drivers.Connections.Configuration with private;
   type DataSource_Access is access all DataSource'Class;

   --  Attempts to establish a connection with the data source
   --  that this DataSource object represents.
   function Get_Connection (Controller : in DataSource)
                         return Master_Connection'Class;

   --  ------------------------------
   --  Replicated Data Source
   --  ------------------------------
   --  The replicated data source supports a Master/Slave database configuration.
   --  When using this data source, the master is used to execute
   --  update, insert, delete and also query statements.  The slave is used
   --  to execute query statements.  The master and slave are represented by
   --  two separate data sources.  This allows to have a master on one server,
   --  use a specific user/password and get a slave on another server with other
   --  credentials.
   type Replicated_DataSource is new DataSource with private;
   type Replicated_DataSource_Access is access all Replicated_DataSource'Class;

   --  Set the master data source
   procedure Set_Master (Controller : in out Replicated_DataSource;
                         Master     : in DataSource_Access);

   --  Get the master data source
   function Get_Master (Controller : in Replicated_DataSource)
                       return DataSource_Access;

   --  Set the slave data source
   procedure Set_Slave (Controller : in out Replicated_DataSource;
                        Slave      : in DataSource_Access);

   --  Get the slace data source
   function Get_Slave (Controller : in Replicated_DataSource)
                      return DataSource_Access;

   --  Get a slave database connection
   function Get_Slave_Connection (Controller : in Replicated_DataSource)
                                 return Connection'Class;

private

   type Connection is new ADO.Drivers.Connections.Ref.Ref with null record;

   type Master_Connection is new Connection with null record;

   type DataSource is new ADO.Drivers.Connections.Configuration with null record;

   type Replicated_DataSource is new DataSource with record
      Master : DataSource_Access := null;
      Slave  : DataSource_Access := null;
   end record;

end ADO.Databases;

Change the implementation to use the Util.Refs package