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

with Util.Files;
with Util.Streams;
with Util.Streams.Files;
with Ada.Streams;
with Ada.Streams.Stream_IO;

with Ada.Directories;

with ASF.Streams;
package body ASF.Servlets.Files is

   use Ada.Streams;
   use Ada.Streams.Stream_IO;
   use Ada.Directories;

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out File_Servlet;
                         Context : in Servlet_Registry'Class) is
      Dir : constant String := Context.Get_Init_Parameter ("web.dir");
   begin
      Server.Dir := new String '(Dir);
   end Initialize;

   --  ------------------------------
   --  Returns the time the Request object was last modified, in milliseconds since
   --  midnight January 1, 1970 GMT.  If the time is unknown, this method returns
   --  a negative number (the default).
   --
   --  Servlets that support HTTP GET requests and can quickly determine their
   --  last modification time should override this method. This makes browser and
   --  proxy caches work more effectively, reducing the load on server and network
   --  resources.
   --  ------------------------------
   function Get_Last_Modified (Server : in File_Servlet;
                               Requet : in Requests.Request'Class)
                               return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Clock;
   end Get_Last_Modified;

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

      use Util.Files;

      URI  : constant String := Request.Get_Request_URI;
      Path : constant String := Find_File_Path (Name => URI, Paths => Server.Dir.all);
   begin
      if not Ada.Directories.Exists (Path)
        or else Ada.Directories.Kind (Path) /= Ada.Directories.Ordinary_File then
         Response.Send_Error (Responses.SC_NOT_FOUND);
         return;
      end if;

      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
         Input  : Util.Streams.Files.File_Stream;
      begin
         Input.Open (Name => Path, Mode => In_File);
         Util.Streams.Copy (From => Input, Into => Output);
      end;
   end Do_Get;

end ASF.Servlets.Files;

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

with Util.Files;
with Util.Streams;
with Util.Streams.Files;
with Ada.Streams;
with Ada.Streams.Stream_IO;

with Ada.Directories;

with ASF.Streams;
package body ASF.Servlets.Files is

   use Ada.Streams;
   use Ada.Streams.Stream_IO;
   use Ada.Directories;

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out File_Servlet;
                         Context : in Servlet_Registry'Class) is
      Dir : constant String := Context.Get_Init_Parameter ("web.dir");
   begin
      Server.Dir := new String '(Dir);
   end Initialize;

   --  ------------------------------
   --  Returns the time the Request object was last modified, in milliseconds since
   --  midnight January 1, 1970 GMT.  If the time is unknown, this method returns
   --  a negative number (the default).
   --
   --  Servlets that support HTTP GET requests and can quickly determine their
   --  last modification time should override this method. This makes browser and
   --  proxy caches work more effectively, reducing the load on server and network
   --  resources.
   --  ------------------------------
   function Get_Last_Modified (Server : in File_Servlet;
                               Requet : in Requests.Request'Class)
                               return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Clock;
   end Get_Last_Modified;

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

      use Util.Files;

      URI  : constant String := Request.Get_Path_Info;
      Path : constant String := Find_File_Path (Name => URI, Paths => Server.Dir.all);
   begin
      if not Ada.Directories.Exists (Path)
        or else Ada.Directories.Kind (Path) /= Ada.Directories.Ordinary_File then
         Response.Send_Error (Responses.SC_NOT_FOUND);
         return;
      end if;

      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
         Input  : Util.Streams.Files.File_Stream;
      begin
         Input.Open (Name => Path, Mode => In_File);
         Util.Streams.Copy (From => Input, Into => Output);
      end;
   end Do_Get;

end ASF.Servlets.Files;

Use Get_Path_Info instead of the Get_Request_URI to get only the relative part of the Path and drop the servlet prefix. This path is then used to find the file path.


-----------------------------------------------------------------------
--  factories -- Factory for property manager implementation
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Properties.Hash;
package body Util.Properties.Factories is

   Property_Manager_Factory : Interface_P.Manager_Factory;

   --  ------------------------------
   --  Initialize the property manager by setting the implementation.
   --  ------------------------------
   procedure Initialize (Properties : in out Manager) is
      use Interface_P;
   begin
      if Properties.Impl = null then
         if Property_Manager_Factory = null then
            Properties.Impl := new Util.Properties.Hash.Manager;
         else
            Properties.Impl := Property_Manager_Factory.all;
         end if;
         Properties.Impl.Count := 1;
      end if;
   end Initialize;

   --  ------------------------------
   --  Set the default implementation factory for property manager.
   --  ------------------------------
   procedure Set_Default_Factory (Factory : Interface_P.Manager_Factory) is
   begin
      Property_Manager_Factory := Factory;
   end Set_Default_Factory;

end Util.Properties.Factories;

-----------------------------------------------------------------------
--  factories -- Factory for property manager implementation
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 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 Util.Properties.Hash;
package body Util.Properties.Factories is

   Property_Manager_Factory : Interface_P.Manager_Factory;

   --  ------------------------------
   --  Initialize the property manager by setting the implementation.
   --  ------------------------------
   procedure Initialize (Properties : in out Manager) is
      use Interface_P;
   begin
      if Properties.Impl = null then
         if Property_Manager_Factory = null then
            Properties.Impl := new Util.Properties.Hash.Manager;
         else
            Properties.Impl := Property_Manager_Factory.all;
         end if;
         Util.Concurrent.Counters.Increment (Properties.Impl.Count);
      end if;
   end Initialize;

   --  ------------------------------
   --  Set the default implementation factory for property manager.
   --  ------------------------------
   procedure Set_Default_Factory (Factory : Interface_P.Manager_Factory) is
   begin
      Property_Manager_Factory := Factory;
   end Set_Default_Factory;

end Util.Properties.Factories;

Update to use the concurrent counter

Update to use the concurrent counter


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

with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Strings.Sets;

with Gen.Model.List;
with Gen.Model.Mappings;
limited with Gen.Model.Enums;
limited with Gen.Model.Tables;
limited with Gen.Model.Queries;
limited with Gen.Model.Beans;
package Gen.Model.Packages is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   --  The Model_Definition contains the complete model from one or
   --  several files.  It maintains a list of Ada packages that must be generated.
   type Model_Definition is new Definition with private;
   type Model_Definition_Access is access all Model_Definition'Class;

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Model_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  ------------------------------
   --  Package Definition
   --  ------------------------------
   --  The Package_Definition holds the tables, queries and other information
   --  that must be generated for a given Ada package.
   type Package_Definition is new Definition with private;
   type Package_Definition_Access is access all Package_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Package_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Package_Definition);

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Package_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  Initialize the package instance
   overriding
   procedure Initialize (O : in out Package_Definition);

   --  Find the type identified by the name.
   function Find_Type (From : in Package_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Get the model which contains all the package definitions.
   function Get_Model (From : in Package_Definition)
                       return Model_Definition_Access;

   --  Returns True if the package is a pre-defined package and must not be generated.
   function Is_Predefined (From : in Package_Definition) return Boolean;

   --  Set the package as a pre-defined package.
   procedure Set_Predefined (From : in out Package_Definition);

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Model_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Initialize the model definition instance.
   overriding
   procedure Initialize (O : in out Model_Definition);

   --  Returns True if the model contains at least one package.
   function Has_Packages (O : in Model_Definition) return Boolean;

   --  Register or find the package knowing its name
   procedure Register_Package (O      : in out Model_Definition;
                               Name   : in Unbounded_String;
                               Result : out Package_Definition_Access);

   --  Register the declaration of the given enum in the model.
   procedure Register_Enum (O    : in out Model_Definition;
                            Enum : access Gen.Model.Enums.Enum_Definition'Class);

   --  Register the declaration of the given table in the model.
   procedure Register_Table (O     : in out Model_Definition;
                             Table : access Gen.Model.Tables.Table_Definition'Class);

   --  Register the declaration of the given query in the model.
   procedure Register_Query (O     : in out Model_Definition;
                             Table : access Gen.Model.Queries.Query_File_Definition'Class);

   --  Register the declaration of the given bean in the model.
   procedure Register_Bean (O     : in out Model_Definition;
                            Bean  : access Gen.Model.Beans.Bean_Definition'Class);

   --  Register a type mapping.  The From type describes a type in the XML
   --  configuration files (hibernate, query, ...) and the To represents the
   --  corresponding Ada type.
   procedure Register_Type (O    : in out Model_Definition;
                            From : in String;
                            To   : in String);

   --  Find the type identified by the name.
   function Find_Type (From : in Model_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Set the directory name associated with the model. This directory name allows to
   --  save and build a model in separate directories for the application, the unit tests
   --  and others.
   procedure Set_Dirname (O : in out Model_Definition;
                          Target_Dir : in String;
                          Model_Dir  : in String);

   --  Get the directory name associated with the model.
   function Get_Dirname (O : in Model_Definition) return String;

   --  Get the directory name which contains the model.
   function Get_Model_Directory (O : in Model_Definition) return String;

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (Model : in out Model_Definition;
                                        Name  : in String);

   --  Returns True if the generation is enabled for the given package name.
   function Is_Generation_Enabled (Model : in Model_Definition;
                                   Name  : in String) return Boolean;

   --  Iterate over the model tables.
   procedure Iterate_Tables (Model   : in Model_Definition;
                             Process : not null access
                               procedure (Item : in out Tables.Table_Definition));

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Model_Definition);

   package Package_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Package_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Package_Cursor is Package_Map.Cursor;

   --  Get the first package of the model definition.
   function First (From : Model_Definition) return Package_Cursor;

   --  Returns true if the package cursor contains a valid package
   function Has_Element (Position : Package_Cursor) return Boolean
                         renames Package_Map.Has_Element;

   --  Returns the package definition.
   function Element (Position : Package_Cursor) return Package_Definition_Access
                     renames Package_Map.Element;

   --  Move the iterator to the next package definition.
   procedure Next (Position : in out Package_Cursor)
                   renames Package_Map.Next;

private

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

   --  Returns False if the <tt>Left</tt> table does not depend on <tt>Right</tt>.
   --  Returns True if the <tt>Left</tt> table depends on the <tt>Right</tt> table.
   function Dependency_Compare (Left, Right : in Definition_Access) return Boolean;

   --  Sort the tables on their dependency.
   procedure Dependency_Sort is new Table_List.Sort_On ("<" => Dependency_Compare);

   subtype Table_List_Definition is Table_List.List_Definition;
   subtype Enum_List_Definition is Table_List.List_Definition;

   type List_Object is new Util.Beans.Basic.List_Bean with record
      Values     : Util.Beans.Objects.Vectors.Vector;
      Row        : Natural;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : in List_Object) return Natural;

   --  Set the current row index.  Valid row indexes start at 1.
   overriding
   procedure Set_Row_Index (From  : in out List_Object;
                            Index : in Natural);

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : in List_Object) return Util.Beans.Objects.Object;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in List_Object;
                       Name : in String) return Util.Beans.Objects.Object;

   type Package_Definition is new Definition with record
      --  Enums defined in the package.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  Hibernate tables
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  Custom queries
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Spec_Types    : aliased List_Object;
      Used_Spec          : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Body_Types    : aliased List_Object;
      Used_Body          : Util.Beans.Objects.Object;

      --  A map of all types defined in this package.
      Types        : Gen.Model.Mappings.Mapping_Maps.Map;

      --  The base name for the package (ex: gen-model-users)
      Base_Name    : Unbounded_String;

      --  The global model (used to resolve types from other packages).
      Model              : Model_Definition_Access;

      --  True if the package uses Ada.Calendar.Time
      Uses_Calendar_Time : Boolean := False;

      --  True if the package is a pre-defined package (ie, defined by a UML profile).
      Is_Predefined      : Boolean := False;
   end record;

   type Model_Definition is new Definition with record
      --  List of all enums.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  List of all tables.
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  List of all queries.
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  Map of all packages.
      Packages     : Package_Map.Map;

      --  Directory associated with the model ('src', 'samples', 'regtests', ...).
      Dir_Name     : Unbounded_String;

      --  Directory that contains the SQL and model files.
      DB_Name      : Unbounded_String;

      --  When not empty, a list of packages that must be taken into account for the generation.
      --  By default all packages and tables defined in the model are generated.
      Gen_Packages : Util.Strings.Sets.Set;
   end record;

end Gen.Model.Packages;

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

with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Strings.Sets;

with Gen.Model.List;
with Gen.Model.Mappings;
limited with Gen.Model.Enums;
limited with Gen.Model.Tables;
limited with Gen.Model.Queries;
limited with Gen.Model.Beans;
package Gen.Model.Packages is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   --  The Model_Definition contains the complete model from one or
   --  several files.  It maintains a list of Ada packages that must be generated.
   type Model_Definition is new Definition with private;
   type Model_Definition_Access is access all Model_Definition'Class;

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Model_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  ------------------------------
   --  Package Definition
   --  ------------------------------
   --  The Package_Definition holds the tables, queries and other information
   --  that must be generated for a given Ada package.
   type Package_Definition is new Definition with private;
   type Package_Definition_Access is access all Package_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Package_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Package_Definition);

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Package_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  Initialize the package instance
   overriding
   procedure Initialize (O : in out Package_Definition);

   --  Find the type identified by the name.
   function Find_Type (From : in Package_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Get the model which contains all the package definitions.
   function Get_Model (From : in Package_Definition)
                       return Model_Definition_Access;

   --  Returns True if the package is a pre-defined package and must not be generated.
   function Is_Predefined (From : in Package_Definition) return Boolean;

   --  Set the package as a pre-defined package.
   procedure Set_Predefined (From : in out Package_Definition);

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Model_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Initialize the model definition instance.
   overriding
   procedure Initialize (O : in out Model_Definition);

   --  Returns True if the model contains at least one package.
   function Has_Packages (O : in Model_Definition) return Boolean;

   --  Register or find the package knowing its name
   procedure Register_Package (O      : in out Model_Definition;
                               Name   : in Unbounded_String;
                               Result : out Package_Definition_Access);

   --  Register the declaration of the given enum in the model.
   procedure Register_Enum (O    : in out Model_Definition;
                            Enum : access Gen.Model.Enums.Enum_Definition'Class);

   --  Register the declaration of the given table in the model.
   procedure Register_Table (O     : in out Model_Definition;
                             Table : access Gen.Model.Tables.Table_Definition'Class);

   --  Register the declaration of the given query in the model.
   procedure Register_Query (O     : in out Model_Definition;
                             Table : access Gen.Model.Queries.Query_File_Definition'Class);

   --  Register the declaration of the given bean in the model.
   procedure Register_Bean (O     : in out Model_Definition;
                            Bean  : access Gen.Model.Beans.Bean_Definition'Class);

   --  Register a type mapping.  The From type describes a type in the XML
   --  configuration files (hibernate, query, ...) and the To represents the
   --  corresponding Ada type.
   procedure Register_Type (O    : in out Model_Definition;
                            From : in String;
                            To   : in String);

   --  Find the type identified by the name.
   function Find_Type (From : in Model_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Set the directory name associated with the model. This directory name allows to
   --  save and build a model in separate directories for the application, the unit tests
   --  and others.
   procedure Set_Dirname (O : in out Model_Definition;
                          Target_Dir : in String;
                          Model_Dir  : in String);

   --  Get the directory name associated with the model.
   function Get_Dirname (O : in Model_Definition) return String;

   --  Get the directory name which contains the model.
   function Get_Model_Directory (O : in Model_Definition) return String;

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (Model : in out Model_Definition;
                                        Name  : in String);

   --  Returns True if the generation is enabled for the given package name.
   function Is_Generation_Enabled (Model : in Model_Definition;
                                   Name  : in String) return Boolean;

   --  Iterate over the model tables.
   procedure Iterate_Tables (Model   : in Model_Definition;
                             Process : not null access
                               procedure (Item : in out Tables.Table_Definition));

   --  Iterate over the model enums.
   procedure Iterate_Enums (Model   : in Model_Definition;
                             Process : not null access
                               procedure (Item : in out Enums.Enum_Definition));

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Model_Definition);

   package Package_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Package_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Package_Cursor is Package_Map.Cursor;

   --  Get the first package of the model definition.
   function First (From : Model_Definition) return Package_Cursor;

   --  Returns true if the package cursor contains a valid package
   function Has_Element (Position : Package_Cursor) return Boolean
                         renames Package_Map.Has_Element;

   --  Returns the package definition.
   function Element (Position : Package_Cursor) return Package_Definition_Access
                     renames Package_Map.Element;

   --  Move the iterator to the next package definition.
   procedure Next (Position : in out Package_Cursor)
                   renames Package_Map.Next;

private

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

   --  Returns False if the <tt>Left</tt> table does not depend on <tt>Right</tt>.
   --  Returns True if the <tt>Left</tt> table depends on the <tt>Right</tt> table.
   function Dependency_Compare (Left, Right : in Definition_Access) return Boolean;

   --  Sort the tables on their dependency.
   procedure Dependency_Sort is new Table_List.Sort_On ("<" => Dependency_Compare);

   subtype Table_List_Definition is Table_List.List_Definition;
   subtype Enum_List_Definition is Table_List.List_Definition;

   type List_Object is new Util.Beans.Basic.List_Bean with record
      Values     : Util.Beans.Objects.Vectors.Vector;
      Row        : Natural;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : in List_Object) return Natural;

   --  Set the current row index.  Valid row indexes start at 1.
   overriding
   procedure Set_Row_Index (From  : in out List_Object;
                            Index : in Natural);

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : in List_Object) return Util.Beans.Objects.Object;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in List_Object;
                       Name : in String) return Util.Beans.Objects.Object;

   type Package_Definition is new Definition with record
      --  Enums defined in the package.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  Hibernate tables
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  Custom queries
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Spec_Types    : aliased List_Object;
      Used_Spec          : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Body_Types    : aliased List_Object;
      Used_Body          : Util.Beans.Objects.Object;

      --  A map of all types defined in this package.
      Types        : Gen.Model.Mappings.Mapping_Maps.Map;

      --  The base name for the package (ex: gen-model-users)
      Base_Name    : Unbounded_String;

      --  The global model (used to resolve types from other packages).
      Model              : Model_Definition_Access;

      --  True if the package uses Ada.Calendar.Time
      Uses_Calendar_Time : Boolean := False;

      --  True if the package is a pre-defined package (ie, defined by a UML profile).
      Is_Predefined      : Boolean := False;
   end record;

   type Model_Definition is new Definition with record
      --  List of all enums.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  List of all tables.
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  List of all queries.
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  Map of all packages.
      Packages     : Package_Map.Map;

      --  Directory associated with the model ('src', 'samples', 'regtests', ...).
      Dir_Name     : Unbounded_String;

      --  Directory that contains the SQL and model files.
      DB_Name      : Unbounded_String;

      --  When not empty, a list of packages that must be taken into account for the generation.
      --  By default all packages and tables defined in the model are generated.
      Gen_Packages : Util.Strings.Sets.Set;
   end record;

end Gen.Model.Packages;

Declare the Iterate_Enums procedure on the model


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

with Ada.Task_Attributes;
with ADO.Databases;

package body AWA.Services.Contexts is

   use type ADO.Databases.Connection_Status;
   use type AWA.Users.Principals.Principal_Access;

   package Task_Context is new Ada.Task_Attributes
     (Service_Context_Access, null);

   --  ------------------------------
   --  Get the application associated with the current service operation.
   --  ------------------------------
   function Get_Application (Ctx : in Service_Context)
                             return AWA.Applications.Application_Access is
   begin
      return Ctx.Application;
   end Get_Application;

   --  ------------------------------
   --  Get the current database connection for reading.
   --  ------------------------------
   function Get_Session (Ctx : in Service_Context_Access) return ADO.Sessions.Session is
   begin
      if Ctx.Slave.Get_Status /= ADO.Databases.OPEN then
         Ctx.Slave  := Ctx.Application.Get_Session;
      end if;
      return Ctx.Slave;
   end Get_Session;

   --  ------------------------------
   --  Get the current database connection for reading and writing.
   --  ------------------------------
   function Get_Master_Session (Ctx : in Service_Context_Access)
                                return ADO.Sessions.Master_Session is
   begin
      if Ctx.Master.Get_Status /= ADO.Databases.OPEN then
         Ctx.Master := Ctx.Application.Get_Master_Session;
--           Ctx.Slave  := Ctx.Master;
      end if;
      return Ctx.Master;
   end Get_Master_Session;

   --  ------------------------------
   --  Get the current user invoking the service operation.
   --  Returns a null user if there is none.
   --  ------------------------------
   function Get_User (Ctx : in Service_Context) return AWA.Users.Models.User_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_User;
      else
         return Ctx.Principal.Get_User;
      end if;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (Ctx : in Service_Context) return ADO.Identifier is
   begin
      if Ctx.Principal = null then
         return ADO.NO_IDENTIFIER;
      else
         return Ctx.Principal.Get_User_Identifier;
      end if;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the current user session from the user invoking the service operation.
   --  Returns a null session if there is none.
   --  ------------------------------
   function Get_User_Session (Ctx : in Service_Context) return AWA.Users.Models.Session_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_Session;
      else
         return Ctx.Principal.Get_Session;
      end if;
   end Get_User_Session;

   --  ------------------------------
   --  Starts a transaction.
   --  ------------------------------
   procedure Start (Ctx : in out Service_Context) is
   begin
      if Ctx.Transaction = 0 and then not Ctx.Active_Transaction then
         Ctx.Master.Begin_Transaction;
         Ctx.Active_Transaction := True;
      end if;
      Ctx.Transaction := Ctx.Transaction + 1;
   end Start;

   --  ------------------------------
   --  Commits the current transaction.  The database transaction is really committed by the
   --  last Commit called.
   --  ------------------------------
   procedure Commit (Ctx : in out Service_Context) is
   begin
      Ctx.Transaction := Ctx.Transaction - 1;
      if Ctx.Transaction = 0 and then Ctx.Active_Transaction then
         Ctx.Master.Commit;
         Ctx.Active_Transaction := False;
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.  The database transaction is rollback at the first
   --  call to Rollback.
   --  ------------------------------
   procedure Rollback (Ctx : in out Service_Context) is
   begin
      null;
   end Rollback;

   --  ------------------------------
   --  Set the current application and user context.
   --  ------------------------------
   procedure Set_Context (Ctx         : in out Service_Context;
                          Application : in AWA.Applications.Application_Access;
                          Principal   : in AWA.Users.Principals.Principal_Access) is
   begin
      Ctx.Application := Application;
      Ctx.Principal   := Principal;
   end Set_Context;

   --  ------------------------------
   --  Initializes the service context.
   --  ------------------------------
   overriding
   procedure Initialize (Ctx : in out Service_Context) is
      use type AWA.Applications.Application_Access;
   begin
      Ctx.Previous := Task_Context.Value;
      Task_Context.Set_Value (Ctx'Unchecked_Access);
      if Ctx.Previous /= null and then Ctx.Application = null then
         Ctx.Application := Ctx.Previous.Application;
      end if;
   end Initialize;

   --  ------------------------------
   --  Finalize the service context, rollback non-committed transaction, releases any object.
   --  ------------------------------
   overriding
   procedure Finalize (Ctx : in out Service_Context) is
   begin
      --  When the service context is released, we must not have any active transaction.
      --  This means we are leaving the service in an abnormal way such as when an
      --  exception is raised.  If this is the case, rollback the transaction.
      if Ctx.Active_Transaction then
         Ctx.Master.Rollback;
      end if;
      Task_Context.Set_Value (Ctx.Previous);
   end Finalize;

   --  ------------------------------
   --  Get the current service context.
   --  Returns null if the current thread is not associated with any service context.
   --  ------------------------------
   function Current return Service_Context_Access is
   begin
      return Task_Context.Value;
   end Current;

end AWA.Services.Contexts;

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

with Ada.Task_Attributes;
with ADO.Databases;

package body AWA.Services.Contexts is

   use type ADO.Databases.Connection_Status;
   use type AWA.Users.Principals.Principal_Access;

   package Task_Context is new Ada.Task_Attributes
     (Service_Context_Access, null);

   --  ------------------------------
   --  Get the application associated with the current service operation.
   --  ------------------------------
   function Get_Application (Ctx : in Service_Context)
                             return AWA.Applications.Application_Access is
   begin
      return Ctx.Application;
   end Get_Application;

   --  ------------------------------
   --  Get the current database connection for reading.
   --  ------------------------------
   function Get_Session (Ctx : in Service_Context_Access) return ADO.Sessions.Session is
   begin
      --  If a master database session was created, use it.
      if Ctx.Master.Get_Status = ADO.Databases.OPEN then
         return ADO.Sessions.Session (Ctx.Master);

      elsif Ctx.Slave.Get_Status /= ADO.Databases.OPEN then
         Ctx.Slave  := Ctx.Application.Get_Session;
      end if;
      return Ctx.Slave;
   end Get_Session;

   --  ------------------------------
   --  Get the current database connection for reading and writing.
   --  ------------------------------
   function Get_Master_Session (Ctx : in Service_Context_Access)
                                return ADO.Sessions.Master_Session is
   begin
      if Ctx.Master.Get_Status /= ADO.Databases.OPEN then
         Ctx.Master := Ctx.Application.Get_Master_Session;
      end if;
      return Ctx.Master;
   end Get_Master_Session;

   --  ------------------------------
   --  Get the current user invoking the service operation.
   --  Returns a null user if there is none.
   --  ------------------------------
   function Get_User (Ctx : in Service_Context) return AWA.Users.Models.User_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_User;
      else
         return Ctx.Principal.Get_User;
      end if;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (Ctx : in Service_Context) return ADO.Identifier is
   begin
      if Ctx.Principal = null then
         return ADO.NO_IDENTIFIER;
      else
         return Ctx.Principal.Get_User_Identifier;
      end if;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the current user session from the user invoking the service operation.
   --  Returns a null session if there is none.
   --  ------------------------------
   function Get_User_Session (Ctx : in Service_Context) return AWA.Users.Models.Session_Ref is
   begin
      if Ctx.Principal = null then
         return AWA.Users.Models.Null_Session;
      else
         return Ctx.Principal.Get_Session;
      end if;
   end Get_User_Session;

   --  ------------------------------
   --  Starts a transaction.
   --  ------------------------------
   procedure Start (Ctx : in out Service_Context) is
   begin
      if Ctx.Transaction = 0 and then not Ctx.Active_Transaction then
         Ctx.Master.Begin_Transaction;
         Ctx.Active_Transaction := True;
      end if;
      Ctx.Transaction := Ctx.Transaction + 1;
   end Start;

   --  ------------------------------
   --  Commits the current transaction.  The database transaction is really committed by the
   --  last Commit called.
   --  ------------------------------
   procedure Commit (Ctx : in out Service_Context) is
   begin
      Ctx.Transaction := Ctx.Transaction - 1;
      if Ctx.Transaction = 0 and then Ctx.Active_Transaction then
         Ctx.Master.Commit;
         Ctx.Active_Transaction := False;
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.  The database transaction is rollback at the first
   --  call to Rollback.
   --  ------------------------------
   procedure Rollback (Ctx : in out Service_Context) is
   begin
      null;
   end Rollback;

   --  ------------------------------
   --  Set the current application and user context.
   --  ------------------------------
   procedure Set_Context (Ctx         : in out Service_Context;
                          Application : in AWA.Applications.Application_Access;
                          Principal   : in AWA.Users.Principals.Principal_Access) is
   begin
      Ctx.Application := Application;
      Ctx.Principal   := Principal;
   end Set_Context;

   --  ------------------------------
   --  Initializes the service context.
   --  ------------------------------
   overriding
   procedure Initialize (Ctx : in out Service_Context) is
      use type AWA.Applications.Application_Access;
   begin
      Ctx.Previous := Task_Context.Value;
      Task_Context.Set_Value (Ctx'Unchecked_Access);
      if Ctx.Previous /= null and then Ctx.Application = null then
         Ctx.Application := Ctx.Previous.Application;
      end if;
   end Initialize;

   --  ------------------------------
   --  Finalize the service context, rollback non-committed transaction, releases any object.
   --  ------------------------------
   overriding
   procedure Finalize (Ctx : in out Service_Context) is
   begin
      --  When the service context is released, we must not have any active transaction.
      --  This means we are leaving the service in an abnormal way such as when an
      --  exception is raised.  If this is the case, rollback the transaction.
      if Ctx.Active_Transaction then
         Ctx.Master.Rollback;
      end if;
      Task_Context.Set_Value (Ctx.Previous);
   end Finalize;

   --  ------------------------------
   --  Get the current service context.
   --  Returns null if the current thread is not associated with any service context.
   --  ------------------------------
   function Current return Service_Context_Access is
   begin
      return Task_Context.Value;
   end Current;

end AWA.Services.Contexts;

Fix Get_Session to return the master session if such session was created.


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

--  === Encoder and Decoders ===
--  The Util.Encoders package defines the Encoder and Decode objects
--  which provide a mechanism to transform a stream from one format into
--  another format.
--
--  ==== Simple encoding and decoding ====
--
package Util.Encoders is

   pragma Preelaborate;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;
   function Encode_Binary (E    : in Encoder;
                           Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : in String) return Encoder;

   type Decoder is tagged limited private;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Decoder;
                    Data : in String) return String;
   function Decode_Binary (E    : in Decoder;
                           Data : in String) return Ada.Streams.Stream_Element_Array;

   --  Create the decoder object for the specified encoding format.
   function Create (Name : in String) return Decoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input array represented by Data into
   --  the output array Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, encryption, compression, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data array.
   --
   --  The transformer returns in Last the last valid position
   --  in the output array Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  array cannot be transformed.
   procedure Transform (E       : in out Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Finish encoding the input array.
   procedure Finish (E    : in out Transformer;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) is null;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array)
                       return Ada.Streams.Stream_Element_Array;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset);

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private

   --  Transform the input data into the target string.
   procedure Convert (E    : in out Transformer'Class;
                      Data : in Ada.Streams.Stream_Element_Array;
                      Into : out String);

   type Encoder is new Ada.Finalization.Limited_Controlled with record
      Encode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

   type Decoder is new Ada.Finalization.Limited_Controlled with record
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Decoder);

end Util.Encoders;

-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2012, 2016, 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 Ada.Streams;
with Ada.Finalization;
with Interfaces;

--  === Encoder and Decoders ===
--  The Util.Encoders package defines the Encoder and Decode objects
--  which provide a mechanism to transform a stream from one format into
--  another format.
--
--  ==== Simple encoding and decoding ====
--
package Util.Encoders is

   pragma Preelaborate;

   use Ada.Streams;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Secret key
   --  ------------------------------
   --  A secret key of the given length, it cannot be copied and is safely erased.
   subtype Key_Length is Stream_Element_Offset range 1 .. Stream_Element_Offset'Last;

   type Secret_Key (Length : Key_Length) is limited private;

   --  Create the secret key from the password string.
   function Create (Password : in String) return Secret_Key
     with Pre => Password'Length > 0, Post => Create'Result.Length = Password'Length;

   procedure Create (Password : in String;
                     Key      : out Secret_Key)
     with Pre => Password'Length > 0, Post => Key.Length = Password'Length;

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;
   function Encode_Binary (E    : in Encoder;
                           Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : in String) return Encoder;

   type Decoder is tagged limited private;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Decoder;
                    Data : in String) return String;
   function Decode_Binary (E    : in Decoder;
                           Data : in String) return Ada.Streams.Stream_Element_Array;

   --  Create the decoder object for the specified encoding format.
   function Create (Name : in String) return Decoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input array represented by Data into
   --  the output array Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, encryption, compression, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data array.
   --
   --  The transformer returns in Last the last valid position
   --  in the output array Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  array cannot be transformed.
   procedure Transform (E       : in out Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Finish encoding the input array.
   procedure Finish (E    : in out Transformer;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) is null;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;
   function Transform (E    : in out Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array)
                       return Ada.Streams.Stream_Element_Array;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset);

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private
   use Ada.Finalization;

   type Secret_Key (Length : Key_Length) is limited new Limited_Controlled with record
      Secret : Ada.Streams.Stream_Element_Array (1 .. Length) := (others => 0);
   end record;

   overriding
   procedure Finalize (Object : in out Secret_Key);

   --  Transform the input data into the target string.
   procedure Convert (E    : in out Transformer'Class;
                      Data : in Ada.Streams.Stream_Element_Array;
                      Into : out String);

   type Encoder is limited new Limited_Controlled with record
      Encode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

   type Decoder is limited new Limited_Controlled with record
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Decoder);

end Util.Encoders;

Declare Secret_Key type to hold a secret key and erase memory when it is removed


-----------------------------------------------------------------------
--  util-http-clients -- HTTP Clients
--  Copyright (C) 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.Unchecked_Deallocation;
with Util.Log.Loggers;
package body Util.Http.Clients is

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients");

   procedure Initialize (Form : in out Form_Data;
                         Size : in Positive) is
   begin
      Form.Buffer.Initialize (Output => null,
                              Size   => Size);
      Form.Initialize (Form.Buffer'Unchecked_Access);
   end Initialize;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   overriding
   function Contains_Header (Reply : in Response;
                             Name  : in String) return Boolean is
   begin
      if Reply.Delegate = null then
         return False;
      else
         return Reply.Delegate.Contains_Header (Name);
      end if;
   end Contains_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   overriding
   function Get_Header (Reply  : in Response;
                        Name   : in String) return String is
   begin
      if Reply.Delegate = null then
         return "";
      else
         return Reply.Delegate.Get_Header (Name);
      end if;
   end Get_Header;

   --  ------------------------------
   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   overriding
   procedure Set_Header (Reply    : in out Response;
                         Name     : in String;
                         Value    : in String) is
   begin
      Reply.Delegate.Set_Header (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   --  ------------------------------
   overriding
   procedure Add_Header (Reply   : in out Response;
                         Name    : in String;
                         Value   : in String) is
   begin
      Reply.Delegate.Add_Header (Name, Value);
   end Add_Header;

   --  ------------------------------
   --  Iterate over the response headers and executes the Process procedure.
   --  ------------------------------
   overriding
   procedure Iterate_Headers (Reply   : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      if Reply.Delegate /= null then
         Reply.Delegate.Iterate_Headers (Process);
      end if;
   end Iterate_Headers;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Response) return String is
   begin
      if Reply.Delegate = null then
         return "";
      else
         return Reply.Delegate.Get_Body;
      end if;
   end Get_Body;

   --  ------------------------------
   --  Get the response status code.
   --  ------------------------------
   function Get_Status (Reply : in Response) return Natural is
   begin
      return Reply.Delegate.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   overriding
   function Contains_Header (Request : in Client;
                             Name    : in String) return Boolean is
   begin
      if Request.Delegate = null then
         return False;
      else
         return Request.Delegate.Contains_Header (Name);
      end if;
   end Contains_Header;

   --  ------------------------------
   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   overriding
   function Get_Header (Request : in Client;
                        Name    : in String) return String is
   begin
      if Request.Delegate = null then
         return "";
      else
         return Request.Delegate.Get_Header (Name);
      end if;
   end Get_Header;

   --  ------------------------------
   --  Sets a header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   overriding
   procedure Set_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String) is
   begin
      Request.Delegate.Set_Header (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a header with the given name and value.
   --  This method allows headers to have multiple values.
   --  ------------------------------
   overriding
   procedure Add_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String) is
   begin
      Request.Delegate.Add_Header (Name, Value);
   end Add_Header;

   --  ------------------------------
   --  Iterate over the request headers and executes the Process procedure.
   --  ------------------------------
   overriding
   procedure Iterate_Headers (Request : in Client;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      Request.Delegate.Iterate_Headers (Process);
   end Iterate_Headers;

   --  ------------------------------
   --  Removes all headers with the given name.
   --  ------------------------------
   procedure Remove_Header (Request : in out Client;
                            Name    : in String) is
   begin
      null;
   end Remove_Header;

   --  ------------------------------
   --  Initialize the client
   --  ------------------------------
   overriding
   procedure Initialize (Http : in out Client) is
   begin
      Http.Delegate := null;
      Http.Manager  := Default_Http_Manager;
      if Http.Manager = null then
         Log.Error ("No HTTP manager was defined");
         raise Program_Error with "No HTTP manager was defined.";
      end if;
      Http.Manager.Create (Http);
   end Initialize;

   overriding
   procedure Finalize (Http : in out Client) is
      procedure Free is new Ada.Unchecked_Deallocation (Http_Request'Class,
                                                        Http_Request_Access);
   begin
      Free (Http.Delegate);
   end Finalize;

   --  ------------------------------
   --  Execute an http GET request on the given URL.  Additional request parameters,
   --  cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Get (Request  : in out Client;
                  URL      : in String;
                  Reply    : out Response'Class) is
   begin
      Request.Manager.Do_Get (Request, URL, Reply);
   end Get;

   --  ------------------------------
   --  Execute an http POST request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Post (Request : in out Client;
                   URL     : in String;
                   Data    : in String;
                   Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Post (Request, URL, Data, Reply);
   end Post;

   procedure Post (Request : in out Client;
                   URL     : in String;
                   Data    : in Form_Data'Class;
                   Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Post (Request, URL, Util.Streams.Texts.To_String (Data.Buffer), Reply);
   end Post;

   --  ------------------------------
   --  Execute an http PUT request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Put (Request : in out Client;
                  URL     : in String;
                  Data    : in String;
                  Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Put (Request, URL, Data, Reply);
   end Put;

   --  ------------------------------
   --  Execute a http DELETE request on the given URL.
   --  ------------------------------
   procedure Delete (Request : in out Client;
                     URL     : in String;
                     Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Delete (Request, URL, Reply);
   end Delete;

   --  ------------------------------
   --  Set the timeout for the connection.
   --  ------------------------------
   procedure Set_Timeout (Request : in out Client;
                          Timeout : in Duration) is
   begin
      Request.Manager.Set_Timeout (Request, Timeout);
   end Set_Timeout;

   --  ------------------------------
   --  Adds the specified cookie to the request. This method can be called multiple
   --  times to set more than one cookie.
   --  ------------------------------
   procedure Add_Cookie (Http   : in out Client;
                         Cookie : in Util.Http.Cookies.Cookie) is
   begin
      null;
   end Add_Cookie;

   --  ------------------------------
   --  Free the resource used by the response.
   --  ------------------------------
   overriding
   procedure Finalize (Reply : in out Response) is
      procedure Free is new Ada.Unchecked_Deallocation (Http_Response'Class,
                                                        Http_Response_Access);
   begin
      Free (Reply.Delegate);
   end Finalize;

end Util.Http.Clients;

-----------------------------------------------------------------------
--  util-http-clients -- HTTP Clients
--  Copyright (C) 2011, 2012, 2013, 2017, 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.Unchecked_Deallocation;
with Util.Log.Loggers;
package body Util.Http.Clients is

   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients");

   procedure Initialize (Form : in out Form_Data;
                         Size : in Positive) is
   begin
      Form.Buffer.Initialize (Output => null,
                              Size   => Size);
      Form.Initialize (Form.Buffer'Unchecked_Access);
   end Initialize;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   overriding
   function Contains_Header (Reply : in Response;
                             Name  : in String) return Boolean is
   begin
      if Reply.Delegate = null then
         return False;
      else
         return Reply.Delegate.Contains_Header (Name);
      end if;
   end Contains_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   overriding
   function Get_Header (Reply  : in Response;
                        Name   : in String) return String is
   begin
      if Reply.Delegate = null then
         return "";
      else
         return Reply.Delegate.Get_Header (Name);
      end if;
   end Get_Header;

   --  ------------------------------
   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   overriding
   procedure Set_Header (Reply    : in out Response;
                         Name     : in String;
                         Value    : in String) is
   begin
      Reply.Delegate.Set_Header (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   --  ------------------------------
   overriding
   procedure Add_Header (Reply   : in out Response;
                         Name    : in String;
                         Value   : in String) is
   begin
      Reply.Delegate.Add_Header (Name, Value);
   end Add_Header;

   --  ------------------------------
   --  Iterate over the response headers and executes the Process procedure.
   --  ------------------------------
   overriding
   procedure Iterate_Headers (Reply   : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      if Reply.Delegate /= null then
         Reply.Delegate.Iterate_Headers (Process);
      end if;
   end Iterate_Headers;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Response) return String is
   begin
      if Reply.Delegate = null then
         return "";
      else
         return Reply.Delegate.Get_Body;
      end if;
   end Get_Body;

   --  ------------------------------
   --  Get the response status code.
   --  ------------------------------
   function Get_Status (Reply : in Response) return Natural is
   begin
      return Reply.Delegate.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   overriding
   function Contains_Header (Request : in Client;
                             Name    : in String) return Boolean is
   begin
      if Request.Delegate = null then
         return False;
      else
         return Request.Delegate.Contains_Header (Name);
      end if;
   end Contains_Header;

   --  ------------------------------
   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   overriding
   function Get_Header (Request : in Client;
                        Name    : in String) return String is
   begin
      if Request.Delegate = null then
         return "";
      else
         return Request.Delegate.Get_Header (Name);
      end if;
   end Get_Header;

   --  ------------------------------
   --  Sets a header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   overriding
   procedure Set_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String) is
   begin
      Request.Delegate.Set_Header (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a header with the given name and value.
   --  This method allows headers to have multiple values.
   --  ------------------------------
   overriding
   procedure Add_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String) is
   begin
      Request.Delegate.Add_Header (Name, Value);
   end Add_Header;

   --  ------------------------------
   --  Iterate over the request headers and executes the Process procedure.
   --  ------------------------------
   overriding
   procedure Iterate_Headers (Request : in Client;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is
   begin
      Request.Delegate.Iterate_Headers (Process);
   end Iterate_Headers;

   --  ------------------------------
   --  Removes all headers with the given name.
   --  ------------------------------
   procedure Remove_Header (Request : in out Client;
                            Name    : in String) is
   begin
      null;
   end Remove_Header;

   --  ------------------------------
   --  Initialize the client
   --  ------------------------------
   overriding
   procedure Initialize (Http : in out Client) is
   begin
      Http.Delegate := null;
      Http.Manager  := Default_Http_Manager;
      if Http.Manager = null then
         Log.Error ("No HTTP manager was defined");
         raise Program_Error with "No HTTP manager was defined.";
      end if;
      Http.Manager.Create (Http);
   end Initialize;

   overriding
   procedure Finalize (Http : in out Client) is
      procedure Free is new Ada.Unchecked_Deallocation (Http_Request'Class,
                                                        Http_Request_Access);
   begin
      Free (Http.Delegate);
   end Finalize;

   --  ------------------------------
   --  Execute an http GET request on the given URL.  Additional request parameters,
   --  cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Get (Request  : in out Client;
                  URL      : in String;
                  Reply    : out Response'Class) is
   begin
      Request.Manager.Do_Get (Request, URL, Reply);
   end Get;

   --  ------------------------------
   --  Execute an http POST request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Post (Request : in out Client;
                   URL     : in String;
                   Data    : in String;
                   Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Post (Request, URL, Data, Reply);
   end Post;

   procedure Post (Request : in out Client;
                   URL     : in String;
                   Data    : in Form_Data'Class;
                   Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Post (Request, URL, Util.Streams.Texts.To_String (Data.Buffer), Reply);
   end Post;

   --  ------------------------------
   --  Execute an http PUT request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Put (Request : in out Client;
                  URL     : in String;
                  Data    : in String;
                  Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Put (Request, URL, Data, Reply);
   end Put;

   --  ------------------------------
   --  Execute an http PATCH request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Patch (Request : in out Client;
                    URL     : in String;
                    Data    : in String;
                    Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Patch (Request, URL, Data, Reply);
   end Patch;

   --  ------------------------------
   --  Execute a http DELETE request on the given URL.
   --  ------------------------------
   procedure Delete (Request : in out Client;
                     URL     : in String;
                     Reply   : out Response'Class) is
   begin
      Request.Manager.Do_Delete (Request, URL, Reply);
   end Delete;

   --  ------------------------------
   --  Execute an http HEAD request on the given URL.  Additional request parameters,
   --  cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Head (Request  : in out Client;
                   URL      : in String;
                   Reply    : out Response'Class) is
   begin
      Request.Manager.Do_Head (Request, URL, Reply);
   end Head;

   --  ------------------------------
   --  Execute an http OPTIONS request on the given URL.  Additional request parameters,
   --  cookies and headers should have been set on the client object.
   --  ------------------------------
   procedure Options (Request  : in out Client;
                      URL      : in String;
                      Reply    : out Response'Class) is
   begin
      Request.Manager.Do_Options (Request, URL, Reply);
   end Options;

   --  ------------------------------
   --  Set the timeout for the connection.
   --  ------------------------------
   procedure Set_Timeout (Request : in out Client;
                          Timeout : in Duration) is
   begin
      Request.Manager.Set_Timeout (Request, Timeout);
   end Set_Timeout;

   --  ------------------------------
   --  Adds the specified cookie to the request. This method can be called multiple
   --  times to set more than one cookie.
   --  ------------------------------
   procedure Add_Cookie (Http   : in out Client;
                         Cookie : in Util.Http.Cookies.Cookie) is
   begin
      null;
   end Add_Cookie;

   --  ------------------------------
   --  Free the resource used by the response.
   --  ------------------------------
   overriding
   procedure Finalize (Reply : in out Response) is
      procedure Free is new Ada.Unchecked_Deallocation (Http_Response'Class,
                                                        Http_Response_Access);
   begin
      Free (Reply.Delegate);
   end Finalize;

end Util.Http.Clients;

Implement operations to support HTTP Head, Patch, Options