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

package body Wiki.Attributes is

   use Ada.Characters;

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Ada.Characters.Conversions.To_String (Attr.Value.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wide_Wide_String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Unbounded_Wide_Wide_String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return To_Unbounded_Wide_Wide_String (Attr.Value.Value);
   end Get_Unbounded_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Ref := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Value.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Unbounded_Wide_Wide_String is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Unbounded_Wide_Value (Attr);
      else
         return Null_Unbounded_Wide_Wide_String;
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wide_Wide_String is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Wide_Value (Attr);
      else
         return "";
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wide_Wide_String;
                     Value : in Wide_Wide_String) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Conversions.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
   begin
      Append (List, Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Name),
              Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Value));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
      Val : constant Wide_Wide_String
        := To_Wide_Wide_String (Value);
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Val'Length,
                           Name         => Name,
                           Value        => Val);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List) is
   begin
      List.List.Clear;
   end Clear;

   --  ------------------------------
   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name : in String;
                                                           Value : in Wide_Wide_String)) is
      Iter : Attribute_Vectors.Cursor := List.List.First;
      Item : Attribute_Ref;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         Item := Attribute_Vectors.Element (Iter);
         Process (Item.Value.Name, Item.Value.Value);
         Attribute_Vectors.Next (Iter);
      end loop;
   end Iterate;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

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

package body Wiki.Attributes is

   use Ada.Characters;

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Ada.Characters.Conversions.To_String (Attr.Value.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wiki.Strings.WString is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Unbounded_Wide_Wide_String is
      Attr : constant Attribute_Ref := Attribute_Vectors.Element (Position.Pos);
   begin
      return To_Unbounded_Wide_Wide_String (Attr.Value.Value);
   end Get_Unbounded_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Ref := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Value.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Unbounded_Wide_Wide_String is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Unbounded_Wide_Value (Attr);
      else
         return Null_Unbounded_Wide_Wide_String;
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List;
                           Name : in String) return Wiki.Strings.WString is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Wide_Value (Attr);
      else
         return "";
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Wiki.Strings.WString;
                     Value : in Wiki.Strings.WString) is
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Conversions.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
   begin
      Append (List, Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Name),
              Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Value));
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List;
                     Name  : in String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
      Val  : constant Wiki.Strings.WString := To_Wide_Wide_String (Value);
      Attr : constant Attribute_Access
        := new Attribute '(Util.Refs.Ref_Entity with
                           Name_Length  => Name'Length,
                           Value_Length => Val'Length,
                           Name         => Name,
                           Value        => Val);
   begin
      List.List.Append (Attribute_Refs.Create (Attr));
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List) is
   begin
      List.List.Clear;
   end Clear;

   --  ------------------------------
   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterate (List    : in Attribute_List;
                      Process : not null access procedure (Name  : in String;
                                                           Value : in Wiki.Strings.WString)) is
      Iter : Attribute_Vectors.Cursor := List.List.First;
      Item : Attribute_Ref;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         Item := Attribute_Vectors.Element (Iter);
         Process (Item.Value.Name, Item.Value.Value);
         Attribute_Vectors.Next (Iter);
      end loop;
   end Iterate;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

Use the Wiki.Strings.WString type

Use the Wiki.Strings.WString type


-----------------------------------------------------------------------
--  asf-rest-tests - Unit tests for ASF.Rest and ASF.Servlets.Rest
--  Copyright (C) 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 Util.Log;
with Util.Test_Caller;
with Util.Measures;

with EL.Contexts.Default;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Servlets.Rest;
with ASF.Rest.Definition;

