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

with Util.Strings;
with Util.Log.Loggers;
with Util.Http.Clients.Curl.Constants;
package body Util.Http.Clients.Curl is

   use System;

   pragma Linker_Options ("-lcurl");

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

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access;

   PUT_TOKEN : Chars_Ptr := Strings.New_String ("PUT");
   Manager   : aliased Curl_Http_Manager;

   --  ------------------------------
   --  Register the CURL Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   --  ------------------------------
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String) is
   begin
      if Code /= CURLE_OK then
         declare
            Error : constant Chars_Ptr := Curl_Easy_Strerror (Code);
            Msg   : constant String := Interfaces.C.Strings.Value (Error);
         begin
            Log.Error ("{0}: {1}", Message, Msg);
            raise Connection_Error with Msg;
         end;
      end if;
   end Check_Code;

   --  ------------------------------
   --  Create a new HTTP request associated with the current request manager.
   --  ------------------------------
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);

      Request : Curl_Http_Request_Access;
      Data    : CURL;
   begin
      Data := Curl_Easy_Init;
      if Data = System.Null_Address then
         raise Storage_Error with "curl_easy_init cannot create the CURL instance";
      end if;
      Request := new Curl_Http_Request;
      Request.Data  := Data;
      Http.Delegate := Request.all'Access;
   end Create;

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access is
   begin
      return Curl_Http_Request'Class (Http.Delegate.all)'Access;
   end Get_Request;

   --  ------------------------------
   --  This function is called by CURL when a response line was read.
   --  ------------------------------
   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T is

      Total : constant Size_T := Size * Nmemb;
      Line  : constant String := Interfaces.C.Strings.Value (Data, Total);
   begin
      Log.Info ("RCV: {0}", Line);
      if Response.Parsing_Body then
         Ada.Strings.Unbounded.Append (Response.Content, Line);

      elsif Total = 2 and then Line (1) = ASCII.CR and then Line (2) = ASCII.LF then
         Response.Parsing_Body := True;

      else
         declare
            Pos   : constant Natural := Util.Strings.Index (Line, ':');
            Start : Natural;
            Last  : Natural;
         begin
            if Pos > 0 then
               Start := Pos + 1;
               while Start <= Line'Last and Line (Start) = ' ' loop
                  Start := Start + 1;
               end loop;
               Last := Line'Last;
               while Last >= Start and (Line (Last) = ASCII.CR or Line (Last) = ASCII.LF) loop
                  Last := Last - 1;
               end loop;
               Response.Add_Header (Name  => Line (Line'First .. Pos - 1),
                                    Value => Line (Start .. Last));
            end if;
         end;
      end if;
      return Total;
   end Read_Response;

   --  ------------------------------
   --  Prepare to setup the headers in the request.
   --  ------------------------------
   procedure Set_Headers (Request : in out Curl_Http_Request) is

      procedure Process (Name, Value : in String) is
         S : Chars_Ptr := Strings.New_String (Name & ": " & Value);
      begin
         Request.Curl_Headers := Curl_Slist_Append (Request.Curl_Headers, S);
         Interfaces.C.Strings.Free (S);
      end Process;

   begin
      if Request.Curl_Headers /= null then
         Curl_Slist_Free_All (Request.Curl_Headers);
         Request.Curl_Headers := null;
      end if;

      Request.Iterate_Headers (Process'Access);
   end Set_Headers;

   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("GET {0}", URI);
      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HTTPGET, 1);
      Check_Code (Result, "set http GET");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Get;

   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("POST {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");
      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POST, 1);
      Check_Code (Result, "set http POST");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Post;

   overriding
   procedure Do_Put (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("PUT {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");
      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POST, 1);
      Check_Code (Result, "set http PUT");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_CUSTOMREQUEST, PUT_TOKEN);
      Check_Code (Result, "set http PUT");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Put;

   overriding
   procedure Finalize (Request : in out Curl_Http_Request) is
   begin
      if Request.Data /= System.Null_Address then
         Curl_Easy_Cleanup (Request.Data);
         Request.Data := System.Null_Address;
      end if;
      if Request.Curl_Headers /= null then
         Curl_Slist_Free_All (Request.Curl_Headers);
         Request.Curl_Headers := null;
      end if;
      Interfaces.C.Strings.Free (Request.URL);
      Interfaces.C.Strings.Free (Request.Content);
   end Finalize;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Reply.Content);
   end Get_Body;

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

