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

with Ada.Strings.Unbounded;

with Util.Http.Clients.Mockups;

with Util.Test_Caller;
with Ada.Text_IO;
package body Security.Auth.Tests is

   package Caller is new Util.Test_Caller (Test, "Security.Openid");
   procedure Setup (M : in out Manager;
                    Name : in String);

   procedure Check_Discovery (T    : in out Test;
                              Name : in String;
                              URI  : in String);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OpenID.Discover",
                       Test_Discovery'Access);
      Caller.Add_Test (Suite, "Test Security.OpenID.Verify_Signature",
                       Test_Verify_Signature'Access);
   end Add_Tests;

   overriding
   function Get_Parameter (Params : in Test_Parameters;
                           Name   : in String) return String is
   begin
      if Params.Params.Contains (Name) then
         return Params.Params.Element (Name);
      else
         return "";
      end if;
   end Get_Parameter;

   procedure Set_Parameter (Params : in out Test_Parameters;
                            Name   : in String;
                            Value  : in String) is
   begin
      Params.Params.Include (Name, Value);
   end Set_Parameter;

   procedure Setup (M : in out Manager;
                    Name : in String) is
      Params : Test_Parameters;
   begin
      Params.Set_Parameter ("auth.provider.google", "openid");
      Params.Set_Parameter ("auth.provider.openid", "openid");
      Params.Set_Parameter ("openid.realm", "http://localhost/verify");
      Params.Set_Parameter ("openid.callback_url", "http://localhost/openId");
      M.Initialize (Params, Name);
   end Setup;

   procedure Check_Discovery (T    : in out Test;
                              Name : in String;
                              URI  : in String) is
      pragma Unreferenced (URI, T);

      M      : Manager;
      Dir    : constant String := "regtests/files/discover/";
      Path   : constant String := Util.Tests.Get_Path (Dir);
      Result : End_Point;
   begin
      Setup (M, "openid");
      Util.Http.Clients.Mockups.Register;
      Util.Http.Clients.Mockups.Set_File (Path & Name & ".xrds");
      M.Discover (Name   => Name,
                  Result => Result);
      Ada.Text_IO.Put_Line ("Result: " & To_String (Result));
   end Check_Discovery;

   --  ------------------------------
   --  Test Yadis discovery using static files
   --  ------------------------------
   procedure Test_Discovery (T : in out Test) is
   begin
      Check_Discovery (T, "google", "https://www.google.com/accounts/o8/ud");
      Check_Discovery (T, "yahoo", "https://open.login.yahooapis.com/openid/op/auth");
      Check_Discovery (T, "claimid", "");
      Check_Discovery (T, "livejournal", "");
      Check_Discovery (T, "myopenid", "");
      Check_Discovery (T, "myspace", "");
      Check_Discovery (T, "orange", "");
      Check_Discovery (T, "verisign", "");
      Check_Discovery (T, "steamcommunity", "");
   end Test_Discovery;

   --  ------------------------------
   --  Test the OpenID verify signature process
   --  ------------------------------
   procedure Test_Verify_Signature (T : in out Test) is
      Assoc  : Association;
      Req    : Test_Parameters;
      M      : Manager;
      Result : Authentication;
   begin
      Setup (M, "openid");

--        M.Return_To := To_Unbounded_String ("http://localhost/openId");

      --  Below is a part of the authentication process on Google OpenId.
      --  In theory, you cannot use the following information to authenticate again...
      Assoc.Session_Type := To_Unbounded_String ("no-encryption");
      Assoc.Assoc_Type   := To_Unbounded_String ("HMAC-SHA1");
      Assoc.Assoc_Handle := To_Unbounded_String ("AOQobUdTfNDRSgJLi_0mQQnCCstOsefQadOiW9LNSp4JFO815iHCHsRk");
      Assoc.Mac_Key      := To_Unbounded_String ("NGFpR6vWfe7O8YIhhnXQMjL0goI=");

      Req.Set_Parameter ("openid.ns", "http://specs.openid.net/auth/2.0");
      Req.Set_Parameter ("openid.mode", "id_res");
      Req.Set_Parameter ("openid.op_endpoint", "https://www.google.com/accounts/o8/ud");
      Req.Set_Parameter ("openid.response_nonce", "2011-04-26T20:08:22ZJ_neiVqR0e1wZw");
      Req.Set_Parameter ("openid.return_to", "http://localhost/openId");
      Req.Set_Parameter ("openid.assoc_handle", "AOQobUdTfNDRSgJLi_0mQQnCCstOsefQadOiW9LNSp4JFO815iHCHsRk");
      Req.Set_Parameter ("openid.signed", "op_endpoint,claimed_id,identity,return_to,response_nonce,assoc_handle,ns.ext1,ext1.mode,ext1.type.firstname,ext1.value.firstname,ext1.type.email,ext1.value.email,ext1.type.language,ext1.value.language,ext1.type.lastname,ext1.value.lastname");
      Req.Set_Parameter ("openid.sig", "pV8cmScjrmgKvFn2F6Wxh/qBiIE=");
      Req.Set_Parameter ("openid.identity", "https://www.google.com/accounts/o8/id?id=AItOawm4O6C695XlWrS7MUWC-_V_R2zC-Ol993E");
      Req.Set_Parameter ("openid.claimed_id", "https://www.google.com/accounts/o8/id?id=AItOawm4O6C695XlWrS7MUWC-_V_R2zC-Ol993E");
      Req.Set_Parameter ("openid.ns.ext1", "http://openid.net/srv/ax/1.0");
      Req.Set_Parameter ("openid.ext1.mode", "fetch_response");
      Req.Set_Parameter ("openid.ext1.type.firstname", "http://axschema.org/namePerson/first");
      Req.Set_Parameter ("openid.ext1.value.firstname", "Stephane");
      Req.Set_Parameter ("openid.ext1.type.email", "http://axschema.org/contact/email");
      Req.Set_Parameter ("openid.ext1.value.email", "stephane.carrez@gmail.com");
      Req.Set_Parameter ("openid.ext1.type.language", "http://axschema.org/pref/language");
      Req.Set_Parameter ("openid.ext1.value.language", "fr");
      Req.Set_Parameter ("openid.ext1.type.lastname", "http://axschema.org/namePerson/last");
      Req.Set_Parameter ("openid.ext1.value.lastname", "Carrez");

      M.Verify (Assoc, Req, Result);

      --  If the verification is succeeds, the signature is correct, we should be authenticated.
      T.Assert (Get_Status (Result) = AUTHENTICATED, "Authentication status is not authenticated");
      Util.Tests.Assert_Equals (T, "stephane.carrez@gmail.com", Get_Email (Result), "Invalid email");
   end Test_Verify_Signature;

end Security.Auth.Tests;

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

with Ada.Strings.Unbounded;

with Util.Http.Clients.Mockups;

with Util.Test_Caller;
with Ada.Text_IO;
package body Security.Auth.Tests is

   package Caller is new Util.Test_Caller (Test, "Security.Openid");
   procedure Setup (M : in out Manager;
                    Name : in String);

   procedure Check_Discovery (T    : in out Test;
                              Name : in String;
                              URI  : in String);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OpenID.Discover",
                       Test_Discovery'Access);
      Caller.Add_Test (Suite, "Test Security.OpenID.Verify_Signature",
                       Test_Verify_Signature'Access);
   end Add_Tests;

   overriding
   function Get_Parameter (Params : in Test_Parameters;
                           Name   : in String) return String is
   begin
      if Params.Params.Contains (Name) then
         return Params.Params.Element (Name);
      else
         return "";
      end if;
   end Get_Parameter;

   procedure Set_Parameter (Params : in out Test_Parameters;
                            Name   : in String;
                            Value  : in String) is
   begin
      Params.Params.Include (Name, Value);
   end Set_Parameter;

   procedure Setup (M : in out Manager;
                    Name : in String) is
      Params : Test_Parameters;
   begin
      Params.Set_Parameter ("auth.provider.google", "openid");
      Params.Set_Parameter ("auth.provider.openid", "openid");
      Params.Set_Parameter ("openid.realm", "http://localhost/verify");
      Params.Set_Parameter ("openid.callback_url", "http://localhost/openId");
      M.Initialize (Params, Name);
   end Setup;

   procedure Check_Discovery (T    : in out Test;
                              Name : in String;
                              URI  : in String) is
      pragma Unreferenced (URI, T);

      M      : Manager;
      Dir    : constant String := "regtests/files/discover/";
      Path   : constant String := Util.Tests.Get_Path (Dir);
      Result : End_Point;
   begin
      Setup (M, "openid");
      Util.Http.Clients.Mockups.Register;
      Util.Http.Clients.Mockups.Set_File (Path & Name & ".xrds");
      M.Discover (Name   => Name,
                  Result => Result);
      Ada.Text_IO.Put_Line ("Result: " & To_String (Result));
   end Check_Discovery;

   --  ------------------------------
   --  Test Yadis discovery using static files
   --  ------------------------------
   procedure Test_Discovery (T : in out Test) is
   begin
      Check_Discovery (T, "google", "https://www.google.com/accounts/o8/ud");
      Check_Discovery (T, "yahoo", "https://open.login.yahooapis.com/openid/op/auth");
      Check_Discovery (T, "claimid", "");
      Check_Discovery (T, "livejournal", "");
      Check_Discovery (T, "myopenid", "");
      Check_Discovery (T, "myspace", "");
      Check_Discovery (T, "orange", "");
      Check_Discovery (T, "verisign", "");
      Check_Discovery (T, "steamcommunity", "");
   end Test_Discovery;

   --  ------------------------------
   --  Test the OpenID verify signature process
   --  ------------------------------
   procedure Test_Verify_Signature (T : in out Test) is
      Assoc  : Association;
      Req    : Test_Parameters;
      M      : Manager;
      Result : Authentication;
   begin
      Setup (M, "openid");

      pragma Style_Checks ("-mr");
--        M.Return_To := To_Unbounded_String ("http://localhost/openId");

      --  Below is a part of the authentication process on Google OpenId.
      --  In theory, you cannot use the following information to authenticate again...
      Assoc.Session_Type := To_Unbounded_String ("no-encryption");
      Assoc.Assoc_Type   := To_Unbounded_String ("HMAC-SHA1");
      Assoc.Assoc_Handle := To_Unbounded_String ("AOQobUdTfNDRSgJLi_0mQQnCCstOsefQadOiW9LNSp4JFO815iHCHsRk");
      Assoc.Mac_Key      := To_Unbounded_String ("NGFpR6vWfe7O8YIhhnXQMjL0goI=");

      Req.Set_Parameter ("openid.ns", "http://specs.openid.net/auth/2.0");
      Req.Set_Parameter ("openid.mode", "id_res");
      Req.Set_Parameter ("openid.op_endpoint", "https://www.google.com/accounts/o8/ud");
      Req.Set_Parameter ("openid.response_nonce", "2011-04-26T20:08:22ZJ_neiVqR0e1wZw");
      Req.Set_Parameter ("openid.return_to", "http://localhost/openId");
      Req.Set_Parameter ("openid.assoc_handle", "AOQobUdTfNDRSgJLi_0mQQnCCstOsefQadOiW9LNSp4JFO815iHCHsRk");
      Req.Set_Parameter ("openid.signed", "op_endpoint,claimed_id,identity,return_to,response_nonce,assoc_handle,ns.ext1,ext1.mode,ext1.type.firstname,ext1.value.firstname,ext1.type.email,ext1.value.email,ext1.type.language,ext1.value.language,ext1.type.lastname,ext1.value.lastname");
      Req.Set_Parameter ("openid.sig", "pV8cmScjrmgKvFn2F6Wxh/qBiIE=");
      Req.Set_Parameter ("openid.identity", "https://www.google.com/accounts/o8/id?id=AItOawm4O6C695XlWrS7MUWC-_V_R2zC-Ol993E");
      Req.Set_Parameter ("openid.claimed_id", "https://www.google.com/accounts/o8/id?id=AItOawm4O6C695XlWrS7MUWC-_V_R2zC-Ol993E");
      Req.Set_Parameter ("openid.ns.ext1", "http://openid.net/srv/ax/1.0");
      Req.Set_Parameter ("openid.ext1.mode", "fetch_response");
      Req.Set_Parameter ("openid.ext1.type.firstname", "http://axschema.org/namePerson/first");
      Req.Set_Parameter ("openid.ext1.value.firstname", "Stephane");
      Req.Set_Parameter ("openid.ext1.type.email", "http://axschema.org/contact/email");
      Req.Set_Parameter ("openid.ext1.value.email", "stephane.carrez@gmail.com");
      Req.Set_Parameter ("openid.ext1.type.language", "http://axschema.org/pref/language");
      Req.Set_Parameter ("openid.ext1.value.language", "fr");
      Req.Set_Parameter ("openid.ext1.type.lastname", "http://axschema.org/namePerson/last");
      Req.Set_Parameter ("openid.ext1.value.lastname", "Carrez");

      M.Verify (Assoc, Req, Result);

      --  If the verification is succeeds, the signature is correct, we should be authenticated.
      T.Assert (Get_Status (Result) = AUTHENTICATED, "Authentication status is not authenticated");
      Util.Tests.Assert_Equals (T, "stephane.carrez@gmail.com", Get_Email (Result), "Invalid email");
   end Test_Verify_Signature;

end Security.Auth.Tests;

Fix style compilation warning

Fix style compilation warning


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

with AWA.Services.Contexts;
with AWA.Blogs.Services;

with ADO.Queries;
with ADO.Sessions;
with ADO.Sessions.Entities;

with ASF.Contexts.Faces;
with ASF.Applications.Messages.Factory;
with ASF.Events.Faces.Actions;
package body AWA.Blogs.Beans is

   use Ada.Strings.Unbounded;

   BLOG_ID_PARAMETER : constant String := "blog_id";
   POST_ID_PARAMETER : constant String := "post_id";

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as an identifier.
   --  Returns NO_IDENTIFIER if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name : in String) return ADO.Identifier is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier'Value (P);
      end if;
   exception
      when others =>
         return ADO.NO_IDENTIFIER;
   end Get_Parameter;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Blogs.Models.Blog_Ref (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Blog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   package Create_Blog_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Blog_Bean,
                                                      Method => Create_Blog,
                                                      Name   => "create");

   Blog_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Create_Blog_Binding.Proxy'Access);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Blog_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Blog_Bean_Binding'Access;
   end Get_Method_Bindings;

   overriding
   function Copy (Bean : in Blog_Bean) return Blog_Bean is
      pragma Unreferenced (Bean);
      Ref : Blog_Bean;
   begin
      return Ref;
   end Copy;

   --  ------------------------------
   --  Create a new blog.
   --  ------------------------------
   procedure Create_Blog (Bean    : in out Blog_Bean;
                          Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant AWA.Blogs.Services.Blog_Service_Access := Bean.Module.Get_Blog_Manager;
      Result  : ADO.Identifier;
   begin
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => Bean.Get_Name,
                           Result       => Result);
      Outcome := To_Unbounded_String ("success");

   exception
      when Services.Not_Found =>
         Outcome := To_Unbounded_String ("failure");

         ASF.Applications.Messages.Factory.Add_Message ("users.signup_error_message");
   end Create_Blog;

   --  ------------------------------
   --  Create the Blog_Bean bean instance.
   --  ------------------------------
   function Create_Blog_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is
      use type ADO.Identifier;

      Blog_Id : constant ADO.Identifier := Get_Parameter (BLOG_ID_PARAMETER);
      Object  : constant Blog_Bean_Access := new Blog_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
   begin
      if Blog_Id > 0 then
         Object.Load (Session, Blog_Id);
      end if;
      Object.Module := Module;
      return Object.all'Access;
   end Create_Blog_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Create_Post (Bean    : in out Post_Bean;
                          Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type ADO.Identifier;

      Manager : constant AWA.Blogs.Services.Blog_Service_Access := Bean.Module.Get_Blog_Manager;
      Result  : ADO.Identifier;
      Blog_Id : constant ADO.Identifier := Get_Parameter (BLOG_ID_PARAMETER);
      Post_Id : constant ADO.Identifier := Get_Parameter (POST_ID_PARAMETER);
   begin
      if Post_Id < 0 then
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => Bean.Post.Get_Title,
                              URI     => Bean.Post.Get_URI,
                              Text    => Bean.Post.Get_Text,
                              Result  => Result);
      else
         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => To_String (Bean.Title),
                              Text    => To_String (Bean.Text));
      end if;
      Outcome := To_Unbounded_String ("success");

   exception
      when Services.Not_Found =>
         Outcome := To_Unbounded_String ("failure");

         ASF.Applications.Messages.Factory.Add_Message ("users.signup_error_message");
   end Create_Post;

   package Create_Post_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Post_Bean,
                                                      Method => Create_Post,
                                                      Name   => "create");

   package Save_Post_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Post_Bean,
                                                      Method => Create_Post,
                                                      Name   => "save");

   Post_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Create_Post_Binding.Proxy'Access,
         2 => Save_Post_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Post_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = BLOG_ID_ATTR then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Blog_Id));
      elsif Name = POST_ID_ATTR then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Post.Get_Id));
      else
         return From.Post.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Post_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = BLOG_ID_ATTR then
         From.Blog_Id := ADO.Identifier (Util.Beans.Objects.To_Integer (Value));
      elsif Name = POST_ID_ATTR then
         From.Blog_Id := ADO.Identifier (Util.Beans.Objects.To_Integer (Value));
      elsif Name = POST_TEXT_ATTR then
         From.Post.Set_Text (Util.Beans.Objects.To_Unbounded_String (Value));
      elsif Name = POST_TITLE_ATTR then
         From.Post.Set_Title (Util.Beans.Objects.To_Unbounded_String (Value));
      elsif Name = POST_URI_ATTR then
         From.Post.Set_URI (Util.Beans.Objects.To_Unbounded_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Post_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Post_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Post_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is
      use type ADO.Identifier;

      Object  : constant Post_Bean_Access := new Post_Bean;
      Post_Id : constant ADO.Identifier := Get_Parameter (POST_ID_PARAMETER);
   begin
      if Post_Id > 0 then
         declare
            Session : ADO.Sessions.Session := Module.Get_Session;
         begin
            Object.Post.Load (Session, Post_Id);
            Object.Title := Object.Post.Get_Title;
            Object.Text  := Object.Post.Get_Text;
            Object.URI   := Object.Post.Get_URI;
         end;
      end if;
      Object.Module := Module;
      return Object.all'Access;
   end Create_Post_Bean;

   --  ------------------------------
   --  Create the Post_List_Bean bean instance.
   --  ------------------------------
   function Create_Post_List_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Blogs.Models;

      Object  : constant Post_Info_List_Bean_Access := new Post_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Blogs.Models.Query_Blog_Post_List);
      AWA.Blogs.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Post_List_Bean;

   --  ------------------------------
   --  Create the Admin_Post_List_Bean bean instance.
   --  ------------------------------
   function Create_Admin_Post_List_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                                         return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Blogs.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Admin_Post_Info_List_Bean_Access := new Admin_Post_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
      Blog_Id : constant ADO.Identifier := Get_Parameter (BLOG_ID_PARAMETER);
   begin
      if Blog_Id > 0 then
         Query.Set_Query (AWA.Blogs.Models.Query_Blog_Admin_Post_List);
         Query.Bind_Param ("blog_id", Blog_Id);
         Query.Bind_Param ("user_id", User);
         ADO.Sessions.Entities.Bind_Param (Query, "table",
                                           AWA.Blogs.Models.BLOG_TABLE'Access, Session);
         AWA.Blogs.Models.List (Object.all, Session, Query);
      end if;
      return Object.all'Access;
   end Create_Admin_Post_List_Bean;

   --  ------------------------------
   --  Create the Blog_List_Bean bean instance.
   --  ------------------------------
   function Create_Blog_List_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Blogs.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Object  : constant Blog_Info_List_Bean_Access := new Blog_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Blogs.Models.Query_Blog_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Blogs.Models.BLOG_TABLE'Access, Session);
      AWA.Blogs.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Blog_List_Bean;

end AWA.Blogs.Beans;

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

with AWA.Services.Contexts;
with AWA.Blogs.Services;

with ADO.Queries;
with ADO.Sessions;
with ADO.Sessions.Entities;

with ASF.Contexts.Faces;
with ASF.Applications.Messages.Factory;
with ASF.Events.Faces.Actions;
package body AWA.Blogs.Beans is

   use Ada.Strings.Unbounded;

   BLOG_ID_PARAMETER : constant String := "blog_id";
   POST_ID_PARAMETER : constant String := "post_id";

   --  ------------------------------
   --  Get the parameter identified by the given name and return it as an identifier.
   --  Returns NO_IDENTIFIER if the parameter does not exist or is not valid.
   --  ------------------------------
   function Get_Parameter (Name : in String) return ADO.Identifier is
      Ctx  : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      P    : constant String := Ctx.Get_Parameter (Name);
   begin
      if P = "" then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier'Value (P);
      end if;
   exception
      when others =>
         return ADO.NO_IDENTIFIER;
   end Get_Parameter;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Blogs.Models.Blog_Ref (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Blog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   package Create_Blog_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Blog_Bean,
                                                      Method => Create_Blog,
                                                      Name   => "create");

   Blog_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Create_Blog_Binding.Proxy'Access);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Blog_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Blog_Bean_Binding'Access;
   end Get_Method_Bindings;

   overriding
   function Copy (Bean : in Blog_Bean) return Blog_Bean is
      pragma Unreferenced (Bean);
      Ref : Blog_Bean;
   begin
      return Ref;
   end Copy;

   --  ------------------------------
   --  Create a new blog.
   --  ------------------------------
   procedure Create_Blog (Bean    : in out Blog_Bean;
                          Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant AWA.Blogs.Services.Blog_Service_Access := Bean.Module.Get_Blog_Manager;
      Result  : ADO.Identifier;
   begin
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => Bean.Get_Name,
                           Result       => Result);
      Outcome := To_Unbounded_String ("success");

   exception
      when Services.Not_Found =>
         Outcome := To_Unbounded_String ("failure");

         ASF.Applications.Messages.Factory.Add_Message ("users.signup_error_message");
   end Create_Blog;

   --  ------------------------------
   --  Create the Blog_Bean bean instance.
   --  ------------------------------
   function Create_Blog_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is
      use type ADO.Identifier;

      Blog_Id : constant ADO.Identifier := Get_Parameter (BLOG_ID_PARAMETER);
      Object  : constant Blog_Bean_Access := new Blog_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
   begin
      if Blog_Id > 0 then
         Object.Load (Session, Blog_Id);
      end if;
      Object.Module := Module;
      return Object.all'Access;
   end Create_Blog_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Create_Post (Bean    : in out Post_Bean;
                          Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      use type ADO.Identifier;

      Manager : constant AWA.Blogs.Services.Blog_Service_Access := Bean.Module.Get_Blog_Manager;
      Result  : ADO.Identifier;
      Blog_Id : constant ADO.Identifier := Get_Parameter (BLOG_ID_PARAMETER);
      Post_Id : constant ADO.Identifier := Get_Parameter (POST_ID_PARAMETER);
   begin
      if Post_Id < 0 then
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => Bean.Post.Get_Title,
                              URI     => Bean.Post.Get_URI,
                              Text    => Bean.Post.Get_Text,
                              Result  => Result);
      else
         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => Bean.Post.Get_Title,
                              Text    => Bean.Post.Get_Text);
      end if;
      Outcome := To_Unbounded_String ("success");

   exception
      when Services.Not_Found =>
         Outcome := To_Unbounded_String ("failure");

         ASF.Applications.Messages.Factory.Add_Message ("users.signup_error_message");
   end Create_Post;

   package Create_Post_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Post_Bean,
                                                      Method => Create_Post,
                                                      Name   => "create");

   package Save_Post_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Post_Bean,
                                                      Method => Create_Post,
                                                      Name   => "save");

   Post_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Create_Post_Binding.Proxy'Access,
         2 => Save_Post_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Post_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = BLOG_ID_ATTR then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Blog_Id));
      elsif Name = POST_ID_ATTR then
         return Util.Beans.Objects.To_Object (Long_Long_Integer (From.Post.Get_Id));
      else
         return From.Post.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Post_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = BLOG_ID_ATTR then
         From.Blog_Id := ADO.Identifier (Util.Beans.Objects.To_Integer (Value));
      elsif Name = POST_ID_ATTR then
         From.Blog_Id := ADO.Identifier (Util.Beans.Objects.To_Integer (Value));
      elsif Name = POST_TEXT_ATTR then
         From.Post.Set_Text (Util.Beans.Objects.To_Unbounded_String (Value));
      elsif Name = POST_TITLE_ATTR then
         From.Post.Set_Title (Util.Beans.Objects.To_Unbounded_String (Value));
      elsif Name = POST_URI_ATTR then
         From.Post.Set_URI (Util.Beans.Objects.To_Unbounded_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Post_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Post_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Post_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access is
      use type ADO.Identifier;

      Object  : constant Post_Bean_Access := new Post_Bean;
      Post_Id : constant ADO.Identifier := Get_Parameter (POST_ID_PARAMETER);
   begin
      if Post_Id > 0 then
         declare
            Session : ADO.Sessions.Session := Module.Get_Session;
         begin
            Object.Post.Load (Session, Post_Id);
            Object.Title := Object.Post.Get_Title;
            Object.Text  := Object.Post.Get_Text;
            Object.URI   := Object.Post.Get_URI;
         end;
      end if;
      Object.Module := Module;
      return Object.all'Access;
   end Create_Post_Bean;

   --  ------------------------------
   --  Create the Post_List_Bean bean instance.
   --  ------------------------------
   function Create_Post_List_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Blogs.Models;

      Object  : constant Post_Info_List_Bean_Access := new Post_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Blogs.Models.Query_Blog_Post_List);
      AWA.Blogs.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Post_List_Bean;

   --  ------------------------------
   --  Create the Admin_Post_List_Bean bean instance.
   --  ------------------------------
   function Create_Admin_Post_List_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                                         return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Blogs.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Admin_Post_Info_List_Bean_Access := new Admin_Post_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
      Blog_Id : constant ADO.Identifier := Get_Parameter (BLOG_ID_PARAMETER);
   begin
      if Blog_Id > 0 then
         Query.Set_Query (AWA.Blogs.Models.Query_Blog_Admin_Post_List);
         Query.Bind_Param ("blog_id", Blog_Id);
         Query.Bind_Param ("user_id", User);
         ADO.Sessions.Entities.Bind_Param (Query, "table",
                                           AWA.Blogs.Models.BLOG_TABLE'Access, Session);
         AWA.Blogs.Models.List (Object.all, Session, Query);
      end if;
      return Object.all'Access;
   end Create_Admin_Post_List_Bean;

   --  ------------------------------
   --  Create the Blog_List_Bean bean instance.
   --  ------------------------------
   function Create_Blog_List_Bean (Module : in AWA.Blogs.Module.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Blogs.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Object  : constant Blog_Info_List_Bean_Access := new Blog_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Blogs.Models.Query_Blog_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Blogs.Models.BLOG_TABLE'Access, Session);
      AWA.Blogs.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Blog_List_Bean;

end AWA.Blogs.Beans;

Fix updating the blog post title and content


-----------------------------------------------------------------------
--  awa-permissions -- Permissions module
--  Copyright (C) 2011, 2012, 2013, 2014, 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 Security.Permissions;
with Security.Policies;

with Util.Serialize.IO.XML;
private with Util.Beans.Objects;

with ADO;
with ADO.Objects;
private with ADO.Sessions;

--  == Introduction ==
--  The *AWA.Permissions* framework defines and controls the permissions used by an application
--  to verify and grant access to the data and application service.  The framework provides a
--  set of services and API that helps an application in enforcing its specific permissions.
--  Permissions are verified by a permission controller which uses the service context to
--  have information about the user and other context.  The framework allows to use different
--  kinds of permission controllers.  The `Entity_Controller` is the default permission
--  controller which uses the database and an XML configuration to verify a permission.
--
--  === Declaration ===
--  To be used in the application, the first step is to declare the permission.
--  This is a static definition of the permission that will be used to ask to verify the
--  permission.  The permission is given a unique name that will be used in configuration files:
--
--    with Security.Permissions;
--    ...
--    package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
--
--  === Checking for a permission ===
--  A permission can be checked in Ada as well as in the presentation pages.
--  This is done by using the `Check` procedure and the permission definition.  This operation
--  acts as a barrier: it does not return anything but returns normally if the permission is
--  granted.  If the permission is denied, it raises the `NO_PERMISSION` exception.
--
--  Several `Check` operation exists.  Some require no argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    with AWA.Permissions;
--    ...
--    AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
--                           Entity     => Blog_Id);
--
--  === Configuring a permission ===
--  The *AWA.Permissions* framework supports a simple permission model
--  The application configuration file must provide some information to help in checking the
--  permission.  The permission name is referenced by the `name` XML entity.  The `entity-type`
--  refers to the database entity (ie, the table) that the permission concerns.
--  The `sql` XML entity represents the SQL statement that must be used to verify the permission.
--
--    <entity-permission>
--      <name>blog-create-post</name>
--      <entity-type>blog</entity-type>
--      <description>Permission to create a new post.</description>
--      <sql>
--        SELECT acl.id FROM acl
--        WHERE acl.entity_type = :entity_type
--        AND acl.user_id = :user_id
--        AND acl.entity_id = :entity_id
--      </sql>
--    </entity-permission>
--
--  === Adding a permission ===
--  Adding a permission means to create an `ACL` database record that links a given database
--  entity to the user.  This is done easily with the `Add_Permission` procedure:
--
--    with AWA.Permissions.Services;
--    ...
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  [images/awa_permissions_model.png]
--
--  == Queries ==
--  @include permissions.xml
--
package AWA.Permissions is

   NAME : constant String := "Entity-Policy";

   --  Exception raised by the Check procedure if the user does not have
   --  the permission.
   NO_PERMISSION : exception;

   --  Maximum number of entity types that can be defined in the XML entity-permission.
   --  Most permission need only one entity type.  Keep that number small.
   MAX_ENTITY_TYPES : constant Positive := 5;

   type Entity_Type_Array is array (1 .. MAX_ENTITY_TYPES) of ADO.Entity_Type;

   type Permission_Type is (READ, WRITE);

   type Entity_Permission is new Security.Permissions.Permission with private;

   --  Verify that the permission represented by Permission is granted.
   --
   procedure Check (Permission : in Security.Permissions.Permission_Index);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Objects.Object_Ref'Class);

private

   type Entity_Permission is new Security.Permissions.Permission with record
      Entity : ADO.Identifier;
   end record;

   type Entity_Policy;
   type Entity_Policy_Access is access all Entity_Policy'Class;

   type Controller_Config is record
      Name     : Util.Beans.Objects.Object;
      SQL      : Util.Beans.Objects.Object;
      Entity   : ADO.Entity_Type := 0;
      Entities : Entity_Type_Array := (others => ADO.NO_ENTITY_TYPE);
      Count    : Natural := 0;
      Manager  : Entity_Policy_Access;
      Session  : ADO.Sessions.Session;
   end record;

   type Entity_Policy is new Security.Policies.Policy with record
      Config : aliased Controller_Config;
   end record;

   --  Get the policy name.
   overriding
   function Get_Name (From : in Entity_Policy) return String;

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out Entity_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

end AWA.Permissions;

-----------------------------------------------------------------------
--  awa-permissions -- Permissions module
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 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 Security.Permissions;
with Security.Policies;

with Util.Serialize.Mappers;
private with Util.Beans.Objects;

with ADO;
with ADO.Objects;
private with ADO.Sessions;

--  == Introduction ==
--  The *AWA.Permissions* framework defines and controls the permissions used by an application
--  to verify and grant access to the data and application service.  The framework provides a
--  set of services and API that helps an application in enforcing its specific permissions.
--  Permissions are verified by a permission controller which uses the service context to
--  have information about the user and other context.  The framework allows to use different
--  kinds of permission controllers.  The `Entity_Controller` is the default permission
--  controller which uses the database and an XML configuration to verify a permission.
--
--  === Declaration ===
--  To be used in the application, the first step is to declare the permission.
--  This is a static definition of the permission that will be used to ask to verify the
--  permission.  The permission is given a unique name that will be used in configuration files:
--
--    with Security.Permissions;
--    ...
--    package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
--
--  === Checking for a permission ===
--  A permission can be checked in Ada as well as in the presentation pages.
--  This is done by using the `Check` procedure and the permission definition.  This operation
--  acts as a barrier: it does not return anything but returns normally if the permission is
--  granted.  If the permission is denied, it raises the `NO_PERMISSION` exception.
--
--  Several `Check` operation exists.  Some require no argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    with AWA.Permissions;
--    ...
--    AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
--                           Entity     => Blog_Id);
--
--  === Configuring a permission ===
--  The *AWA.Permissions* framework supports a simple permission model
--  The application configuration file must provide some information to help in checking the
--  permission.  The permission name is referenced by the `name` XML entity.  The `entity-type`
--  refers to the database entity (ie, the table) that the permission concerns.
--  The `sql` XML entity represents the SQL statement that must be used to verify the permission.
--
--    <entity-permission>
--      <name>blog-create-post</name>
--      <entity-type>blog</entity-type>
--      <description>Permission to create a new post.</description>
--      <sql>
--        SELECT acl.id FROM acl
--        WHERE acl.entity_type = :entity_type
--        AND acl.user_id = :user_id
--        AND acl.entity_id = :entity_id
--      </sql>
--    </entity-permission>
--
--  === Adding a permission ===
--  Adding a permission means to create an `ACL` database record that links a given database
--  entity to the user.  This is done easily with the `Add_Permission` procedure:
--
--    with AWA.Permissions.Services;
--    ...
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  [images/awa_permissions_model.png]
--
--  == Queries ==
--  @include permissions.xml
--
package AWA.Permissions is

   NAME : constant String := "Entity-Policy";

   --  Exception raised by the Check procedure if the user does not have
   --  the permission.
   NO_PERMISSION : exception;

   --  Maximum number of entity types that can be defined in the XML entity-permission.
   --  Most permission need only one entity type.  Keep that number small.
   MAX_ENTITY_TYPES : constant Positive := 5;

   type Entity_Type_Array is array (1 .. MAX_ENTITY_TYPES) of ADO.Entity_Type;

   type Permission_Type is (READ, WRITE);

   type Entity_Permission is new Security.Permissions.Permission with private;

   --  Verify that the permission represented by Permission is granted.
   --
   procedure Check (Permission : in Security.Permissions.Permission_Index);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Objects.Object_Ref'Class);

