--  Copyright (c) 2013 Felix Krause <contact@flyx.org>
--
--  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 Interfaces.C.Strings;

with GL.API;
with GL.Enums.Getter;
with GL.Errors;

package body GL.Context is

   function Major_Version return Int is
      Result : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Major_Version, Result'Access);
      Raise_Exception_On_OpenGL_Error;
      return Result;
   end Major_Version;

   function Minor_Version return Int is
      Result : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Minor_Version, Result'Access);
      Raise_Exception_On_OpenGL_Error;
      return Result;
   end Minor_Version;

   function Version_String return String is
   begin
      return C.Strings.Value (API.Get_String (Enums.Getter.Version));
   end Version_String;

   function Vendor return String is
   begin
      return C.Strings.Value (API.Get_String (Enums.Getter.Vendor));
   end Vendor;

   function Renderer return String is
   begin
      return C.Strings.Value (API.Get_String (Enums.Getter.Renderer));
   end Renderer;

   function Extensions return String_List is
      use Ada.Strings.Unbounded;
      use type Errors.Error_Code;
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Extensions, Count'Access);
      Raise_Exception_On_OpenGL_Error;

      pragma Assert (API.Get_Error = Errors.No_Error);
      --  We are on OpenGL 3

      return List : String_List (1 .. Positive (Count)) do
         for I in List'Range loop
            List (I) := To_Unbounded_String
              (C.Strings.Value (API.Get_String_I
                                (Enums.Getter.Extensions, UInt (I - 1))));
         end loop;
      end return;
   end Extensions;

   function Has_Extension (Name : String) return Boolean is
      use type Errors.Error_Code;
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Extensions, Count'Access);
      Raise_Exception_On_OpenGL_Error;

      pragma Assert (API.Get_Error = Errors.No_Error);
      --  We are on OpenGL 3

      for I in 1 .. Count loop
         declare
            Extension : constant String := C.Strings.Value
              (API.Get_String_I (Enums.Getter.Extensions, UInt (I - 1)));
         begin
            if Extension = Name then
               return True;
            end if;
         end;
      end loop;
      return False;
   end Has_Extension;

   function Primary_Shading_Language_Version return String is
      Result : constant String := C.Strings.Value
        (API.Get_String (Enums.Getter.Shading_Language_Version));
   begin
      Raise_Exception_On_OpenGL_Error;
      return Result;
   end Primary_Shading_Language_Version;

   function Supported_Shading_Language_Versions return String_List is
      use Ada.Strings.Unbounded;
      use type Errors.Error_Code;
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Shading_Language_Versions, Count'Access);
      if API.Get_Error = Errors.Invalid_Enum then
         raise Feature_Not_Supported_Exception;
      end if;
      return List : String_List (1 .. Positive (Count)) do
         for I in List'Range loop
            List (I) := To_Unbounded_String
              (C.Strings.Value (API.Get_String_I (
               Enums.Getter.Shading_Language_Version, UInt (I))));
         end loop;
      end return;
   end Supported_Shading_Language_Versions;

   function Supports_Shading_Language_Version (Name : String) return Boolean is
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Shading_Language_Versions, Count'Access);
      Raise_Exception_On_OpenGL_Error;
      for I in 1 .. Count loop
         if C.Strings.Value
           (API.Get_String_I (Enums.Getter.Shading_Language_Version,
                              UInt (I))) = Name
         then
            return True;
         end if;
      end loop;
      return False;
   end Supports_Shading_Language_Version;

end GL.Context;

--  Copyright (c) 2013 Felix Krause <contact@flyx.org>
--
--  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 Interfaces.C.Strings;

with GL.API;
with GL.Enums.Getter;
with GL.Errors;