end Util.Http.Clients.Curl;

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

with Util.Strings;
with Util.Log.Loggers;
with Util.Http.Clients.Curl.Constants;
package body Util.Http.Clients.Curl is

   use System;

   pragma Linker_Options ("-lcurl");

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

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access;

   PUT_TOKEN : Chars_Ptr := Strings.New_String ("PUT");
   Manager   : aliased Curl_Http_Manager;

   --  ------------------------------
   --  Register the CURL Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Check the CURL result code and report and exception and a log message if
   --  the CURL code indicates an error.
   --  ------------------------------
   procedure Check_Code (Code    : in CURL_Code;
                         Message : in String) is
   begin
      if Code /= CURLE_OK then
         declare
            Error : constant Chars_Ptr := Curl_Easy_Strerror (Code);
            Msg   : constant String := Interfaces.C.Strings.Value (Error);
         begin
            Log.Error ("{0}: {1}", Message, Msg);
            raise Connection_Error with Msg;
         end;
      end if;
   end Check_Code;

   --  ------------------------------
   --  Create a new HTTP request associated with the current request manager.
   --  ------------------------------
   procedure Create (Manager  : in Curl_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);

      Request : Curl_Http_Request_Access;
      Data    : CURL;
   begin
      Data := Curl_Easy_Init;
      if Data = System.Null_Address then
         raise Storage_Error with "curl_easy_init cannot create the CURL instance";
      end if;
      Request := new Curl_Http_Request;
      Request.Data  := Data;
      Http.Delegate := Request.all'Access;
   end Create;

   function Get_Request (Http : in Client'Class) return Curl_Http_Request_Access is
   begin
      return Curl_Http_Request'Class (Http.Delegate.all)'Access;
   end Get_Request;

   --  ------------------------------
   --  This function is called by CURL when a response line was read.
   --  ------------------------------
   function Read_Response (Data     : in Chars_Ptr;
                           Size     : in Size_T;
                           Nmemb    : in Size_T;
                           Response : in Curl_Http_Response_Access) return Size_T is

      Total : constant Size_T := Size * Nmemb;
      Line  : constant String := Interfaces.C.Strings.Value (Data, Total);
   begin
      Log.Info ("RCV: {0}", Line);
      if Response.Parsing_Body then
         Ada.Strings.Unbounded.Append (Response.Content, Line);

      elsif Total = 2 and then Line (1) = ASCII.CR and then Line (2) = ASCII.LF then
         Response.Parsing_Body := True;

      else
         declare
            Pos   : constant Natural := Util.Strings.Index (Line, ':');
            Start : Natural;
            Last  : Natural;
         begin
            if Pos > 0 then
               Start := Pos + 1;
               while Start <= Line'Last and Line (Start) = ' ' loop
                  Start := Start + 1;
               end loop;
               Last := Line'Last;
               while Last >= Start and (Line (Last) = ASCII.CR or Line (Last) = ASCII.LF) loop
                  Last := Last - 1;
               end loop;
               Response.Add_Header (Name  => Line (Line'First .. Pos - 1),
                                    Value => Line (Start .. Last));
            end if;
         end;
      end if;
      return Total;
   end Read_Response;

   --  ------------------------------
   --  Prepare to setup the headers in the request.
   --  ------------------------------
   procedure Set_Headers (Request : in out Curl_Http_Request) is

      procedure Process (Name, Value : in String) is
         S : Chars_Ptr := Strings.New_String (Name & ": " & Value);
      begin
         Request.Curl_Headers := Curl_Slist_Append (Request.Curl_Headers, S);
         Interfaces.C.Strings.Free (S);
      end Process;

   begin
      if Request.Curl_Headers /= null then
         Curl_Slist_Free_All (Request.Curl_Headers);
         Request.Curl_Headers := null;
      end if;

      Request.Iterate_Headers (Process'Access);
   end Set_Headers;

   procedure Do_Get (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("GET {0}", URI);
      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");

      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HTTPGET, 1);
      Check_Code (Result, "set http GET");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Get;

   procedure Do_Post (Manager  : in Curl_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("POST {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");
      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POST, 1);
      Check_Code (Result, "set http POST");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Post;

   overriding
   procedure Do_Put (Manager  : in Curl_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Manager);
      use Interfaces.C;

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Result   : CURL_Code;
      Response : Curl_Http_Response_Access;
      Status   : aliased C.long;
   begin
      Log.Info ("PUT {0}", URI);

      Result := Curl_Easy_Setopt_Write_Callback (Req.Data, Constants.CURLOPT_WRITEUNCTION,
                                                 Read_Response'Access);
      Check_Code (Result, "set callback");
      Req.Set_Headers;

      Interfaces.C.Strings.Free (Req.URL);
      Req.URL := Strings.New_String (URI);

      Interfaces.C.Strings.Free (Req.Content);
      Req.Content := Strings.New_String (Data);

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POST, 1);
      Check_Code (Result, "set http PUT");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_HEADER, 1);
      Check_Code (Result, "set header");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_CUSTOMREQUEST, PUT_TOKEN);
      Check_Code (Result, "set http PUT");

      Result := Curl_Easy_Setopt_Slist (Req.Data, Constants.CURLOPT_HTTPHEADER, Req.Curl_Headers);
      Check_Code (Result, "set http GET headers");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_URL, Req.URL);
      Check_Code (Result, "set url");

      Result := Curl_Easy_Setopt_String (Req.Data, Constants.CURLOPT_POSTFIELDS, Req.Content);
      Check_Code (Result, "set post data");

      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_POSTFIELDSIZE, Data'Length);
      Check_Code (Result, "set post data");

      Response := new Curl_Http_Response;
      Result := Curl_Easy_Setopt_Data (Req.Data, Constants.CURLOPT_WRITEDATA, Response);
      Check_Code (Result, "set write data");
      Reply.Delegate := Response.all'Access;

      Result := Curl_Easy_Perform (Req.Data);
      Check_Code (Result, "get request");

      Result := Curl_Easy_Getinfo_Long (Req.Data, Constants.CURLINFO_RESPONSE_CODE, Status'Access);
      Check_Code (Result, "get response code");
      Response.Status := Natural (Status);
   end Do_Put;

   --  ------------------------------
   --  Set the timeout for the connection.
   --  ------------------------------
   overriding
   procedure Set_Timeout (Manager : in Curl_Http_Manager;
                          Http    : in Client'Class;
                          Timeout : in Duration) is
      pragma Unreferenced (Manager);

      Req      : constant Curl_Http_Request_Access := Get_Request (Http);
      Time     : constant Interfaces.C.long := Interfaces.C.long (Timeout);
      Result   : CURL_Code;
   begin
      Result := Curl_Easy_Setopt_Long (Req.Data, Constants.CURLOPT_TIMEOUT, Time);
      Check_Code (Result, "set timeout");
   end Set_Timeout;

   overriding
   procedure Finalize (Request : in out Curl_Http_Request) is
   begin
      if Request.Data /= System.Null_Address then
         Curl_Easy_Cleanup (Request.Data);
         Request.Data := System.Null_Address;
      end if;
      if Request.Curl_Headers /= null then
         Curl_Slist_Free_All (Request.Curl_Headers);
         Request.Curl_Headers := null;
      end if;
      Interfaces.C.Strings.Free (Request.URL);
      Interfaces.C.Strings.Free (Request.Content);
   end Finalize;

   --  ------------------------------
   --  Get the response body as a string.
   --  ------------------------------
   overriding
   function Get_Body (Reply : in Curl_Http_Response) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Reply.Content);
   end Get_Body;

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