private

   type Entity_Permission is new Security.Permissions.Permission with record
      Entity : ADO.Identifier;
   end record;

   type Entity_Policy;
   type Entity_Policy_Access is access all Entity_Policy'Class;

   type Controller_Config is record
      Name     : Util.Beans.Objects.Object;
      SQL      : Util.Beans.Objects.Object;
      Grant    : Util.Beans.Objects.Object;
      Entity   : ADO.Entity_Type := 0;
      Entities : Entity_Type_Array := (others => ADO.NO_ENTITY_TYPE);
      Count    : Natural := 0;
      Manager  : Entity_Policy_Access;
      Session  : ADO.Sessions.Session;
   end record;

   type Entity_Policy is new Security.Policies.Policy with record
      Config : aliased Controller_Config;
   end record;

   --  Get the policy name.
   overriding
   function Get_Name (From : in Entity_Policy) return String;

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out Entity_Policy;
                             Mapper : in out Util.Serialize.Mappers.Processing);

end AWA.Permissions;

Update the Prepare_Config to use the new parser/mapper interface


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

with ADO.Sessions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
package AWA.Workspaces.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

   --  Initialize the workspaces module.
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

private

   type Workspace_Module is new AWA.Modules.Module with null record;

end AWA.Workspaces.Modules;