package body GL.Context is

   function Major_Version return Int is
      Result : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Major_Version, Result'Access);
      Raise_Exception_On_OpenGL_Error;
      return Result;
   end Major_Version;

   function Minor_Version return Int is
      Result : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Minor_Version, Result'Access);
      Raise_Exception_On_OpenGL_Error;
      return Result;
   end Minor_Version;

   function Version_String return String is
   begin
      return C.Strings.Value (API.Get_String (Enums.Getter.Version));
   end Version_String;

   function Vendor return String is
   begin
      return C.Strings.Value (API.Get_String (Enums.Getter.Vendor));
   end Vendor;

   function Renderer return String is
   begin
      return C.Strings.Value (API.Get_String (Enums.Getter.Renderer));
   end Renderer;

   function Extensions return String_List is
      use Ada.Strings.Unbounded;
      use type Errors.Error_Code;
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Extensions, Count'Access);
      Raise_Exception_On_OpenGL_Error;

      pragma Assert (API.Get_Error = Errors.No_Error);
      --  We are on OpenGL 3

      return List : String_List (1 .. Positive (Count)) do
         for I in List'Range loop
            List (I) := To_Unbounded_String
              (C.Strings.Value (API.Get_String_I
                                (Enums.Getter.Extensions, UInt (I - 1))));
         end loop;
      end return;
   end Extensions;

   function Has_Extension (Name : String) return Boolean is
      use type Errors.Error_Code;
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Extensions, Count'Access);
      Raise_Exception_On_OpenGL_Error;

      pragma Assert (API.Get_Error = Errors.No_Error);
      --  We are on OpenGL 3

      for I in 1 .. Count loop
         declare
            Extension : constant String := C.Strings.Value
              (API.Get_String_I (Enums.Getter.Extensions, UInt (I - 1)));
         begin
            if Extension = Name then
               return True;
            end if;
         end;
      end loop;
      return False;
   end Has_Extension;

   function Primary_Shading_Language_Version return String is
      Result : constant String := C.Strings.Value
        (API.Get_String (Enums.Getter.Shading_Language_Version));
   begin
      Raise_Exception_On_OpenGL_Error;
      return Result;
   end Primary_Shading_Language_Version;

   function Supported_Shading_Language_Versions return String_List is
      use Ada.Strings.Unbounded;
      use type Errors.Error_Code;
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Shading_Language_Versions, Count'Access);
      if API.Get_Error = Errors.Invalid_Enum then
         raise Feature_Not_Supported_Exception;
      end if;
      return List : String_List (1 .. Positive (Count)) do
         for I in List'Range loop
            List (I) := To_Unbounded_String
              (C.Strings.Value (API.Get_String_I (
               Enums.Getter.Shading_Language_Version, UInt (I - 1))));
         end loop;
      end return;
   end Supported_Shading_Language_Versions;

   function Supports_Shading_Language_Version (Name : String) return Boolean is
      Count : aliased Int;
   begin
      API.Get_Integer (Enums.Getter.Num_Shading_Language_Versions, Count'Access);
      Raise_Exception_On_OpenGL_Error;
      for I in 1 .. Count loop
         if C.Strings.Value
           (API.Get_String_I (Enums.Getter.Shading_Language_Version,
                              UInt (I - 1))) = Name
         then
            return True;
         end if;
      end loop;
      return False;
   end Supports_Shading_Language_Version;

end GL.Context;

Fix an off-by-one error in GL.Context

gl: Fix an off-by-one error in GL.Context

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs 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 Util.Tests;
with Util.Test_Caller;
with Util.Measures;

with ADO;
with ADO.Sessions;
with ADO.SQL;
with ADO.Objects;
with Ada.Calendar;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Blogs.Module;
with AWA.Users.Services.Tests.Helpers;
package body AWA.Blogs.Services.Tests is

   use Util.Tests;
   use ADO;
   use ADO.Objects;

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a user
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Services.Blog_Service_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Users.Services.Tests.Helpers.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Module.Get_Blog_Manager;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog",
                           Result       => Blog_Id);
   end Test_Create_Blog;

end AWA.Blogs.Services.Tests;

-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs 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 Util.Tests;
with Util.Test_Caller;
with Util.Measures;

with ADO;
with ADO.Sessions;
with ADO.SQL;
with ADO.Objects;
with Ada.Calendar;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Blogs.Module;
with AWA.Users.Services.Tests.Helpers;
package body AWA.Blogs.Services.Tests is

   use Util.Tests;
   use ADO;
   use ADO.Objects;

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Post",
                       Test_Create_Post'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a blog
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Services.Blog_Service_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Users.Services.Tests.Helpers.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Module.Get_Blog_Manager;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");
   end Test_Create_Blog;

   --  ------------------------------
   --  Test creating and updating of a blog post
   --  ------------------------------
   procedure Test_Create_Post (T : in out Test) is
      Manager   : AWA.Blogs.Services.Blog_Service_Access;
      Blog_Id   : ADO.Identifier;
      Post_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Users.Services.Tests.Helpers.Login (Context, Sec_Ctx, "test-blog-post@test.com");

      Manager := AWA.Blogs.Module.Get_Blog_Manager;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog post",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");

      Manager.Create_Post (Blog_Id => Blog_Id,
                           Title   => "Testing blog title",
                           URI     => "testing-blog-title",
                           Text    => "The blog content",
                           Result  => Post_Id);
      T.Assert (Post_Id > 0, "Invalid post identifier");

      Manager.Update_Post (Post_Id => Post_Id,
                           Title   => "New blog post title",
                           Text    => "The new post content");
      Manager.Delete_Post (Post_Id => Post_Id);

      --  Verify that a Not_Found exception is raised if the post was deleted.
      begin
         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => "Something",
                              Text    => "Content");
         T.Assert (False, "Exception Not_Found was not raised");
      exception
         when Not_Found =>
            null;
      end;

      --  Verify that a Not_Found exception is raised if the post was deleted.
      begin
         Manager.Delete_Post (Post_Id => Post_Id);
         T.Assert (False, "Exception Not_Found was not raised");
      exception
         when Not_Found =>
            null;
      end;

   end Test_Create_Post;