end Util.Http.Clients.Curl;

Implement the Set_Timeout procedure

Implement the Set_Timeout procedure


-----------------------------------------------------------------------
--  asf-converters -- ASF Converters
--  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 EL.Objects;
--  with ASF.Components;
--  with ASF.Contexts.Faces;

--  The ASF.Converters defines an interface used by the conversion model
--  to translate an object into a string when formatting the response and translate
--  a string into an object during the apply request or validation phases (JSF postback).
--
--  See JSR 314 - JavaServer Faces Specification 3.3.2 Converter
--  (To_String is the JSF getAsString method and To_Object is the JSF getAsObject method)
package ASF.Converters.Numbers is

   Invalid_Conversion : exception;

   --  ------------------------------
   --  Converter
   --  ------------------------------
   --  The Object_Converter is a must implement two functions to convert a string into
   --  an object and the opposite.  The converter instance must be registered in
   --  the component factory (See ASF.Factory.Component_Factory).
   --  Unlike the Java implementation, the instance will be shared by multiple
   --  views and requests.
   type Object_Converter is abstract new Converter with null record;

   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
--     overriding
--     function To_String (Convert   : in Object_Converter;
--                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
--                         Component : in ASF.Components.UIComponent'Class;
--                         Value     : in EL.Objects.Object) return String;

   --  Convert the string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