-----------------------------------------------------------------------
--  awa-workspaces-module -- Module workspaces
--  Copyright (C) 2011, 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 ADO.Sessions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
package AWA.Workspaces.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

   --  Initialize the workspaces module.
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

   --  Send the invitation to the user.
   procedure Send_Invitation (Module : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class);

private

   type Workspace_Module is new AWA.Modules.Module with null record;

end AWA.Workspaces.Modules;

Declare the Send_Invitation procedure to send an invitation to someone


-----------------------------------------------------------------------
--  babel-base -- Database for files
--  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.Finalization;
with ADO;

with Babel.Files;
package Babel.Base is

   type Database is abstract new Ada.Finalization.Limited_Controlled with private;
   type Database_Access is access all Database'Class;

   --  Insert the file in the database.
   procedure Insert (Into : in out Database;
                     File : in Babel.Files.File_Type) is abstract;

private

   type Database is abstract new Ada.Finalization.Limited_Controlled with record
      Name : Integer;
   end record;

end Babel.Base;

-----------------------------------------------------------------------
--  babel-base -- Database for files
--  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.Finalization;
with ADO;

with Babel.Files;
package Babel.Base is

   type Database is abstract new Ada.Finalization.Limited_Controlled with private;
   type Database_Access is access all Database'Class;

   --  Insert the file in the database.
   procedure Insert (Into : in out Database;
                     File : in Babel.Files.File_Type) is abstract;

   procedure Iterate (From    : in Database;
                      Process : not null access
                        procedure (File : in Babel.Files.File_Type)) is abstract;

   procedure Copy (Into : in out Database'Class;
                   From : in Database'Class);

private

   type Database is abstract new Ada.Finalization.Limited_Controlled with record
      Name : Integer;
   end record;

end Babel.Base;

Declare the Iterate and Copy procedures

Declare the Iterate and Copy procedures


-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 2014, 2015, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   --  The path separator.
   Path_Separator      : constant Character := ':';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Util.Systems.Types.mode_t) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, Util.Systems.Types.STAT_NAME);

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, Util.Systems.Types.FSTAT_NAME);

   function Sys_Lseek (Fs : in File_Type;
                       Offset : in Util.Systems.Types.off_t;
                       Mode   : in Util.Systems.Types.Seek_Mode) return Util.Systems.Types.off_t;
   pragma Import (C, Sys_Lseek, "lseek");

   function Sys_Fchmod (Fd   : in File_Type;
                        Mode : in Util.Systems.Types.mode_t) return Integer;
   pragma Import (C, Sys_Fchmod, "fchmod");

   --  Change permission of a file.
   function Sys_Chmod (Path  : in Ptr;
                       Mode  : in Util.Systems.Types.mode_t) return Integer;
   pragma Import (C, Sys_Chmod, "chmod");

   --  Rename a file (the Ada.Directories.Rename does not allow to use
   --  the Unix atomic file rename!)
   function Sys_Rename (Oldpath  : in Ptr;
                        Newpath  : in Ptr) return Integer;
   pragma Import (C, Sys_Rename, "rename");

   --  Libc errno.  The __get_errno function is provided by the GNAT runtime.
   function Errno return Integer;
   pragma Import (C, Errno, "__get_errno");