end AWA.Blogs.Services.Tests;

Add unit test for post creation

Add unit test for post creation


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

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

package Security.Policies.Urls is

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

   --  ------------------------------
   --  URI Permission
   --  ------------------------------
   --  Represents a permission to access a given URI.
   type URI_Permission (Len : Natural) is new Permissions.Permission with record
      URI : String (1 .. Len);
   end record;

   --  ------------------------------
   --  URL policy
   --  ------------------------------
   type URL_Policy is new Policy with private;
   type URL_Policy_Access is access all URL_Policy'Class;

   Invalid_Name : exception;

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

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out URL_Policy);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out URL_Policy);

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

private

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
   end record;

end Security.Policies.Urls;

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

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Refs;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

package Security.Policies.Urls is

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

   --  ------------------------------
   --  URI Permission
   --  ------------------------------
   --  Represents a permission to access a given URI.
   type URI_Permission (Len : Natural) is new Permissions.Permission with record
      URI : String (1 .. Len);
   end record;

   --  ------------------------------
   --  URL policy
   --  ------------------------------
   type URL_Policy is new Policy with private;
   type URL_Policy_Access is access all URL_Policy'Class;

   Invalid_Name : exception;

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

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out URL_Policy);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out URL_Policy);

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

private

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
   end record;

end Security.Policies.Urls;

Remove unused with clauses

Remove unused with clauses


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

with Util.Log.Loggers;

with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Blogs.Beans;
with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;

with ADO.Sessions;

with Ada.Calendar;

package body AWA.Blogs.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Blogs.Module");

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

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

      --  Setup the resource bundles.
      App.Register ("blogMsg", "blogs");

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_List_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Admin_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Admin_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Status_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Status_List'Access);

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

   --  ------------------------------
   --  Get the blog module instance associated with the current application.
   --  ------------------------------
   function Get_Blog_Module return Blog_Module_Access is
      function Get is new AWA.Modules.Get (Blog_Module, Blog_Module_Access, NAME);
   begin
      return Get;
   end Get_Blog_Module;

   --  ------------------------------
   --  Create a new blog for the user workspace.
   --  ------------------------------
   procedure Create_Blog (Model        : in Blog_Module;
                          Workspace_Id : in ADO.Identifier;
                          Title        : in String;
                          Result       : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating blog {0} for user", Title);

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create blog permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Blog.Permission,
                             Entity     => WS);

      Blog.Set_Name (Title);
      Blog.Set_Workspace (WS);
      Blog.Set_Create_Date (Ada.Calendar.Clock);
      Blog.Save (DB);

      --  Add the permission for the user to use the new blog.
      AWA.Permissions.Services.Add_Permission (Session => DB,
                                               User    => User,
                                               Entity  => Blog);
      Ctx.Commit;

      Result := Blog.Get_Id;
      Log.Info ("Blog {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Blog;

   --  ------------------------------
   --  Create a new post associated with the given blog identifier.
   --  ------------------------------
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Log.Debug ("Creating post for user");

      Ctx.Start;
      --  Get the blog instance.
      Blog.Load (Session => DB,
                 Id      => Blog_Id,
                 Found   => Found);
      if not Found then
         Log.Error ("Blog {0} not found", ADO.Identifier'Image (Blog_Id));
         raise Not_Found with "Blog not found";
      end if;

      --  Check that the user has the create post permission on the given blog.
      AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
                             Entity     => Blog);

      --  Build the new post.
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Create_Date (Ada.Calendar.Clock);
      Post.Set_Uri (URI);
      Post.Set_Author (Ctx.Get_User);
      Post.Set_Status (Status);
      Post.Set_Blog (Blog);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;

      Result := Post.Get_Id;
      Log.Info ("Post {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Post;

   --  ------------------------------
   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   --  ------------------------------
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type) is
      pragma Unreferenced (Model);

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the update post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Update_Post.Permission,
                             Entity     => Post);

      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Uri (URI);
      Post.Set_Status (Status);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;
   end Update_Post;

   --  ------------------------------
   --  Delete the post identified by the given identifier.
   --  ------------------------------
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the delete post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Delete_Post.Permission,
                             Entity     => Post);

      Post.Delete (Session => DB);
      Ctx.Commit;
   end Delete_Post;

end AWA.Blogs.Modules;

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

with Util.Log.Loggers;

with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Blogs.Beans;
with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;

with ADO.Sessions;

with Ada.Calendar;