--     overriding
--     function To_Object (Convert   : in Object_Converter;
--                         Context   : in ASF.Contexts.Faces.Faces_Context'Class;
--                         Component : in ASF.Components.UIComponent'Class;
--                         Value     : in String) return EL.Objects.Object;

end ASF.Converters.Numbers;

-----------------------------------------------------------------------
--  asf-converters-numbers -- Floating point number converters
--  Copyright (C) 2010, 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 EL.Objects;
with ASF.Components;
with ASF.Contexts.Faces;
with ASF.Locales;
private with Util.Locales;
private with Ada.Text_IO.Editing;

--  The `ASF.Converters.Numbers` provides a floating point number converter.
--  It can be used to print floating point numbers in various formats.
package ASF.Converters.Numbers is

   type Number_Converter is new Converter with private;
   type Number_Converter_Access is access all Number_Converter'Class;

   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   overriding
   function To_String (Convert   : in Number_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in EL.Objects.Object) return String;

   --  Convert the string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   overriding
   function To_Object (Convert   : in Number_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return EL.Objects.Object;

   --  Set the picture that must be used for the conversion.
   procedure Set_Picture (Converter : in out Number_Converter;
                          Picture   : in String);

   --  Get the currency to be used from the resource bundle in the user's current locale.
   function Get_Currency (Converter : in Number_Converter;
                          Bundle    : in ASF.Locales.Bundle) return String;

   --  Get the separator to be used from the resource bundle in the user's current locale.
   function Get_Separator (Converter : in Number_Converter;
                           Bundle    : in ASF.Locales.Bundle) return Character;

   --  Get the radix mark to be used from the resource bundle in the user's current locale.
   function Get_Radix_Mark (Converter : in Number_Converter;
                            Bundle    : in ASF.Locales.Bundle) return Character;

   --  Get the fill character to be used from the resource bundle in the user's current locale.
   function Get_Fill (Converter : in Number_Converter;
                      Bundle    : in ASF.Locales.Bundle) return Character;

private

   type Number_Converter is new Converter with record
      Picture         : Ada.Text_IO.Editing.Picture;
      Locale          : Util.Locales.Locale;
      Depend_On_Local : Boolean := False;
   end record;

   --  Get the locale that must be used to format the number.
   function Get_Locale (Convert   : in Number_Converter;
                        Context   : in ASF.Contexts.Faces.Faces_Context'Class)
                        return Util.Locales.Locale;

end ASF.Converters.Numbers;

Declare Number_Converter type with operations to convert a floating point number


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

with AWA.Modules.Get;
with Util.Log.Loggers;
package body AWA.Changelogs.Modules is

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

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

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

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the changelogs module.
   --  ------------------------------
   function Get_Changelog_Module return Changelog_Module_Access is
      function Get is new AWA.Modules.Get (Changelog_Module, Changelog_Module_Access, NAME);
   begin
      return Get;
   end Get_Changelog_Module;

end AWA.Changelogs.Modules;

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

with Util.Log.Loggers;

with AWA.Modules.Get;
with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Changelogs.Models;

with ADO.Sessions;
with ADO.Sessions.Entities;
package body AWA.Changelogs.Modules is

   package ASC renames AWA.Services.Contexts;

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

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

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

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the changelogs module.
   --  ------------------------------
   function Get_Changelog_Module return Changelog_Module_Access is
      function Get is new AWA.Modules.Get (Changelog_Module, Changelog_Module_Access, NAME);
   begin
      return Get;
   end Get_Changelog_Module;

   --  ------------------------------
   --  Add the log message and associate it with the database entity identified by
   --  the given id and the entity type.  The log message is associated with the current user.
   --  ------------------------------
   procedure Add_Log (Model       : in Changelog_Module;
                      Id          : in ADO.Identifier;
                      Entity_Type : in String;
                      Message     : in String) is
      pragma Unreferenced (Model);

      Ctx     : constant ASC.Service_Context_Access := ASC.Current;
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Kind    : ADO.Entity_Type;
      History : AWA.Changelogs.Models.Changelog_Ref;
   begin
      Ctx.Start;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type);
      History.Set_For_Entity_Id (Id);
      History.Set_User (User);
      History.Set_Date (Ada.Calendar.Clock);
      History.Set_Entity_Type (Kind);
      History.Set_Text (Message);
      History.Save (DB);
      DB.Commit;
   end Add_Log;

end AWA.Changelogs.Modules;

Implement the Add_Log operation

Implement the Add_Log operation


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

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

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

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

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

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

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

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

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

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

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

private

   protected type Memory_Allocator is

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

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

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

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

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

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

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

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

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

end MAT.Memory.Targets;

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

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

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

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

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

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

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

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

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

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map);