end Util.Systems.Os;

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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   --  The path separator.
   Path_Separator      : constant Character := ':';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Interfaces.C.int;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Util.Systems.Types.mode_t) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, Util.Systems.Types.STAT_NAME);

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, Util.Systems.Types.FSTAT_NAME);

   function Sys_Lseek (Fs : in File_Type;
                       Offset : in Util.Systems.Types.off_t;
                       Mode   : in Util.Systems.Types.Seek_Mode) return Util.Systems.Types.off_t;
   pragma Import (C, Sys_Lseek, "lseek");

   function Sys_Fchmod (Fd   : in File_Type;
                        Mode : in Util.Systems.Types.mode_t) return Integer;
   pragma Import (C, Sys_Fchmod, "fchmod");

   --  Change permission of a file.
   function Sys_Chmod (Path  : in Ptr;
                       Mode  : in Util.Systems.Types.mode_t) return Integer;
   pragma Import (C, Sys_Chmod, "chmod");

   --  Rename a file (the Ada.Directories.Rename does not allow to use
   --  the Unix atomic file rename!)
   function Sys_Rename (Oldpath  : in Ptr;
                        Newpath  : in Ptr) return Integer;
   pragma Import (C, Sys_Rename, "rename");

   --  Libc errno.  The __get_errno function is provided by the GNAT runtime.
   function Errno return Integer;
   pragma Import (C, Errno, "__get_errno");