package body AWA.Blogs.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Blogs.Module");

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

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

      --  Setup the resource bundles.
      App.Register ("blogMsg", "blogs");

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_List_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Admin_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Admin_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Status_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Status_List'Access);

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

   --  ------------------------------
   --  Get the blog module instance associated with the current application.
   --  ------------------------------
   function Get_Blog_Module return Blog_Module_Access is
      function Get is new AWA.Modules.Get (Blog_Module, Blog_Module_Access, NAME);
   begin
      return Get;
   end Get_Blog_Module;

   --  ------------------------------
   --  Create a new blog for the user workspace.
   --  ------------------------------
   procedure Create_Blog (Model        : in Blog_Module;
                          Workspace_Id : in ADO.Identifier;
                          Title        : in String;
                          Result       : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating blog {0} for user", Title);

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create blog permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Blog.Permission,
                             Entity     => WS);

      Blog.Set_Name (Title);
      Blog.Set_Workspace (WS);
      Blog.Set_Create_Date (Ada.Calendar.Clock);
      Blog.Save (DB);

      --  Add the permission for the user to use the new blog.
      AWA.Permissions.Services.Add_Permission (Session => DB,
                                               User    => User,
                                               Entity  => Blog);
      Ctx.Commit;

      Result := Blog.Get_Id;
      Log.Info ("Blog {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Blog;

   --  ------------------------------
   --  Create a new post associated with the given blog identifier.
   --  ------------------------------
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Log.Debug ("Creating post for user");

      Ctx.Start;
      --  Get the blog instance.
      Blog.Load (Session => DB,
                 Id      => Blog_Id,
                 Found   => Found);
      if not Found then
         Log.Error ("Blog {0} not found", ADO.Identifier'Image (Blog_Id));
         raise Not_Found with "Blog not found";
      end if;

      --  Check that the user has the create post permission on the given blog.
      AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
                             Entity     => Blog);

      --  Build the new post.
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Create_Date (Ada.Calendar.Clock);
      Post.Set_Uri (URI);
      Post.Set_Author (Ctx.Get_User);
      Post.Set_Status (Status);
      Post.Set_Blog (Blog);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;

      Result := Post.Get_Id;
      Log.Info ("Post {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Post;

   --  ------------------------------
   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   --  ------------------------------
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type) is
      pragma Unreferenced (Model);
      use type AWA.Blogs.Models.Post_Status_Type;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the update post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Update_Post.Permission,
                             Entity     => Post);

      if Status = AWA.Blogs.Models.POST_PUBLISHED and then Post.Get_Publish_Date.Is_Null then
         Post.Set_Publish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                    Value   => Ada.Calendar.Clock));
      end if;
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Uri (URI);
      Post.Set_Status (Status);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;
   end Update_Post;

   --  ------------------------------
   --  Delete the post identified by the given identifier.
   --  ------------------------------
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the delete post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Delete_Post.Permission,
                             Entity     => Post);

      Post.Delete (Session => DB);
      Ctx.Commit;
   end Delete_Post;

end AWA.Blogs.Modules;

Set the post publication date when the post is published for the first time


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