private

   protected type Memory_Allocator is

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

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

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

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

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

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map);

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

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

end MAT.Memory.Targets;

Add the filter parameter to the Find operation


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

--  The Util.Encodes.Base64 packages encodes and decodes streams
--  in Base64 (See rfc4648: The Base16, Base32, and Base64 Data Encodings).
package Util.Encoders.Base64 is

   pragma Preelaborate;

   --  Encode the 64-bit value to LEB128 and then base64url.
   function Encode (Value : in Interfaces.Unsigned_64) return String;

   --  Decode the base64url string and then the LEB128 integer.
   --  Raise the Encoding_Error if the string is invalid and cannot be decoded.
   function Decode (Value : in String) return Interfaces.Unsigned_64;

   --  ------------------------------
   --  Base64 encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  a Base64 ascii stream.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  the a base64 output stream Into.
   --
   --  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 stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Encoder;
                        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);

   --  Set the encoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   procedure Set_URL_Mode (E    : in out Encoder;
                           Mode : in Boolean);

   --  Create a base64 encoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   function Create_URL_Encoder return Transformer_Access;

   --  ------------------------------
   --  Base64 decoder
   --  ------------------------------
   --  The Decoder decodes a Base64 ascii stream into a binary stream.
   type Decoder is new Util.Encoders.Transformer with private;

   --  Decodes the base64 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  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 stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in Decoder;
                        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);

   --  Set the decoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   procedure Set_URL_Mode (E    : in out Decoder;
                           Mode : in Boolean);

   --  Create a base64 decoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   function Create_URL_Decoder return Transformer_Access;