end Util.Systems.Os;

Fix header and change File_Type to use the C int type


-----------------------------------------------------------------------
--  api_server -- Example of REST API server
--  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 ASF.Server.Web;
with ASF.Servlets.Rest;
with ASF.Servlets.Files;
with ASF.Applications;
with Util.Log.Loggers;
with Monitor;
with EL.Contexts.Default;

procedure API_Server is
   CONFIG_PATH  : constant String := "samples.properties";

   Api     : aliased ASF.Servlets.Rest.Rest_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   App     : aliased ASF.Servlets.Servlet_Registry;
   WS      : ASF.Server.Web.AWS_Container;
   Ctx     : EL.Contexts.Default.Default_Context;
   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Api_Server");
begin
   Util.Log.Loggers.Initialize (CONFIG_PATH);
   App.Set_Init_Parameter (ASF.Applications.VIEW_DIR, "samples/web");

   --  Register the servlets and filters
   App.Add_Servlet (Name => "api", Server => Api'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "api", Pattern => "/api/*");
   App.Add_Mapping (Name => "files", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");

   Monitor.Mon_API.Register (App, "api", Ctx);

   WS.Register_Application ("/sample", App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/sample/index.html");

   WS.Start;

   delay 6000.0;

end API_Server;

-----------------------------------------------------------------------
--  api_server -- Example of REST API server
--  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 ASF.Server.Web;
with ASF.Servlets.Rest;
with ASF.Servlets.Files;
with ASF.Applications;
with Util.Log.Loggers;
with Monitor;
with EL.Contexts.Default;

procedure API_Server is
   CONFIG_PATH  : constant String := "samples.properties";

   Api     : aliased ASF.Servlets.Rest.Rest_Servlet;
   Files   : aliased ASF.Servlets.Files.File_Servlet;
   App     : aliased ASF.Servlets.Servlet_Registry;
   WS      : ASF.Server.Web.AWS_Container;
   Ctx     : EL.Contexts.Default.Default_Context;
   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Api_Server");
begin
   Util.Log.Loggers.Initialize (CONFIG_PATH);
   App.Set_Init_Parameter (ASF.Applications.VIEW_DIR, "samples/web/monitor");

   --  Register the servlets and filters
   App.Add_Servlet (Name => "api", Server => Api'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "api", Pattern => "/api/*");
   App.Add_Mapping (Name => "files", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");

   Monitor.Mon_API.Register (App, "api", Ctx);

   WS.Register_Application ("/monitor", App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/monitor/index.html");

   WS.Start;

   delay 6000.0;

end API_Server;

Update the URI to use /monitor as base URI


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

--  The ASF.Contexts.Writer defines the response writer to
--  write the rendered result to the response stream.  The IOWriter
--  interface defines the procedure for writing the buffer to the output
--  stream.  The Response_Writer is the main type that provides
--  various methods for writing the content.
--
--  The result stream is encoded according to the encoding type.
--
with Unicode.Encodings;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with EL.Objects;
with Util.Beans.Objects;
with Util.Strings.Builders;
with ASF.Streams;
package ASF.Contexts.Writer is

   use Ada.Strings.Unbounded;
   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  IO Writer
   --  ------------------------------
   type IOWriter is limited interface;
   procedure Write (Stream : in out IOWriter;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  ------------------------------
   --  Response Writer
   --  ------------------------------
   type Response_Writer is new ASF.Streams.Print_Stream with private;
   type Response_Writer_Access is access all Response_Writer'Class;

   --  Backward compatibility
   subtype ResponseWriter is Response_Writer;
   pragma Obsolescent (Entity => ResponseWriter);

   subtype ResponseWriter_Access is Response_Writer_Access;
   pragma Obsolescent (Entity => ResponseWriter_Access);

   --  Initialize the response stream for the given content type and
   --  encoding.  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream       : in out Response_Writer;
                         Content_Type : in String;
                         Encoding     : in String;
                         Output       : in ASF.Streams.Print_Stream);

   --  Get the content type.
   function Get_Content_Type (Stream : in Response_Writer) return String;

   --  Get the character encoding.
   function Get_Encoding (Stream : in Response_Writer) return String;

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out Response_Writer'Class);

   --  Start an XML element with the given name.
   procedure Start_Element (Stream : in out Response_Writer;
                            Name   : in String);

   --  Start an optional XML element with the given name.
   --  The element is written only if it has at least one attribute.
   --  The optional XML element must not contain other XML entities.
   procedure Start_Optional_Element (Stream : in out Response_Writer;
                                     Name   : in String);

   --  Closes an XML element of the given name.
   procedure End_Element (Stream : in out Response_Writer;
                          Name   : in String);

   --  Closes an optional XML element of the given name.
   --  The ending tag is written only if the start tag was written.
   procedure End_Optional_Element (Stream : in out Response_Writer;
                                   Name   : in String);

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Element (Stream   : in out Response_Writer;
                            Name     : in String;
                            Content  : in String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Wide_Wide_String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in Unbounded_String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in EL.Objects.Object);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Unbounded_Wide_Wide_String);

   --  Write a text escaping any character as necessary.
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in Unbounded_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Wide_Wide_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Unbounded_Wide_Wide_String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Value  : in EL.Objects.Object);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Char (Stream : in out Response_Writer;
                         Char   : in Character);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Wide_Char (Stream : in out Response_Writer;
                              Char   : in Wide_Wide_Character);

   --  Write a string on the stream.
   procedure Write (Stream : in out Response_Writer;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write_Raw (Stream : in out Response_Writer;
                        Item   : in String);

   --  Write a raw wide string on the stream.
   procedure Write_Raw (Stream : in out Response_Writer;
                        Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write a raw wide string on the stream.
   procedure Write_Wide_Raw (Stream : in out Response_Writer;
                             Item   : in Wide_Wide_String);

   --  ------------------------------
   --  Javascript Support
   --  ------------------------------
   --  To optimize the execution of Javascript page code, ASF components can queue some
   --  javascript code and have it merged and executed in a single

-----------------------------------------------------------------------
--  writer -- Response stream writer
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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.
-----------------------------------------------------------------------

--  The ASF.Contexts.Writer defines the response writer to
--  write the rendered result to the response stream.  The IOWriter
--  interface defines the procedure for writing the buffer to the output
--  stream.  The Response_Writer is the main type that provides
--  various methods for writing the content.
--
--  The result stream is encoded according to the encoding type.
--
with Unicode.Encodings;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with EL.Objects;
with Util.Beans.Objects;
with Util.Strings.Builders;
with ASF.Streams;
package ASF.Contexts.Writer is

   use Ada.Strings.Unbounded;
   use Ada.Strings.Wide_Wide_Unbounded;

   --  ------------------------------
   --  IO Writer
   --  ------------------------------
   type IOWriter is limited interface;
   procedure Write (Stream : in out IOWriter;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  ------------------------------
   --  Response Writer
   --  ------------------------------
   type Response_Writer is new ASF.Streams.Print_Stream with private;
   type Response_Writer_Access is access all Response_Writer'Class;

   --  Backward compatibility
   subtype ResponseWriter is Response_Writer;
   pragma Obsolescent (Entity => ResponseWriter);

   subtype ResponseWriter_Access is Response_Writer_Access;
   pragma Obsolescent (Entity => ResponseWriter_Access);

   --  Initialize the response stream for the given content type and
   --  encoding.  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream       : in out Response_Writer;
                         Content_Type : in String;
                         Encoding     : in String;
                         Output       : in ASF.Streams.Print_Stream);

   --  Get the content type.
   function Get_Content_Type (Stream : in Response_Writer) return String;

   --  Get the character encoding.
   function Get_Encoding (Stream : in Response_Writer) return String;

   --  Close the current XML entity if an entity was started
   procedure Close_Current (Stream : in out Response_Writer'Class);

   --  Start an XML element with the given name.
   procedure Start_Element (Stream : in out Response_Writer;
                            Name   : in String);

   --  Start an optional XML element with the given name.
   --  The element is written only if it has at least one attribute.
   --  The optional XML element must not contain other XML entities.
   procedure Start_Optional_Element (Stream : in out Response_Writer;
                                     Name   : in String);

   --  Closes an XML element of the given name.
   procedure End_Element (Stream : in out Response_Writer;
                          Name   : in String);

   --  Closes an optional XML element of the given name.
   --  The ending tag is written only if the start tag was written.
   procedure End_Optional_Element (Stream : in out Response_Writer;
                                   Name   : in String);

   --  Write an XML element using the given name and with the content.
   --  This is similar to calling Start_Element, Write_Text
   --  and End_Element.
   procedure Write_Element (Stream   : in out Response_Writer;
                            Name     : in String;
                            Content  : in String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Wide_Wide_String);

   procedure Write_Wide_Element (Stream   : in out Response_Writer;
                                 Name     : in String;
                                 Content  : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in Unbounded_String);

   procedure Write_Attribute (Stream : in out Response_Writer;
                              Name   : in String;
                              Value  : in EL.Objects.Object);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   procedure Write_Wide_Attribute (Stream : in out Response_Writer;
                                   Name   : in String;
                                   Value  : in Unbounded_Wide_Wide_String);

   --  Write a text escaping any character as necessary.
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Text   : in Unbounded_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Wide_Wide_String);
   procedure Write_Wide_Text (Stream : in out Response_Writer;
                              Text   : in Unbounded_Wide_Wide_String);
   procedure Write_Text (Stream : in out Response_Writer;
                         Value  : in EL.Objects.Object);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Char (Stream : in out Response_Writer;
                         Char   : in Character);

   --  Write a character on the response stream and escape that character
   --  as necessary.
   procedure Write_Wide_Char (Stream : in out Response_Writer;
                              Char   : in Wide_Wide_Character);

   --  Write a string on the stream.
   procedure Write (Stream : in out Response_Writer;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write_Raw (Stream : in out Response_Writer;
                        Item   : in String);

   --  Write a raw wide string on the stream.
   procedure Write_Raw (Stream : in out Response_Writer;
                        Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write a raw wide string on the stream.
   procedure Write_Wide_Raw (Stream : in out Response_Writer;
                             Item   : in Wide_Wide_String);

   --  ------------------------------
   --  Javascript Support
   --  ------------------------------
   --  To optimize the execution of Javascript page code, ASF components can queue some
   --  javascript code and have it merged and executed in a single

Add the Async parameter to the Queue_Include_Script procedure