package body ASF.Rest.Tests is

   package Caller is new Util.Test_Caller (Test, "Rest");

   package Test_API_Definition is
     new ASF.Rest.Definition (Object_Type => Test_API,
                              URI         => "/test");

   package API_Create is
     new Test_API_Definition.Definition (Handler    => Create'Access,
                                         Method     => ASF.Rest.POST,
                                         Pattern    => "",
                                         Permission => 0);

   package API_Update is
     new Test_API_Definition.Definition (Handler    => Update'Access,
                                         Method     => ASF.Rest.PUT,
                                         Pattern    => ":id",
                                         Permission => 0);

   package API_Delete is
     new Test_API_Definition.Definition (Handler    => Delete'Access,
                                         Method     => ASF.Rest.DELETE,
                                         Pattern    => ":id",
                                         Permission => 0);

   package API_List is
     new Test_API_Definition.Definition (Handler    => List'Access,
                                         Method     => ASF.Rest.GET,
                                         Pattern    => "",
                                         Permission => 0);

   package API_Get is
     new Test_API_Definition.Definition (Handler    => List'Access,
                                         Method     => ASF.Rest.GET,
                                         Pattern    => ":id",
                                         Permission => 0);

   procedure Create (Data   : in out Test_API;
                     Req    : in out ASF.Rest.Request'Class;
                     Reply  : in out ASF.Rest.Response'Class;
                     Stream : in out ASF.Rest.Output_Stream'Class) is
   begin
      Reply.Set_Status (ASF.Responses.SC_CREATED);

      --  ASF.Rest.Created (Reply, "23");
      Reply.Set_Header (Name  => "Location",
                        Value => "/test/23");
   end Create;

   procedure Update (Data   : in out Test_API;
                     Req    : in out ASF.Rest.Request'Class;
                     Reply  : in out ASF.Rest.Response'Class;
                     Stream : in out ASF.Rest.Output_Stream'Class) is
      Id : constant String := Req.Get_Path_Parameter (1);
   begin
      null;
   end Update;

   procedure Delete (Data   : in out Test_API;
                     Req    : in out ASF.Rest.Request'Class;
                     Reply  : in out ASF.Rest.Response'Class;
                     Stream : in out ASF.Rest.Output_Stream'Class) is
   begin
      Reply.Set_Status (ASF.Responses.SC_NO_CONTENT);
   end Delete;

   procedure List (Data   : in out Test_API;
                   Req    : in out ASF.Rest.Request'Class;
                   Reply  : in out ASF.Rest.Response'Class;
                   Stream : in out ASF.Rest.Output_Stream'Class) is
   begin
      if Req.Get_Path_Parameter_Count = 0 then
         Stream.Start_Document;
         Stream.Start_Array ("list");
         for I in 1 .. 10 loop
            Stream.Start_Entity ("item");
            Stream.Write_Attribute ("id", I);
            Stream.Write_Attribute ("name", "Item " & Natural'Image (I));
            Stream.End_Entity ("item");
         end loop;
         Stream.End_Array ("list");
         Stream.End_Document;
      else
         declare
            Id : constant String := Req.Get_Path_Parameter (1);
         begin
            if Id = "100" then
               Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
            elsif Id /= "44" then
               Reply.Set_Status (ASF.Responses.SC_GONE);
            end if;
         end;
      end if;
   end List;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Rest.POST API operation",
                       Test_Create'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.GET API operation",
                       Test_Get'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.PUT API operation",
                       Test_Update'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.DELETE API operation",
                       Test_Delete'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.TRACE API operation",
                       Test_Invalid'Access);
   end Add_Tests;

   procedure Benchmark (Ctx    : in ASF.Servlets.Servlet_Registry;
                        Title  : in String;
                        Method : in String;
                        URI    : in String) is
      T : Util.Measures.Stamp;
   begin
      for I in 1 .. 1000 loop
         declare
            Request : ASF.Requests.Mockup.Request;
            Reply   : ASF.Responses.Mockup.Response;
            Dispatcher : constant ASF.Servlets.Request_Dispatcher
              := Ctx.Get_Request_Dispatcher (Path => URI);
            Result : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Request.Set_Method (Method);
            Request.Set_Request_URI (URI);
            ASF.Servlets.Forward (Dispatcher, Request, Reply);
         end;
      end loop;

      Util.Measures.Report (T, Title, 1000);
   end Benchmark;

   procedure Test_Operation (T      : in out Test;
                             Method : in String;
                             URI    : in String;
                             Status : in Natural) is
      use ASF.Servlets;
      use Util.Tests;

      Ctx     : Servlet_Registry;
      S1      : aliased ASF.Servlets.Rest.Rest_Servlet;
      EL_Ctx  : EL.Contexts.Default.Default_Context;
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
   begin
      Ctx.Add_Servlet ("API", S1'Unchecked_Access);
      Ctx.Start;
      Ctx.Dump_Routes (Util.Log.INFO_LEVEL);
      Test_API_Definition.Register (Registry  => Ctx,
                                    Name      => "API",
                                    ELContext => EL_Ctx);
      Request.Set_Method (Method);
      declare
         Dispatcher : constant Request_Dispatcher
           := Ctx.Get_Request_Dispatcher (Path => URI);
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Request.Set_Request_URI (URI);
         Forward (Dispatcher, Request, Reply);

         --  Check the response after the API method execution.
         Reply.Read_Content (Result);
         Assert_Equals (T, Status, Reply.Get_Status, "Invalid status for " & Method & ":" & URI);
      end;
      Benchmark (Ctx, Method & " " & URI, Method, URI);
   end Test_Operation;

   --  ------------------------------
   --  Test REST POST create operation
   --  ------------------------------
   procedure Test_Create (T : in out Test) is
   begin
      Test_Operation (T, "POST", "/test", ASF.Responses.SC_CREATED);
   end Test_Create;

   --  ------------------------------
   --  Test REST PUT update operation
   --  ------------------------------
   procedure Test_Update (T : in out Test) is
   begin
      Test_Operation (T, "PUT", "/test/44", ASF.Responses.SC_OK);
   end Test_Update;

   --  ------------------------------
   --  Test REST GET operation
   --  ------------------------------
   procedure Test_Get (T : in out Test) is
   begin
      Test_Operation (T, "GET", "/test", ASF.Responses.SC_OK);
      Test_Operation (T, "GET", "/test/44", ASF.Responses.SC_OK);
      Test_Operation (T, "GET", "/test/100", ASF.Responses.SC_NOT_FOUND);
   end Test_Get;

   --  ------------------------------
   --  Test REST DELETE delete operation
   --  ------------------------------
   procedure Test_Delete (T : in out Test) is
   begin
      Test_Operation (T, "DELETE", "/test/44", ASF.Responses.SC_NO_CONTENT);
   end Test_Delete;

   --  ------------------------------
   --  Test REST operation on invalid operation.
   --  ------------------------------
   procedure Test_Invalid (T : in out Test) is
   begin
      Test_Operation (T, "TRACE", "/test/44", ASF.Responses.SC_NOT_FOUND);
   end Test_Invalid;

end ASF.Rest.Tests;

-----------------------------------------------------------------------
--  asf-rest-tests - Unit tests for ASF.Rest and ASF.Servlets.Rest
--  Copyright (C) 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 Util.Log;
with Util.Test_Caller;
with Util.Measures;

with EL.Contexts.Default;

with Security.Permissions;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Servlets.Rest;
with ASF.Rest.Definition;
with ASF.Rest.Operation;

package body ASF.Rest.Tests is

   package Caller is new Util.Test_Caller (Test, "Rest");

   package Test_Permission is
      new Security.Permissions.Definition ("test-permission");

   package API_Simple_Get is
     new ASF.Rest.Operation (Handler    => Simple_Get'Access,
                             URI        => "/simple/:id");

   package API_Simple_List is
     new ASF.Rest.Operation (Handler    => Simple_Get'Access,
                             URI        => "/simple");

   package API_Simple_Post is
     new ASF.Rest.Operation (Handler    => Simple_Post'Access,
                             URI        => "/simple",
                             Method     => ASF.Rest.POST);

   package API_Simple_Delete is
     new ASF.Rest.Operation (Handler    => Simple_Delete'Access,
                             URI        => "/simple/:id",
                             Method     => ASF.Rest.DELETE);

   package API_Simple_Put is
     new ASF.Rest.Operation (Handler    => Simple_Put'Access,
                             URI        => "/simple/:id",
                             Method     => ASF.Rest.PUT);

   package Test_API_Definition is
     new ASF.Rest.Definition (Object_Type => Test_API,
                              URI         => "/test");

   package API_Create is
     new Test_API_Definition.Definition (Handler    => Create'Access,
                                         Method     => ASF.Rest.POST,
                                         Pattern    => "",
                                         Permission => Test_Permission.Permission);

   package API_Update is
     new Test_API_Definition.Definition (Handler    => Update'Access,
                                         Method     => ASF.Rest.PUT,
                                         Pattern    => ":id",
                                         Permission => 0);

   package API_Delete is
     new Test_API_Definition.Definition (Handler    => Delete'Access,
                                         Method     => ASF.Rest.DELETE,
                                         Pattern    => ":id",
                                         Permission => 0);

   package API_List is
     new Test_API_Definition.Definition (Handler    => List'Access,
                                         Method     => ASF.Rest.GET,
                                         Pattern    => "",
                                         Permission => 0);

   package API_Get is
     new Test_API_Definition.Definition (Handler    => List'Access,
                                         Method     => ASF.Rest.GET,
                                         Pattern    => ":id",
                                         Permission => 0);

   procedure Simple_Get (Req    : in out ASF.Rest.Request'Class;
                         Reply  : in out ASF.Rest.Response'Class;
                         Stream : in out ASF.Rest.Output_Stream'Class) is
      Data : Test_API;
   begin
      List (Data, Req, Reply, Stream);
   end Simple_Get;

   procedure Simple_Put (Req    : in out ASF.Rest.Request'Class;
                         Reply  : in out ASF.Rest.Response'Class;
                         Stream : in out ASF.Rest.Output_Stream'Class) is
      Data : Test_API;
   begin
      Update (Data, Req, Reply, Stream);
   end Simple_Put;

   procedure Simple_Post (Req    : in out ASF.Rest.Request'Class;
                          Reply  : in out ASF.Rest.Response'Class;
                          Stream : in out ASF.Rest.Output_Stream'Class) is
      Data : Test_API;
   begin
      Create (Data, Req, Reply, Stream);
   end Simple_Post;

   procedure Simple_Delete (Req    : in out ASF.Rest.Request'Class;
                            Reply  : in out ASF.Rest.Response'Class;
                            Stream : in out ASF.Rest.Output_Stream'Class) is
      Data : Test_API;
   begin
      Delete (Data, Req, Reply, Stream);
   end Simple_Delete;

   procedure Create (Data   : in out Test_API;
                     Req    : in out ASF.Rest.Request'Class;
                     Reply  : in out ASF.Rest.Response'Class;
                     Stream : in out ASF.Rest.Output_Stream'Class) is
   begin
      Reply.Set_Status (ASF.Responses.SC_CREATED);

      --  ASF.Rest.Created (Reply, "23");
      Reply.Set_Header (Name  => "Location",
                        Value => "/test/23");
   end Create;

   procedure Update (Data   : in out Test_API;
                     Req    : in out ASF.Rest.Request'Class;
                     Reply  : in out ASF.Rest.Response'Class;
                     Stream : in out ASF.Rest.Output_Stream'Class) is
      Id : constant String := Req.Get_Path_Parameter (1);
   begin
      Reply.Set_Status (ASF.Responses.SC_OK);
   end Update;

   procedure Delete (Data   : in out Test_API;
                     Req    : in out ASF.Rest.Request'Class;
                     Reply  : in out ASF.Rest.Response'Class;
                     Stream : in out ASF.Rest.Output_Stream'Class) is
   begin
      Reply.Set_Status (ASF.Responses.SC_NO_CONTENT);
   end Delete;

   procedure List (Data   : in out Test_API;
                   Req    : in out ASF.Rest.Request'Class;
                   Reply  : in out ASF.Rest.Response'Class;
                   Stream : in out ASF.Rest.Output_Stream'Class) is
   begin
      if Req.Get_Path_Parameter_Count = 0 then
         Stream.Start_Document;
         Stream.Start_Array ("list");
         for I in 1 .. 10 loop
            Stream.Start_Entity ("item");
            Stream.Write_Attribute ("id", I);
            Stream.Write_Attribute ("name", "Item " & Natural'Image (I));
            Stream.End_Entity ("item");
         end loop;
         Stream.End_Array ("list");
         Stream.End_Document;
      else
         declare
            Id : constant String := Req.Get_Path_Parameter (1);
         begin
            if Id = "100" then
               Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
            elsif Id /= "44" then
               Reply.Set_Status (ASF.Responses.SC_GONE);
            end if;
         end;
      end if;
   end List;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Rest.POST API operation",
                       Test_Create'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.GET API operation",
                       Test_Get'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.PUT API operation",
                       Test_Update'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.DELETE API operation",
                       Test_Delete'Access);
      Caller.Add_Test (Suite, "Test ASF.Rest.TRACE API operation",
                       Test_Invalid'Access);
   end Add_Tests;

   procedure Benchmark (Ctx    : in ASF.Servlets.Servlet_Registry;
                        Title  : in String;
                        Method : in String;
                        URI    : in String) is
      T : Util.Measures.Stamp;
   begin
      for I in 1 .. 1000 loop
         declare
            Request : ASF.Requests.Mockup.Request;
            Reply   : ASF.Responses.Mockup.Response;
            Dispatcher : constant ASF.Servlets.Request_Dispatcher
              := Ctx.Get_Request_Dispatcher (Path => URI);
            Result : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Request.Set_Method (Method);
            Request.Set_Request_URI (URI);
            ASF.Servlets.Forward (Dispatcher, Request, Reply);
         end;
      end loop;

      Util.Measures.Report (T, Title, 1000);
   end Benchmark;

   procedure Test_Operation (T      : in out Test;
                             Method : in String;
                             URI    : in String;
                             Status : in Natural) is
      use ASF.Servlets;
      use Util.Tests;

      Ctx     : Servlet_Registry;
      S1      : aliased ASF.Servlets.Rest.Rest_Servlet;
      EL_Ctx  : EL.Contexts.Default.Default_Context;
      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
   begin
      Ctx.Add_Servlet ("API", S1'Unchecked_Access);
      Ctx.Add_Mapping (Name => "API", Pattern => "/simple/*");
      Ctx.Start;
      Ctx.Dump_Routes (Util.Log.INFO_LEVEL);
      ASF.Rest.Register (Ctx, API_Simple_Get.Definition);
      ASF.Rest.Register (Ctx, API_Simple_List.Definition);
      ASF.Rest.Register (Ctx, API_Simple_Post.Definition);
      ASF.Rest.Register (Ctx, API_Simple_Put.Definition);
      ASF.Rest.Register (Ctx, API_Simple_Delete.Definition);
      Ctx.Dump_Routes (Util.Log.INFO_LEVEL);

      Test_API_Definition.Register (Registry  => Ctx,
                                    Name      => "API",
                                    ELContext => EL_Ctx);
      Request.Set_Method (Method);
      declare
         Dispatcher : constant Request_Dispatcher
           := Ctx.Get_Request_Dispatcher (Path => URI);
         Result : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Request.Set_Request_URI (URI);
         Forward (Dispatcher, Request, Reply);

         --  Check the response after the API method execution.
         Reply.Read_Content (Result);
         Assert_Equals (T, Status, Reply.Get_Status, "Invalid status for " & Method & ":" & URI);
      end;
      Benchmark (Ctx, Method & " " & URI, Method, URI);
   end Test_Operation;

   --  ------------------------------
   --  Test REST POST create operation
   --  ------------------------------
   procedure Test_Create (T : in out Test) is
   begin
      Test_Operation (T, "POST", "/test", ASF.Responses.SC_CREATED);
      Test_Operation (T, "POST", "/simple", ASF.Responses.SC_CREATED);
   end Test_Create;

   --  ------------------------------
   --  Test REST PUT update operation
   --  ------------------------------
   procedure Test_Update (T : in out Test) is
   begin
      Test_Operation (T, "PUT", "/test/44", ASF.Responses.SC_OK);
      Test_Operation (T, "PUT", "/simple/44", ASF.Responses.SC_OK);
   end Test_Update;

   --  ------------------------------
   --  Test REST GET operation
   --  ------------------------------
   procedure Test_Get (T : in out Test) is
   begin
      Test_Operation (T, "GET", "/test", ASF.Responses.SC_OK);
      Test_Operation (T, "GET", "/test/44", ASF.Responses.SC_OK);
      Test_Operation (T, "GET", "/test/100", ASF.Responses.SC_NOT_FOUND);
      Test_Operation (T, "GET", "/simple", ASF.Responses.SC_OK);
      Test_Operation (T, "GET", "/simple/44", ASF.Responses.SC_OK);
      Test_Operation (T, "GET", "/simple/100", ASF.Responses.SC_NOT_FOUND);
   end Test_Get;

   --  ------------------------------
   --  Test REST DELETE delete operation
   --  ------------------------------
   procedure Test_Delete (T : in out Test) is
   begin
      Test_Operation (T, "DELETE", "/test/44", ASF.Responses.SC_NO_CONTENT);
      Test_Operation (T, "DELETE", "/simple/44", ASF.Responses.SC_NO_CONTENT);
   end Test_Delete;

   --  ------------------------------
   --  Test REST operation on invalid operation.
   --  ------------------------------
   procedure Test_Invalid (T : in out Test) is
   begin
      Test_Operation (T, "TRACE", "/test/44", ASF.Responses.SC_NOT_FOUND);
      Test_Operation (T, "TRACE", "/simple/44", ASF.Responses.SC_NOT_FOUND);
   end Test_Invalid;

end ASF.Rest.Tests;

Add new operations to verify simple REST api support with the ASF.Rest.Operation generic package


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

   use type MAT.Types.Target_Tick_Ref;

   Hex_Prefix : Boolean := True;

   Conversion : constant String (1 .. 10) := "0123456789";

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String;

   function Event_Malloc (Item       : in MAT.Events.Target_Event_Type;
                          Related    : in MAT.Events.Tools.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String;

   function Event_Free (Item       : in MAT.Events.Target_Event_Type;
                        Related    : in MAT.Events.Tools.Target_Event_Vector;
                        Start_Time : in MAT.Types.Target_Tick_Ref) return String;

   --  ------------------------------
   --  Format the PID into a string.
   --  ------------------------------
   function Pid (Value : in MAT.Types.Target_Process_Ref) return String is
   begin
      return Util.Strings.Image (Natural (Value));
   end Pid;

   --  ------------------------------
   --  Format the address into a string.
   --  ------------------------------
   function Addr (Value : in MAT.Types.Target_Addr) return String is
      Hex : constant String := MAT.Types.Hex_Image (Value);
   begin
      if Hex_Prefix then
         return "0x" & Hex;
      else
         return Hex;
      end if;
   end Addr;

   --  ------------------------------
   --  Format the size into a string.
   --  ------------------------------
   function Size (Value : in MAT.Types.Target_Size) return String is
      Result : constant String := MAT.Types.Target_Size'Image (Value);
   begin
      if Result (Result'First) = ' ' then
         return Result (Result'First + 1 .. Result'Last);
      else
         return Result;
      end if;
   end Size;

   --  ------------------------------
   --  Format the memory growth size into a string.
   --  ------------------------------
   function Size (Alloced : in MAT.Types.Target_Size;
                  Freed   : in MAT.Types.Target_Size) return String is
      use type MAT.Types.Target_Size;
   begin
      if Alloced > Freed then
         return Size (Alloced - Freed);
      elsif Alloced < Freed then
         return "-" & Size (Freed - Alloced);
      else
         return "=" & Size (Alloced);
      end if;
   end Size;

   --  ------------------------------
   --  Format the time relative to the start time.
   --  ------------------------------
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String is
      T    : constant MAT.Types.Target_Tick_Ref := Value - Start;
      Sec  : constant MAT.Types.Target_Tick_Ref := T / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := T mod 1_000_000;
      Msec : Natural := Natural (Usec / 1_000);
      Frac : String (1 .. 5);
   begin
      Frac (5) := 's';
      Frac (4) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (3) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (2) := Conversion (Msec mod 10 + 1);
      Frac (1) := '.';
      return MAT.Types.Target_Tick_Ref'Image (Sec) & Frac;
   end Time;

   --  ------------------------------
   --  Format the duration in seconds, milliseconds or microseconds.
   --  ------------------------------
   function Duration (Value : in MAT.Types.Target_Tick_Ref) return String is

      Sec  : constant MAT.Types.Target_Tick_Ref := Value / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := Value mod 1_000_000;
      Msec : constant Natural := Natural (Usec / 1_000);
      Val  : Natural;
      Frac : String (1 .. 5);
   begin
      if Sec = 0 and Msec = 0 then
         return Util.Strings.Image (Integer (Usec)) & "us";
      elsif Sec = 0 then
         Val := Natural (Usec mod 1_000);
         Frac (5) := 's';
         Frac (4) := 'm';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Msec)) & Frac;
      else
         Val := Msec;
         Frac (4) := 's';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Sec)) & Frac (1 .. 4);
      end if;
   end Duration;

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String is
      Pos : constant Natural := Ada.Strings.Unbounded.Index (File, "/", Ada.Strings.Backward);
      Len : constant Natural := Ada.Strings.Unbounded.Length (File);
   begin
      if Pos /= 0 then
         return Ada.Strings.Unbounded.Slice (File, Pos + 1, Len);
      else
         return Ada.Strings.Unbounded.To_String (File);
      end if;
   end Location;

   --  ------------------------------
   --  Format a file, line, function information into a string.
   --  ------------------------------
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String is
   begin
      if Ada.Strings.Unbounded.Length (File) = 0 then
         return Ada.Strings.Unbounded.To_String (Func);
      elsif Line > 0 then
         declare
            Num : constant String := Natural'Image (Line);
         begin
            return Ada.Strings.Unbounded.To_String (Func) & " ("
              & Location (File) & ":" & Num (Num'First + 1 .. Num'Last) & ")";
         end;
      else
         return Ada.Strings.Unbounded.To_String (Func) & " (" & Location (File) & ")";
      end if;
   end Location;

   --  ------------------------------
   --  Format an event range description.
   --  ------------------------------
   function Event (First : in MAT.Events.Target_Event_Type;
                   Last  : in MAT.Events.Target_Event_Type) return String is
      use type MAT.Events.Event_Id_Type;

      Id1 : constant String := MAT.Events.Event_Id_Type'Image (First.Id);
      Id2 : constant String := MAT.Events.Event_Id_Type'Image (Last.Id);
   begin
      if First.Id = Last.Id then
         return Id1 (Id1'First + 1 .. Id1'Last);
      else
         return Id1 (Id1'First + 1 .. Id1'Last) & ".." & Id2 (Id2'First + 1 .. Id2'Last);
      end if;
   end Event;

   --  ------------------------------
   --  Format a short description of the event.
   --  ------------------------------
   function Event (Item : in MAT.Events.Target_Event_Type;
                   Mode : in Format_Type := NORMAL) return String is
      use type MAT.Types.Target_Addr;
   begin
      case Item.Index is
         when MAT.Events.MSG_MALLOC =>
            if Mode = BRIEF then
               return "malloc";
            else
               return "malloc(" & Size (Item.Size) & ") = " & Addr (Item.Addr);
            end if;

         when MAT.Events.MSG_REALLOC =>
            if Mode = BRIEF then
               if Item.Old_Addr = 0 then
                  return "realloc";
               else
                  return "realloc";
               end if;
            else
               if Item.Old_Addr = 0 then
                  return "realloc(0," & Size (Item.Size) & ") = "
                    & Addr (Item.Addr);
               else
                  return "realloc(" & Addr (Item.Old_Addr) & "," & Size (Item.Size) & ") = "
                    & Addr (Item.Addr);
               end if;
            end if;

         when MAT.Events.MSG_FREE =>
            if Mode = BRIEF then
               return "free";
            else
               return "free(" & Addr (Item.Addr) & "), " & Size (Item.Size);
            end if;

         when MAT.Events.MSG_BEGIN =>
            return "begin";

         when MAT.Events.MSG_END =>
            return "end";

         when MAT.Events.MSG_LIBRARY =>
            return "library";

      end case;
   end Event;

   function Event_Malloc (Item       : in MAT.Events.Target_Event_Type;
                          Related    : in MAT.Events.Tools.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Free_Event : MAT.Events.Target_Event_Type;
   begin
      Free_Event := MAT.Events.Tools.Find (Related, MAT.Events.MSG_FREE);

      return Size (Item.Size) & " bytes allocated after " & Duration (Item.Time - Start_Time)
        & ", freed " & Duration (Free_Event.Time - Item.Time)
        & " after by event" & MAT.Events.Event_Id_Type'Image (Free_Event.Id)
      ;

   exception
      when MAT.Events.Tools.Not_Found =>
         return Size (Item.Size) & " bytes allocated (never freed)";

   end Event_Malloc;

   function Event_Free (Item       : in MAT.Events.Target_Event_Type;
                        Related    : in MAT.Events.Tools.Target_Event_Vector;
                        Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Alloc_Event : MAT.Events.Target_Event_Type;
   begin
      Alloc_Event := MAT.Events.Tools.Find (Related, MAT.Events.MSG_MALLOC);

      return Size (Alloc_Event.Size) & " bytes freed after " & Duration (Item.Time - Start_Time)
        & ", alloc'ed for " & Duration (Item.Time - Alloc_Event.Time)
        & " by event" & MAT.Events.Event_Id_Type'Image (Alloc_Event.Id);

   exception
      when MAT.Events.Tools.Not_Found =>
         return Size (Item.Size) & " bytes freed";

   end Event_Free;

   --  ------------------------------
   --  Format a short description of the event.
   --  ------------------------------
   function Event (Item       : in MAT.Events.Target_Event_Type;
                   Related    : in MAT.Events.Tools.Target_Event_Vector;
                   Start_Time : in MAT.Types.Target_Tick_Ref) return String is
   begin
      case Item.Index is
         when MAT.Events.MSG_MALLOC =>
            return Event_Malloc (Item, Related, Start_Time);

         when MAT.Events.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.MSG_FREE =>
            return Event_Free (Item, Related, Start_Time);

         when MAT.Events.MSG_BEGIN =>
            return "Begin event";

         when MAT.Events.MSG_END =>
            return "End event";

         when MAT.Events.MSG_LIBRARY =>
            return "Library information event";

      end case;
   end Event;

   --  ------------------------------
   --  Format the difference between two event IDs (offset).
   --  ------------------------------
   function Offset (First  : in MAT.Events.Event_Id_Type;
                    Second : in MAT.Events.Event_Id_Type) return String is
      use type MAT.Events.Event_Id_Type;
   begin
      if First = Second or First = 0 or Second = 0 then
         return "";
      elsif First > Second then
         return "+" & Util.Strings.Image (Natural (First - Second));
      else
         return "-" & Util.Strings.Image (Natural (Second - First));
      end if;
   end Offset;

   --  ------------------------------
   --  Format a short description of the memory allocation slot.
   --  ------------------------------
   function Slot (Value      : in MAT.Types.Target_Addr;
                  Item       : in MAT.Memory.Allocation;
                  Start_Time : in MAT.Types.Target_Tick_Ref) return String is
   begin
      return Addr (Value) & " is " & Size (Item.Size)
        & " bytes allocated after " & Duration (Item.Time - Start_Time)
        & " by event" & MAT.Events.Event_Id_Type'Image (Item.Event);
   end Slot;

end MAT.Formats;

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

   use type MAT.Types.Target_Tick_Ref;

   Hex_Prefix : Boolean := True;

   Hex_Length : Positive := 16;

   Conversion : constant String (1 .. 10) := "0123456789";

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String;

   function Event_Malloc (Item       : in MAT.Events.Target_Event_Type;
                          Related    : in MAT.Events.Tools.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String;

   function Event_Free (Item       : in MAT.Events.Target_Event_Type;
                        Related    : in MAT.Events.Tools.Target_Event_Vector;
                        Start_Time : in MAT.Types.Target_Tick_Ref) return String;

   --  ------------------------------
   --  Format the PID into a string.
   --  ------------------------------
   function Pid (Value : in MAT.Types.Target_Process_Ref) return String is
   begin
      return Util.Strings.Image (Natural (Value));
   end Pid;

   --  ------------------------------
   --  Format the address into a string.
   --  ------------------------------
   function Addr (Value : in MAT.Types.Target_Addr) return String is
      Hex : constant String := MAT.Types.Hex_Image (Value, Hex_Length);
   begin
      if Hex_Prefix then
         return "0x" & Hex;
      else
         return Hex;
      end if;
   end Addr;

   --  ------------------------------
   --  Format the size into a string.
   --  ------------------------------
   function Size (Value : in MAT.Types.Target_Size) return String is
      Result : constant String := MAT.Types.Target_Size'Image (Value);
   begin
      if Result (Result'First) = ' ' then
         return Result (Result'First + 1 .. Result'Last);
      else
         return Result;
      end if;
   end Size;

   --  ------------------------------
   --  Format the memory growth size into a string.
   --  ------------------------------
   function Size (Alloced : in MAT.Types.Target_Size;
                  Freed   : in MAT.Types.Target_Size) return String is
      use type MAT.Types.Target_Size;
   begin
      if Alloced > Freed then
         return Size (Alloced - Freed);
      elsif Alloced < Freed then
         return "-" & Size (Freed - Alloced);
      else
         return "=" & Size (Alloced);
      end if;
   end Size;

   --  ------------------------------
   --  Format the time relative to the start time.
   --  ------------------------------
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String is
      T    : constant MAT.Types.Target_Tick_Ref := Value - Start;
      Sec  : constant MAT.Types.Target_Tick_Ref := T / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := T mod 1_000_000;
      Msec : Natural := Natural (Usec / 1_000);
      Frac : String (1 .. 5);
   begin
      Frac (5) := 's';
      Frac (4) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (3) := Conversion (Msec mod 10 + 1);
      Msec := Msec / 10;
      Frac (2) := Conversion (Msec mod 10 + 1);
      Frac (1) := '.';
      return MAT.Types.Target_Tick_Ref'Image (Sec) & Frac;
   end Time;

   --  ------------------------------
   --  Format the duration in seconds, milliseconds or microseconds.
   --  ------------------------------
   function Duration (Value : in MAT.Types.Target_Tick_Ref) return String is

      Sec  : constant MAT.Types.Target_Tick_Ref := Value / 1_000_000;
      Usec : constant MAT.Types.Target_Tick_Ref := Value mod 1_000_000;
      Msec : constant Natural := Natural (Usec / 1_000);
      Val  : Natural;
      Frac : String (1 .. 5);
   begin
      if Sec = 0 and Msec = 0 then
         return Util.Strings.Image (Integer (Usec)) & "us";
      elsif Sec = 0 then
         Val := Natural (Usec mod 1_000);
         Frac (5) := 's';
         Frac (4) := 'm';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Msec)) & Frac;
      else
         Val := Msec;
         Frac (4) := 's';
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (3) := Conversion (Val mod 10 + 1);
         Val := Val / 10;
         Frac (2) := Conversion (Val mod 10 + 1);
         Frac (1) := '.';
         return Util.Strings.Image (Integer (Sec)) & Frac (1 .. 4);
      end if;
   end Duration;

   function Location (File : in Ada.Strings.Unbounded.Unbounded_String) return String is
      Pos : constant Natural := Ada.Strings.Unbounded.Index (File, "/", Ada.Strings.Backward);
      Len : constant Natural := Ada.Strings.Unbounded.Length (File);
   begin
      if Pos /= 0 then
         return Ada.Strings.Unbounded.Slice (File, Pos + 1, Len);
      else
         return Ada.Strings.Unbounded.To_String (File);
      end if;
   end Location;

   --  ------------------------------
   --  Format a file, line, function information into a string.
   --  ------------------------------
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String is
   begin
      if Ada.Strings.Unbounded.Length (File) = 0 then
         return Ada.Strings.Unbounded.To_String (Func);
      elsif Line > 0 then
         declare
            Num : constant String := Natural'Image (Line);
         begin
            return Ada.Strings.Unbounded.To_String (Func) & " ("
              & Location (File) & ":" & Num (Num'First + 1 .. Num'Last) & ")";
         end;
      else
         return Ada.Strings.Unbounded.To_String (Func) & " (" & Location (File) & ")";
      end if;
   end Location;

   --  ------------------------------
   --  Format an event range description.
   --  ------------------------------
   function Event (First : in MAT.Events.Target_Event_Type;
                   Last  : in MAT.Events.Target_Event_Type) return String is
      use type MAT.Events.Event_Id_Type;

      Id1 : constant String := MAT.Events.Event_Id_Type'Image (First.Id);
      Id2 : constant String := MAT.Events.Event_Id_Type'Image (Last.Id);
   begin
      if First.Id = Last.Id then
         return Id1 (Id1'First + 1 .. Id1'Last);
      else
         return Id1 (Id1'First + 1 .. Id1'Last) & ".." & Id2 (Id2'First + 1 .. Id2'Last);
      end if;
   end Event;

   --  ------------------------------
   --  Format a short description of the event.
   --  ------------------------------
   function Event (Item : in MAT.Events.Target_Event_Type;
                   Mode : in Format_Type := NORMAL) return String is
      use type MAT.Types.Target_Addr;
   begin
      case Item.Index is
         when MAT.Events.MSG_MALLOC =>
            if Mode = BRIEF then
               return "malloc";
            else
               return "malloc(" & Size (Item.Size) & ") = " & Addr (Item.Addr);
            end if;

         when MAT.Events.MSG_REALLOC =>
            if Mode = BRIEF then
               if Item.Old_Addr = 0 then
                  return "realloc";
               else
                  return "realloc";
               end if;
            else
               if Item.Old_Addr = 0 then
                  return "realloc(0," & Size (Item.Size) & ") = "
                    & Addr (Item.Addr);
               else
                  return "realloc(" & Addr (Item.Old_Addr) & "," & Size (Item.Size) & ") = "
                    & Addr (Item.Addr);
               end if;
            end if;

         when MAT.Events.MSG_FREE =>
            if Mode = BRIEF then
               return "free";
            else
               return "free(" & Addr (Item.Addr) & "), " & Size (Item.Size);
            end if;

         when MAT.Events.MSG_BEGIN =>
            return "begin";

         when MAT.Events.MSG_END =>
            return "end";

         when MAT.Events.MSG_LIBRARY =>
            return "library";

      end case;
   end Event;

   function Event_Malloc (Item       : in MAT.Events.Target_Event_Type;
                          Related    : in MAT.Events.Tools.Target_Event_Vector;
                          Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Free_Event : MAT.Events.Target_Event_Type;
   begin
      Free_Event := MAT.Events.Tools.Find (Related, MAT.Events.MSG_FREE);

      return Size (Item.Size) & " bytes allocated after " & Duration (Item.Time - Start_Time)
        & ", freed " & Duration (Free_Event.Time - Item.Time)
        & " after by event" & MAT.Events.Event_Id_Type'Image (Free_Event.Id)
      ;

   exception
      when MAT.Events.Tools.Not_Found =>
         return Size (Item.Size) & " bytes allocated (never freed)";

   end Event_Malloc;

   function Event_Free (Item       : in MAT.Events.Target_Event_Type;
                        Related    : in MAT.Events.Tools.Target_Event_Vector;
                        Start_Time : in MAT.Types.Target_Tick_Ref) return String is
      Alloc_Event : MAT.Events.Target_Event_Type;
   begin
      Alloc_Event := MAT.Events.Tools.Find (Related, MAT.Events.MSG_MALLOC);

      return Size (Alloc_Event.Size) & " bytes freed after " & Duration (Item.Time - Start_Time)
        & ", alloc'ed for " & Duration (Item.Time - Alloc_Event.Time)
        & " by event" & MAT.Events.Event_Id_Type'Image (Alloc_Event.Id);

   exception
      when MAT.Events.Tools.Not_Found =>
         return Size (Item.Size) & " bytes freed";

   end Event_Free;

   --  ------------------------------
   --  Format a short description of the event.
   --  ------------------------------
   function Event (Item       : in MAT.Events.Target_Event_Type;
                   Related    : in MAT.Events.Tools.Target_Event_Vector;
                   Start_Time : in MAT.Types.Target_Tick_Ref) return String is
   begin
      case Item.Index is
         when MAT.Events.MSG_MALLOC =>
            return Event_Malloc (Item, Related, Start_Time);

         when MAT.Events.MSG_REALLOC =>
            return Size (Item.Size) & " bytes reallocated";

         when MAT.Events.MSG_FREE =>
            return Event_Free (Item, Related, Start_Time);

         when MAT.Events.MSG_BEGIN =>
            return "Begin event";

         when MAT.Events.MSG_END =>
            return "End event";

         when MAT.Events.MSG_LIBRARY =>
            return "Library information event";

      end case;
   end Event;

   --  ------------------------------
   --  Format the difference between two event IDs (offset).
   --  ------------------------------
   function Offset (First  : in MAT.Events.Event_Id_Type;
                    Second : in MAT.Events.Event_Id_Type) return String is
      use type MAT.Events.Event_Id_Type;
   begin
      if First = Second or First = 0 or Second = 0 then
         return "";
      elsif First > Second then
         return "+" & Util.Strings.Image (Natural (First - Second));
      else
         return "-" & Util.Strings.Image (Natural (Second - First));
      end if;
   end Offset;

   --  ------------------------------
   --  Format a short description of the memory allocation slot.
   --  ------------------------------
   function Slot (Value      : in MAT.Types.Target_Addr;
                  Item       : in MAT.Memory.Allocation;
                  Start_Time : in MAT.Types.Target_Tick_Ref) return String is
   begin
      return Addr (Value) & " is " & Size (Item.Size)
        & " bytes allocated after " & Duration (Item.Time - Start_Time)
        & " by event" & MAT.Events.Event_Id_Type'Image (Item.Event);
   end Slot;

end MAT.Formats;

Define a Hex_Length format and use it for the hexadecimal conversion


-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  Copyright (C) 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 Util.Strings;
with Util.Serialize.IO;
with ASF.Requests;
with ASF.Responses;
with ASF.Servlets;
with EL.Contexts;
with Security.Permissions;

--  == REST ==
--  The <tt>ASF.Rest</tt> package provides support to implement easily some RESTful API.
package ASF.Rest is

   subtype Request is ASF.Requests.Request;

   subtype Response is ASF.Responses.Response;

   subtype Output_Stream is Util.Serialize.IO.Output_Stream;

   --  The HTTP rest method.
   type Method_Type is (GET, HEAD, POST, PUT, DELETE, TRACE, CONNECT, OPTIONS);

   type Descriptor is abstract tagged limited private;
   type Descriptor_Access is access all Descriptor'Class;

   --  Get the permission index associated with the REST operation.
   function Get_Permission (Handler : in Descriptor)
                            return Security.Permissions.Permission_Index;

   --  Dispatch the request to the API handler.
   procedure Dispatch (Handler : in Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class;
                       Stream  : in out Output_Stream'Class) is abstract;

private

   type Descriptor is abstract tagged limited record
      Next       : Descriptor_Access;
      Method     : Method_Type;
      Pattern    : Util.Strings.Name_Access;
      Permission : Security.Permissions.Permission_Index := 0;
   end record;

   --  Register the API descriptor in a list.
   procedure Register (List : in out Descriptor_Access;
                       Item : in Descriptor_Access);

   --  Register the list of API descriptors for a given servlet and a root path.
   procedure Register (Registry  : in out ASF.Servlets.Servlet_Registry;
                       Name      : in String;
                       URI       : in String;
                       ELContext : in EL.Contexts.ELContext'Class;
                       List      : in Descriptor_Access);

end ASF.Rest;

-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  Copyright (C) 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 Util.Strings;
with Util.Serialize.IO;
with ASF.Requests;
with ASF.Responses;
with ASF.Servlets;
with EL.Contexts;
with Security.Permissions;

--  == REST ==
--  The <tt>ASF.Rest</tt> package provides support to implement easily some RESTful API.
package ASF.Rest is

   subtype Request is ASF.Requests.Request;

   subtype Response is ASF.Responses.Response;

   subtype Output_Stream is Util.Serialize.IO.Output_Stream;

   --  The HTTP rest method.
   type Method_Type is (GET, HEAD, POST, PUT, DELETE, TRACE, CONNECT, OPTIONS);

   type Descriptor is abstract tagged limited private;
   type Descriptor_Access is access all Descriptor'Class;

   --  Get the permission index associated with the REST operation.
   function Get_Permission (Handler : in Descriptor)
                            return Security.Permissions.Permission_Index;

   --  Dispatch the request to the API handler.
   procedure Dispatch (Handler : in Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class;
                       Stream  : in out Output_Stream'Class) is abstract;

   type Operation_Access is
      access procedure (Req    : in out ASF.Rest.Request'Class;
                        Reply  : in out ASF.Rest.Response'Class;
                        Stream : in out ASF.Rest.Output_Stream'Class);

   --  Register the API definition in the servlet registry.
   procedure Register (Registry   : in out ASF.Servlets.Servlet_Registry'Class;
                       Definition : in Descriptor_Access);

private

   type Descriptor is abstract tagged limited record
      Next       : Descriptor_Access;
      Method     : Method_Type;
      Pattern    : Util.Strings.Name_Access;
      Permission : Security.Permissions.Permission_Index := 0;
   end record;

   --  Register the API descriptor in a list.
   procedure Register (List : in out Descriptor_Access;
                       Item : in Descriptor_Access);

   --  Register the list of API descriptors for a given servlet and a root path.
   procedure Register (Registry  : in out ASF.Servlets.Servlet_Registry;
                       Name      : in String;
                       URI       : in String;
                       ELContext : in EL.Contexts.ELContext'Class;
                       List      : in Descriptor_Access);

   type Static_Descriptor is new Descriptor with record
      Handler : Operation_Access;
   end record;

   --  Dispatch the request to the API handler.
   overriding
   procedure Dispatch (Handler : in Static_Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class;
                       Stream  : in out Output_Stream'Class);

end ASF.Rest;

Declare Register, Static_Descriptor type for the ASF.Rest.Operation generic package