private

   type Alphabet is
     array (Interfaces.Unsigned_8 range 0 .. 63) of Ada.Streams.Stream_Element;

   type Alphabet_Access is not null access constant Alphabet;

   BASE64_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('+'), Character'Pos ('/'));

   BASE64_URL_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('-'), Character'Pos ('_'));

   type Encoder is new Util.Encoders.Transformer with record
      Alphabet : Alphabet_Access := BASE64_ALPHABET'Access;
   end record;

   type Alphabet_Values is array (Ada.Streams.Stream_Element) of Interfaces.Unsigned_8;
   type Alphabet_Values_Access is not null access constant Alphabet_Values;

   BASE64_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 36, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('+') => 62, Character'Pos ('/') => 63,
     others => 16#FF#);

   BASE64_URL_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 36, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('-') => 62, Character'Pos ('_') => 63,
      others => 16#FF#);

   type Decoder is new Util.Encoders.Transformer with record
      Values : Alphabet_Values_Access := BASE64_VALUES'Access;
   end record;

end Util.Encoders.Base64;

-----------------------------------------------------------------------
--  util-encoders-base64 -- Encode/Decode a stream in Base64
--  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 Interfaces;

--  The Util.Encodes.Base64 packages encodes and decodes streams
--  in Base64 (See rfc4648: The Base16, Base32, and Base64 Data Encodings).
package Util.Encoders.Base64 is

   pragma Preelaborate;

   --  Encode the 64-bit value to LEB128 and then base64url.
   function Encode (Value : in Interfaces.Unsigned_64) return String;

   --  Decode the base64url string and then the LEB128 integer.
   --  Raise the Encoding_Error if the string is invalid and cannot be decoded.
   function Decode (Value : in String) return Interfaces.Unsigned_64;

   --  ------------------------------
   --  Base64 encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  a Base64 ascii stream.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  the a base64 output stream Into.
   --
   --  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 stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        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);

   --  Set the encoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   procedure Set_URL_Mode (E    : in out Encoder;
                           Mode : in Boolean);

   --  Create a base64 encoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   function Create_URL_Encoder return Transformer_Access;

   --  ------------------------------
   --  Base64 decoder
   --  ------------------------------
   --  The Decoder decodes a Base64 ascii stream into a binary stream.
   type Decoder is new Util.Encoders.Transformer with private;

   --  Decodes the base64 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  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 stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Decoder;
                        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);

   --  Set the decoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   procedure Set_URL_Mode (E    : in out Decoder;
                           Mode : in Boolean);

   --  Create a base64 decoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   function Create_URL_Decoder return Transformer_Access;