--  = Wiki =
--  The Wiki engine parses a Wiki text in several Wiki syntax such as `MediaWiki`,
--  `Creole`, `Markdown`, `Dotclear` and renders the result either in HTML, text or into
--  another Wiki format.  The Wiki engine is used in two steps:
--
--  * The Wiki text is parsed according to its syntax to produce a Wiki Document instance.
--  * The Wiki document is then rendered by a renderer to produce the final HTML, text.
--
--  Through this process, it is possible to insert filters and plugins to customize the
--  parsing and the rendering.
--
--  [images/ada-wiki.png]
--
--  The Ada Wiki engine is organized in several packages:
--
--  * The [Wiki Streams](#wiki-streams) packages define the interface, types and operations
--  for the Wiki engine to read the Wiki or HTML content and for the Wiki renderer to generate
--  the HTML or text outputs.
--  * The [Wiki parser](#wiki-parsers) is responsible for parsing HTML or Wiki content
--  according to a selected Wiki syntax.  It builds the final Wiki document through filters
--  and plugins.
--  * The [Wiki Filters](#wiki-filters) provides a simple filter framework that allows to plug
--  specific filters when a Wiki document is parsed and processed.  Filters are used for the
--  table of content generation, for the HTML filtering, to collect words or links
--  and so on.
--  * The [Wiki Plugins](#wiki-plugins) defines the plugin interface that is used
--  by the Wiki engine to provide pluggable extensions in the Wiki.  Plugins are used
--  for the Wiki template support, to hide some Wiki text content when it is rendered
--  or to interact with other systems.
--  * The Wiki documents and attributes are used for the representation of the Wiki
--  document after the Wiki content is parsed.
--  * The [Wiki renderers](@wiki-render) are the last packages which are used for the rendering
--  of the Wiki document to produce the final HTML or text.
--
--  @include-doc docs/Tutorial.md
--  @include wiki-documents.ads
--  @include wiki-attributes.ads
--  @include wiki-parsers.ads
--  @include wiki-filters.ads
--  @include wiki-plugins.ads
--  @include wiki-render.ads
--  @include wiki-streams.ads
package Wiki is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax
      is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  Textile syntax
         --  https://www.redmine.org/projects/redmine/wiki/RedmineTextFormattingTextile
         SYNTAX_TEXTILE,

         --  A mix of the above
         SYNTAX_MIX,

         --  The input is plain possibly incorrect HTML.
         SYNTAX_HTML);

   --  Defines the possible text formats.
   type Format_Type is (BOLD, STRONG, ITALIC, EMPHASIS, CODE, SUPERSCRIPT, SUBSCRIPT, STRIKEOUT, PREFORMAT, INS);

   type Format_Map is array (Format_Type) of Boolean;

   --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag is
     (
      --  Section 4.1 The root element
      ROOT_HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Deprecated tags but still used widely
      TT_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag) return String_Access;

   type Tag_Boolean_Array is array (Html_Tag) of Boolean;

   No_End_Tag   : constant Tag_Boolean_Array :=
     (
      BASE_TAG   => True,
      LINK_TAG   => True,
      META_TAG   => True,
      IMG_TAG    => True,
      HR_TAG     => True,
      BR_TAG     => True,
      WBR_TAG    => True,
      INPUT_TAG  => True,
      KEYGEN_TAG => True,
      others     => False);

   Tag_Omission : constant Tag_Boolean_Array :=
     (
      --  Section 4.4 Grouping content
      LI_TAG    => True,
      DT_TAG    => True,
      DD_TAG    => True,

      --  Section 4.5 Text-level semantics
      RB_TAG    => True,
      RT_TAG    => True,
      RTC_TAG   => True,
      RP_TAG    => True,

      --  Section 4.9 Tabular data
      TH_TAG    => True,
      TD_TAG    => True,
      TR_TAG    => True,
      TBODY_TAG => True,
      THEAD_TAG => True,
      TFOOT_TAG => True,

      OPTGROUP_TAG => True,
      OPTION_TAG   => True,

      others    => False);

   --  Tags before and after which we want to preserve spaces.
   Tag_Text : constant Tag_Boolean_Array :=
     (
       A_TAG      => True,
       EM_TAG     => True,
       STRONG_TAG => True,
       SMALL_TAG  => True,
       S_TAG      => True,
       CITE_TAG   => True,
       Q_TAG      => True,
       DFN_TAG    => True,
       ABBR_TAG   => True,
       TIME_TAG   => True,
       CODE_TAG   => True,
       VAR_TAG    => True,
       SAMP_TAG   => True,
       KBD_TAG    => True,
       SUB_TAG    => True,
       SUP_TAG    => True,
       I_TAG      => True,
       B_TAG      => True,
       MARK_TAG   => True,
       RUBY_TAG   => True,
       RT_TAG     => True,
       RP_TAG     => True,
       BDI_TAG    => True,
       BDO_TAG    => True,
       SPAN_TAG   => True,
       INS_TAG    => True,
       DEL_TAG    => True,
       TT_TAG     => True,
       UNKNOWN_TAG => True,
       others     => False
     );

end Wiki;

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

--  = Wiki =
--  The Wiki engine parses a Wiki text in several Wiki syntax such as `MediaWiki`,
--  `Creole`, `Markdown`, `Dotclear` and renders the result either in HTML, text or into
--  another Wiki format.  The Wiki engine is used in two steps:
--
--  * The Wiki text is parsed according to its syntax to produce a Wiki Document instance.
--  * The Wiki document is then rendered by a renderer to produce the final HTML, text.
--
--  Through this process, it is possible to insert filters and plugins to customize the
--  parsing and the rendering.
--
--  [images/ada-wiki.png]
--
--  The Ada Wiki engine is organized in several packages:
--
--  * The [Wiki Streams](#wiki-streams) packages define the interface, types and operations
--  for the Wiki engine to read the Wiki or HTML content and for the Wiki renderer to generate
--  the HTML or text outputs.
--  * The [Wiki parser](#wiki-parsers) is responsible for parsing HTML or Wiki content
--  according to a selected Wiki syntax.  It builds the final Wiki document through filters
--  and plugins.
--  * The [Wiki Filters](#wiki-filters) provides a simple filter framework that allows to plug
--  specific filters when a Wiki document is parsed and processed.  Filters are used for the
--  table of content generation, for the HTML filtering, to collect words or links
--  and so on.
--  * The [Wiki Plugins](#wiki-plugins) defines the plugin interface that is used
--  by the Wiki engine to provide pluggable extensions in the Wiki.  Plugins are used
--  for the Wiki template support, to hide some Wiki text content when it is rendered
--  or to interact with other systems.
--  * The Wiki documents and attributes are used for the representation of the Wiki
--  document after the Wiki content is parsed.
--  * The [Wiki renderers](@wiki-render) are the last packages which are used for the rendering
--  of the Wiki document to produce the final HTML or text.
--
--  @include-doc docs/Tutorial.md
--  @include wiki-documents.ads
--  @include wiki-attributes.ads
--  @include wiki-parsers.ads
--  @include wiki-filters.ads
--  @include wiki-plugins.ads
--  @include wiki-render.ads
--  @include wiki-streams.ads
package Wiki is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax
      is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  Textile syntax
         --  https://www.redmine.org/projects/redmine/wiki/RedmineTextFormattingTextile
         SYNTAX_TEXTILE,

         --  The input is plain possibly incorrect HTML.
         SYNTAX_HTML);

   --  Defines the possible text formats.
   type Format_Type is (BOLD, STRONG, ITALIC, EMPHASIS, CODE, SUPERSCRIPT, SUBSCRIPT, STRIKEOUT,
                        PREFORMAT, INS, UNDERLINE);

   type Format_Map is array (Format_Type) of Boolean;

   --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag is
     (
      --  Section 4.1 The root element
      ROOT_HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Deprecated tags but still used widely
      TT_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag) return String_Access;

   type Tag_Boolean_Array is array (Html_Tag) of Boolean;

   No_End_Tag   : constant Tag_Boolean_Array :=
     (
      BASE_TAG   => True,
      LINK_TAG   => True,
      META_TAG   => True,
      IMG_TAG    => True,
      HR_TAG     => True,
      BR_TAG     => True,
      WBR_TAG    => True,
      INPUT_TAG  => True,
      KEYGEN_TAG => True,
      others     => False);

   Tag_Omission : constant Tag_Boolean_Array :=
     (
      --  Section 4.4 Grouping content
      LI_TAG    => True,
      DT_TAG    => True,
      DD_TAG    => True,

      --  Section 4.5 Text-level semantics
      RB_TAG    => True,
      RT_TAG    => True,
      RTC_TAG   => True,
      RP_TAG    => True,

      --  Section 4.9 Tabular data
      TH_TAG    => True,
      TD_TAG    => True,
      TR_TAG    => True,
      TBODY_TAG => True,
      THEAD_TAG => True,
      TFOOT_TAG => True,

      OPTGROUP_TAG => True,
      OPTION_TAG   => True,

      others    => False);

   --  Tags before and after which we want to preserve spaces.
   Tag_Text : constant Tag_Boolean_Array :=
     (
       A_TAG      => True,
       EM_TAG     => True,
       STRONG_TAG => True,
       SMALL_TAG  => True,
       S_TAG      => True,
       CITE_TAG   => True,
       Q_TAG      => True,
       DFN_TAG    => True,
       ABBR_TAG   => True,
       TIME_TAG   => True,
       CODE_TAG   => True,
       VAR_TAG    => True,
       SAMP_TAG   => True,
       KBD_TAG    => True,
       SUB_TAG    => True,
       SUP_TAG    => True,
       I_TAG      => True,
       B_TAG      => True,
       MARK_TAG   => True,
       RUBY_TAG   => True,
       RT_TAG     => True,
       RP_TAG     => True,
       BDI_TAG    => True,
       BDO_TAG    => True,
       SPAN_TAG   => True,
       INS_TAG    => True,
       DEL_TAG    => True,
       TT_TAG     => True,
       UNKNOWN_TAG => True,
       others     => False
     );

end Wiki;

Remove SYNTAX_MIX because it is not useful Add UNDERLINE as new format


-----------------------------------------------------------------------
--  factory -- Session Factory
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 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.Schemas.Entities;
with ADO.Sequences;
with ADO.Caches;
with ADO.Sessions.Sources;

--  === Session Factory ===
--  The session factory is the entry point to obtain a database session.
--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
--
--    with ADO.Sessions.Factory;
--    ...
--    Sess_Factory : ADO.Sessions.Factory;
--
--  The session factory can be initialized by using the <tt>Create</tt> operation and
--  by giving a URI string that identifies the driver and the information to connect
--  to the database.  The session factory is created only once when the application starts.
--
--    ADO.Sessions.Factory.Create (Sess_Factory, "mysql://localhost:3306/ado_test?user=test");
--
--  Having a session factory, one can get a database by using the <tt>Get_Session</tt> or
--  <tt>Get_Master_Session</tt> function.  Each time this operation is called, a new session
--  is returned.  The session is released when the session variable is finalized.
--
--    DB : ADO.Sessions.Session := Sess_Factory.Get_Session;
--
--  The session factory is also responsible for maintaining some data that is shared by
--  all the database connections.  This includes:
--
--  o the sequence generators used to allocate unique identifiers for database tables,
--  o the entity cache,
--  o some application specific global cache.
--
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   ENTITY_CACHE_NAME : constant String := "entity_type";

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record
      Source       : ADO.Sessions.Sources.Data_Source;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      --  Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
      Cache        : aliased ADO.Caches.Cache_Manager;
      Cache_Values : ADO.Caches.Cache_Manager_Access;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

-----------------------------------------------------------------------
--  factory -- Session Factory
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 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.Sequences;
with ADO.Caches;
with ADO.Sessions.Sources;

--  === Session Factory ===
--  The session factory is the entry point to obtain a database session.
--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
--
--    with ADO.Sessions.Factory;
--    ...
--    Sess_Factory : ADO.Sessions.Factory;
--
--  The session factory can be initialized by using the <tt>Create</tt> operation and
--  by giving a URI string that identifies the driver and the information to connect
--  to the database.  The session factory is created only once when the application starts.
--
--    ADO.Sessions.Factory.Create (Sess_Factory, "mysql://localhost:3306/ado_test?user=test");
--
--  Having a session factory, one can get a database by using the <tt>Get_Session</tt> or
--  <tt>Get_Master_Session</tt> function.  Each time this operation is called, a new session
--  is returned.  The session is released when the session variable is finalized.
--
--    DB : ADO.Sessions.Session := Sess_Factory.Get_Session;
--
--  The session factory is also responsible for maintaining some data that is shared by
--  all the database connections.  This includes:
--
--  o the sequence generators used to allocate unique identifiers for database tables,
--  o the entity cache,
--  o some application specific global cache.
--
package ADO.Sessions.Factory is

   pragma Elaborate_Body;

   ENTITY_CACHE_NAME : constant String := "entity_type";

   --  ------------------------------
   --  Session factory
   --  ------------------------------
   type Session_Factory is tagged limited private;
   type Session_Factory_Access is access all Session_Factory'Class;

   --  Get a read-only session from the factory.
   function Get_Session (Factory : in Session_Factory) return Session;

   --  Get a read-write session from the factory.
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session;

   --  Open a session
   procedure Open_Session (Factory : in out Session_Factory;
                           Database : out Session);

   --  Open a session
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session);

   --  Create the session factory to connect to the database represented
   --  by the data source.
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source);

   --  Create the session factory to connect to the database identified
   --  by the URI.
   procedure Create (Factory : out Session_Factory;
                     URI     : in String);

   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   function Get_Session (Proxy : in Session_Record_Access) return Session;
private

   --  The session factory holds the necessary information to obtain a master or slave
   --  database connection.  The sequence factory is shared by all sessions of the same
   --  factory (implementation is thread-safe).  The factory also contains the entity type
   --  cache which is initialized when the factory is created.
   type Session_Factory is tagged limited record
      Source       : ADO.Sessions.Sources.Data_Source;
      Sequences    : Factory_Access := null;
      Seq_Factory  : aliased ADO.Sequences.Factory;
      --  Entity_Cache : aliased ADO.Schemas.Entities.Entity_Cache;
      Entities     : ADO.Sessions.Entity_Cache_Access := null;
      Cache        : aliased ADO.Caches.Cache_Manager;
      Cache_Values : ADO.Caches.Cache_Manager_Access;
   end record;

   --  Initialize the sequence factory associated with the session factory.
   procedure Initialize_Sequences (Factory : in out Session_Factory);

end ADO.Sessions.Factory;

Fix compilation warning detected by GNAT 2017


-----------------------------------------------------------------------
--  awa-permissions -- Permissions module
--  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 Security.Permissions;
with Security.Policies;

with Util.Serialize.IO.XML;

with ADO;

--  == 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:
--
--    package ACL_Create_Post is new Security.Permissions.Permission_ACL ("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 not argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    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:
--
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  @include Permission.hbm.xml
--
--  == 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;

   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);
--
--     --  Get from the security context Context an identifier stored under the
--     --  name Name.  Returns NO_IDENTIFIER if the security context does not define
--     --  such name or the value is not a valid identifier.
--     function Get_Context (Context : in Security.Contexts.Security_Context'Class;
--                           Name    : in String) return ADO.Identifier;

private

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

   type Entity_Policy is new Security.Policies.Policy with null record;
   type Entity_Policy_Access is access all Entity_Policy'Class;

   --  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);

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   overriding
   procedure Finish_Config (Into    : in out Entity_Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser);

end AWA.Permissions;

-----------------------------------------------------------------------
--  awa-permissions -- Permissions module
--  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 Security.Permissions;
with Security.Policies;

with Util.Serialize.IO.XML;

with ADO;

--  == 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:
--
--    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 not argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    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:
--
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  @include Permission.hbm.xml
--
--  == 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;

   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);
--
--     --  Get from the security context Context an identifier stored under the
--     --  name Name.  Returns NO_IDENTIFIER if the security context does not define
--     --  such name or the value is not a valid identifier.
--     function Get_Context (Context : in Security.Contexts.Security_Context'Class;
--                           Name    : in String) return ADO.Identifier;

private

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

   type Entity_Policy is new Security.Policies.Policy with null record;
   type Entity_Policy_Access is access all Entity_Policy'Class;

   --  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);

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   overriding
   procedure Finish_Config (Into    : in out Entity_Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser);

end AWA.Permissions;

Use the Permissions.Definition generic package


-----------------------------------------------------------------------
--  security-openid -- OpenID 2.0 Support
--  Copyright (C) 2009, 2010, 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.
-----------------------------------------------------------------------

--  === OpenID Configuration ==
--  The Open ID provider needs the following configuration parameters:
--
--    openid.realm          The OpenID realm parameter passed in the authentication URL.
--    openid.callback_url   The OpenID return_to parameter.
--
private package Security.Auth.OpenID is

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is new Security.Auth.Manager with private;

   --  Initialize the OpenID authentication realm.  Get the <tt>openid.realm</tt>
   --  and <tt>openid.callback_url</tt> parameters to configure the realm.
   overriding
   procedure Initialize (Realm  : in out Manager;
                         Params : in Parameters'Class;
                         Name   : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   type Manager is new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
   end record;

end Security.Auth.OpenID;

-----------------------------------------------------------------------
--  security-openid -- OpenID 2.0 Support
--  Copyright (C) 2009, 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

--  == OpenID Configuration ==
--  The Open ID provider needs the following configuration parameters:
--
--    openid.realm          The OpenID realm parameter passed in the authentication URL.
--    openid.callback_url   The OpenID return_to parameter.
--
private package Security.Auth.OpenID is

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is new Security.Auth.Manager with private;

   --  Initialize the OpenID authentication realm.  Get the <tt>openid.realm</tt>
   --  and <tt>openid.callback_url</tt> parameters to configure the realm.
   overriding
   procedure Initialize (Realm  : in out Manager;
                         Params : in Parameters'Class;
                         Name   : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   type Manager is new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
   end record;

end Security.Auth.OpenID;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  util-properties-json -- read json files into properties
--  Copyright (C) 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 <tt>Util.Properties.JSON</tt> package provides operations to read a JSON
--  content and put the result in a property manager.  The JSON content is flattened
--  into a set of name/value pairs.  The JSON structure is reflected in the name.
--  Example:
--
--    { "id": "1",                                 id         -> 1
--      "info": { "name": "search",                info.name  -> search
--                "count", "12",                   info.count -> 12
--                "data": { "value": "empty" }},   info.data  -> empty
--      "count": 1                                 info.count -> 1
--    }
package Util.Properties.JSON is

   --  Parse the JSON content and put the flattened content in the property manager.
   procedure Parse_JSON (Manager : in out Util.Properties.Manager'Class;
                         Content : in String;
                         Flatten_Separator : in String := ".");

   --  Read the JSON file into the property manager.
   --  The JSON content is flatten into Flatten the JSON content and add the properties.
   procedure Read_JSON (Manager : in out Util.Properties.Manager'Class;
                        Path    : in String;
                        Flatten_Separator : in String := ".");

end Util.Properties.JSON;

-----------------------------------------------------------------------
--  util-properties-json -- read json files into properties
--  Copyright (C) 2013, 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.
-----------------------------------------------------------------------

--  == Reading JSON property files ==
--  The `Util.Properties.JSON` package provides operations to read a JSON
--  content and put the result in a property manager.  The JSON content is flattened
--  into a set of name/value pairs.  The JSON structure is reflected in the name.
--  Example:
--
--    { "id": "1",                                 id         -> 1
--      "info": { "name": "search",                info.name  -> search
--                "count", "12",                   info.count -> 12
--                "data": { "value": "empty" }},   info.data.value  -> empty
--      "count": 1                                 info.count -> 1
--    }
--
--  To get the value of a JSON property, the user can use the flatten name.  For example:
--
--     Value : constant String := Props.Get ("info.data.value");
--
--  The default separator to construct a flatten name is the dot (`.`) but this can be
--  changed easily when loading the JSON file by specifying the desired separator:
--
--     Util.Properties.JSON.Read_JSON (Props, "config.json", "|");
--
--  Then, the property will be fetch by using:
--
--     Value : constant String := Props.Get ("info|data|value");
--
package Util.Properties.JSON is

   --  Parse the JSON content and put the flattened content in the property manager.
   procedure Parse_JSON (Manager : in out Util.Properties.Manager'Class;
                         Content : in String;
                         Flatten_Separator : in String := ".");

   --  Read the JSON file into the property manager.
   --  The JSON content is flatten into Flatten the JSON content and add the properties.
   procedure Read_JSON (Manager : in out Util.Properties.Manager'Class;
                        Path    : in String;
                        Flatten_Separator : in String := ".");

end Util.Properties.JSON;

Document the JSON properties support

Document the JSON properties support