private

   type Alphabet is
     array (Interfaces.Unsigned_8 range 0 .. 63) of Ada.Streams.Stream_Element;

   type Alphabet_Access is not null access constant Alphabet;

   BASE64_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('+'), Character'Pos ('/'));

   BASE64_URL_ALPHABET : aliased constant Alphabet :=
     (Character'Pos ('A'), Character'Pos ('B'), Character'Pos ('C'), Character'Pos ('D'),
      Character'Pos ('E'), Character'Pos ('F'), Character'Pos ('G'), Character'Pos ('H'),
      Character'Pos ('I'), Character'Pos ('J'), Character'Pos ('K'), Character'Pos ('L'),
      Character'Pos ('M'), Character'Pos ('N'), Character'Pos ('O'), Character'Pos ('P'),
      Character'Pos ('Q'), Character'Pos ('R'), Character'Pos ('S'), Character'Pos ('T'),
      Character'Pos ('U'), Character'Pos ('V'), Character'Pos ('W'), Character'Pos ('X'),
      Character'Pos ('Y'), Character'Pos ('Z'), Character'Pos ('a'), Character'Pos ('b'),
      Character'Pos ('c'), Character'Pos ('d'), Character'Pos ('e'), Character'Pos ('f'),
      Character'Pos ('g'), Character'Pos ('h'), Character'Pos ('i'), Character'Pos ('j'),
      Character'Pos ('k'), Character'Pos ('l'), Character'Pos ('m'), Character'Pos ('n'),
      Character'Pos ('o'), Character'Pos ('p'), Character'Pos ('q'), Character'Pos ('r'),
      Character'Pos ('s'), Character'Pos ('t'), Character'Pos ('u'), Character'Pos ('v'),
      Character'Pos ('w'), Character'Pos ('x'), Character'Pos ('y'), Character'Pos ('z'),
      Character'Pos ('0'), Character'Pos ('1'), Character'Pos ('2'), Character'Pos ('3'),
      Character'Pos ('4'), Character'Pos ('5'), Character'Pos ('6'), Character'Pos ('7'),
      Character'Pos ('8'), Character'Pos ('9'), Character'Pos ('-'), Character'Pos ('_'));

   type Encoder is new Util.Encoders.Transformer with record
      Alphabet : Alphabet_Access := BASE64_ALPHABET'Access;
   end record;

   type Alphabet_Values is array (Ada.Streams.Stream_Element) of Interfaces.Unsigned_8;
   type Alphabet_Values_Access is not null access constant Alphabet_Values;

   BASE64_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 36, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('+') => 62, Character'Pos ('/') => 63,
     others => 16#FF#);

   BASE64_URL_VALUES : aliased constant Alphabet_Values :=
     (Character'Pos ('A') => 0,  Character'Pos ('B') => 1,
      Character'Pos ('C') => 2,  Character'Pos ('D') => 3,
      Character'Pos ('E') => 4,  Character'Pos ('F') => 5,
      Character'Pos ('G') => 6,  Character'Pos ('H') => 7,
      Character'Pos ('I') => 8,  Character'Pos ('J') => 9,
      Character'Pos ('K') => 10, Character'Pos ('L') => 11,
      Character'Pos ('M') => 12, Character'Pos ('N') => 13,
      Character'Pos ('O') => 14, Character'Pos ('P') => 15,
      Character'Pos ('Q') => 16, Character'Pos ('R') => 17,
      Character'Pos ('S') => 18, Character'Pos ('T') => 19,
      Character'Pos ('U') => 20, Character'Pos ('V') => 21,
      Character'Pos ('W') => 22, Character'Pos ('X') => 23,
      Character'Pos ('Y') => 24, Character'Pos ('Z') => 25,
      Character'Pos ('a') => 26, Character'Pos ('b') => 27,
      Character'Pos ('c') => 28, Character'Pos ('d') => 29,
      Character'Pos ('e') => 30, Character'Pos ('f') => 31,
      Character'Pos ('g') => 32, Character'Pos ('h') => 33,
      Character'Pos ('i') => 34, Character'Pos ('j') => 35,
      Character'Pos ('k') => 36, Character'Pos ('l') => 37,
      Character'Pos ('m') => 38, Character'Pos ('n') => 39,
      Character'Pos ('o') => 40, Character'Pos ('p') => 41,
      Character'Pos ('q') => 42, Character'Pos ('r') => 43,
      Character'Pos ('s') => 44, Character'Pos ('t') => 45,
      Character'Pos ('u') => 46, Character'Pos ('v') => 47,
      Character'Pos ('w') => 48, Character'Pos ('x') => 49,
      Character'Pos ('y') => 50, Character'Pos ('z') => 51,
      Character'Pos ('0') => 52, Character'Pos ('1') => 53,
      Character'Pos ('2') => 54, Character'Pos ('3') => 55,
      Character'Pos ('4') => 56, Character'Pos ('5') => 57,
      Character'Pos ('6') => 58, Character'Pos ('7') => 59,
      Character'Pos ('8') => 60, Character'Pos ('9') => 61,
      Character'Pos ('-') => 62, Character'Pos ('_') => 63,
      others => 16#FF#);

   type Decoder is new Util.Encoders.Transformer with record
      Values : Alphabet_Values_Access := BASE64_VALUES'Access;
   end record;

end Util.Encoders.Base64;

Change the Transformer interface to accept in out parameter for the Transformer


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

with Util.Tests;

package Util.Texts.Builders_Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test the length operation.
   procedure Test_Length (T : in out Test);

   --  Test the append operation.
   procedure Test_Append (T : in out Test);

   --  Test the append operation.
   procedure Test_Inline_Append (T : in out Test);

   --  Test the iterate operation.
   procedure Test_Iterate (T : in out Test);

   --  Test the iterate operation.
   procedure Test_Inline_Iterate (T : in out Test);

   --  Test the clear operation.
   procedure Test_Clear (T : in out Test);

   --  Test the tail operation.
   procedure Test_Tail (T : in out Test);

   --  Test the append and iterate performance.
   procedure Test_Perf (T : in out Test);

end Util.Texts.Builders_Tests;

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

with Util.Tests;

package Util.Texts.Builders_Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   --  Test the length operation.
   procedure Test_Length (T : in out Test);

   --  Test the append operation.
   procedure Test_Append (T : in out Test);

   --  Test the append operation.
   procedure Test_Inline_Append (T : in out Test);

   --  Test the iterate operation.
   procedure Test_Iterate (T : in out Test);

   --  Test the iterate operation.
   procedure Test_Inline_Iterate (T : in out Test);

   --  Test the Find generic operation.
   procedure Test_Find (T : in out Test);

   --  Test the clear operation.
   procedure Test_Clear (T : in out Test);

   --  Test the tail operation.
   procedure Test_Tail (T : in out Test);

   --  Test the append and iterate performance.
   procedure Test_Perf (T : in out Test);

end Util.Texts.Builders_Tests;

Declare the Test_Find procedure

Declare the Test_Find procedure


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

   type Memory_Servant is new MAT.Readers.Reader_Base with record
      Data  : MAT.Memory.Targets.Client_Memory;
--        Slots : Client_Memory_Ref;
--        Impl        : Client_Memory_Ref;
   end record;
   type Memory_Reader_Access is access all Memory_Servant'Class;
   --  The memory servant is a proxy for the generic communication
   --  channel to process incomming events (such as memory allocations).

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out MAT.Readers.Message);

   --  Register the reader to extract and analyze memory events.
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Memory_Reader_Access);

end MAT.Memory.Readers;

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

   type Memory_Servant is new MAT.Readers.Reader_Base with record
      Data  : MAT.Memory.Targets.Target_Memory;
--        Slots : Client_Memory_Ref;
--        Impl        : Client_Memory_Ref;
   end record;
   type Memory_Reader_Access is access all Memory_Servant'Class;
   --  The memory servant is a proxy for the generic communication
   --  channel to process incomming events (such as memory allocations).

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out MAT.Readers.Message);

   --  Register the reader to extract and analyze memory events.
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Memory_Reader_Access);

end MAT.Memory.Readers;

Rename Client_Memory into Target_Memory

Rename Client_Memory into Target_Memory


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

with Util.Testsuite;
with Util.Tests;
procedure Util_Harness is

   procedure Harness is new Util.Tests.Harness (Util.Testsuite.Suite);

begin
   Harness ("util-tests.xml");
end Util_Harness;

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

with Ada.Directories;
with Util.Testsuite;
with Util.Tests;
with Util.Properties;
procedure Util_Harness is

   procedure Initialize (Props : in Util.Properties.Manager);

   procedure Harness is new Util.Tests.Harness (Util.Testsuite.Suite, Initialize);

   procedure Initialize (Props : in Util.Properties.Manager) is
      pragma Unreferenced (Props);

      Path : constant String := Util.Tests.Get_Test_Path ("regtests/result");
   begin
      if not Ada.Directories.Exists (Path) then
         Ada.Directories.Create_Directory (Path);
      end if;
   end Initialize;

begin
   Harness ("util-tests.xml");
end Util_Harness;

Fix running the testsuite with AUnit: create the 'regtests/result' directory if it does not exist