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

with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
package body ASF.Models.Selects is

   function UTF8_Decode (S : in String) return Wide_Wide_String
      renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Decode;

   --  ------------------------------
   --  Return an Object from the select item record.
   --  Returns a NULL object if the item is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item) return Util.Beans.Objects.Object is
   begin
      if Item.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_Access := new Select_Item;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item instance from a generic bean object.
   --  Returns an empty item if the object does not hold a Select_Item.
   --  ------------------------------
   function To_Select_Item (Object : in Util.Beans.Objects.Object) return Select_Item is
      Bean   : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item'Class) then
         return Result;
      end if;
      Result := Select_Item (Bean.all);
      return Result;
   end To_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item (Label       : in String;
                                Value       : in String;
                                Description : in String := "";
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (UTF8_Decode (Label));
         Item.Value       := To_Unbounded_Wide_Wide_String (UTF8_Decode (Value));
         Item.Description := To_Unbounded_Wide_Wide_String (UTF8_Decode (Description));
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item_Wide (Label       : in Wide_Wide_String;
                                     Value       : in Wide_Wide_String;
                                     Description : in Wide_Wide_String := "";
                                     Disabled    : in Boolean := False;
                                     Escaped     : in Boolean := True) return Select_Item is
      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         Item.Description := To_Unbounded_Wide_Wide_String (Description);
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item_Wide;

   --  ------------------------------
   --  Creates a Select_Item with the specified label, value and description.
   --  The objects are converted to a wide wide string.  The empty string is used if they
   --  are null.
   --  ------------------------------
   function Create_Select_Item (Label       : in Util.Beans.Objects.Object;
                                Value       : in Util.Beans.Objects.Object;
                                Description : in Util.Beans.Objects.Object;
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      use Util.Beans.Objects;

      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Access := Result.Item.Value;
      begin
         if not Is_Null (Label) then
            Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         end if;
         if not Is_Null (Value) then
            Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         end if;
         if not Is_Null (Description) then
            Item.Description := To_Unbounded_Wide_Wide_String (Description);
         end if;
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Get the item label.
   --  ------------------------------
   function Get_Label (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Label);
      end if;
   end Get_Label;

   --  ------------------------------
   --  Get the item value.
   --  ------------------------------
   function Get_Value (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Value);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the item description.
   --  ------------------------------
   function Get_Description (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Description);
      end if;
   end Get_Description;

   --  ------------------------------
   --  Returns true if the item is disabled.
   --  ------------------------------
   function Is_Disabled (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Disabled;
      end if;
   end Is_Disabled;

   --  ------------------------------
   --  Returns true if the label must be escaped using HTML escape rules.
   --  ------------------------------
   function Is_Escaped (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Escape;
      end if;
   end Is_Escaped;

   --  ------------------------------
   --  Returns true if the select item component is empty.
   --  ------------------------------
   function Is_Empty (Item : in Select_Item) return Boolean is
   begin
      return Item.Item.Is_Null;
   end Is_Empty;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Select_Item;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      end if;
      declare
         Item : constant Select_Item_Record_Access := From.Item.Value;
      begin
         if Name = "name" then
            return Util.Beans.Objects.To_Object (Item.Label);
         elsif Name = "value" then
            return Util.Beans.Objects.To_Object (Item.Value);
         elsif Name = "description" then
            return Util.Beans.Objects.To_Object (Item.Description);
         elsif Name = "disabled" then
            return Util.Beans.Objects.To_Object (Item.Disabled);
         elsif Name = "escaped" then
            return Util.Beans.Objects.To_Object (Item.Escape);
         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end;
   end Get_Value;

   --  ------------------------------
   --  Select Item List
   --  ------------------------------

   --  ------------------------------
   --  Return an Object from the select item list.
   --  Returns a NULL object if the list is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      if Item.List.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_List_Access := new Select_Item_List;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item_List instance from a generic bean object.
   --  Returns an empty list if the object does not hold a Select_Item_List.
   --  ------------------------------
   function To_Select_Item_List (Object : in Util.Beans.Objects.Object) return Select_Item_List is
      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item_List;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item_List'Class) then
         return Result;
      end if;
      Result := Select_Item_List (Bean.all);
      return Result;
   end To_Select_Item_List;

   --  ------------------------------
   --  Get the number of elements in the list.
   --  ------------------------------
   overriding
   function Get_Count (From : in Select_Item_List) return Natural is
   begin
      return From.Length;
   end Get_Count;

   --  ------------------------------
   --  Set the current row index.  Valid row indexes start at 1.
   --  ------------------------------
   overriding
   procedure Set_Row_Index (From  : in out Select_Item_List;
                            Index : in Natural) is
   begin
      From.Current := From.Get_Select_Item (Index);
      From.Row     := Util.Beans.Objects.To_Object (From.Current'Unchecked_Access,
                                                    Util.Beans.Objects.STATIC);
   end Set_Row_Index;

   --  ------------------------------
   --  Get the element at the current row index.
   --  ------------------------------
   overriding
   function Get_Row (From  : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      return From.Row;
   end Get_Row;

   --  ------------------------------
   --  Get the number of items in the list.
   --  ------------------------------
   function Length (List : in Select_Item_List) return Natural is
   begin
      if List.List.Is_Null then
         return 0;
      else
         return Natural (List.List.Value.List.Length);
      end if;
   end Length;

   --  ------------------------------
   --  Get the select item from the list
   --  ------------------------------
   function Get_Select_Item (List : in Select_Item_List'Class;
                             Pos  : in Positive) return Select_Item is
   begin
      if List.List.Is_Null then
         raise Constraint_Error with "Select item list is empty";
      end if;
      return List.List.Value.List.Element (Pos);
   end Get_Select_Item;

   --  ------------------------------
   --  Add the item at the end of the list.
   --  ------------------------------
   procedure Append (List : in out Select_Item_List;
                     Item : in Select_Item'Class) is
   begin
      if List.List.Is_Null then
         List.List := Select_Item_Vector_Refs.Create;
      end if;
      List.List.Value.all.List.Append (Select_Item (Item));
   end Append;

   --  ------------------------------
   --  Add the item at the end of the list.  This is a shortcut for
   --  Append (Create_List_Item (Label, Value))
   --  ------------------------------
   procedure Append (List  : in out Select_Item_List;
                     Label : in String;
                     Value : in String) is
   begin
      List.Append (Create_Select_Item (Label, Value));
   end Append;

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

end ASF.Models.Selects;

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

with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
package body ASF.Models.Selects is

   function UTF8_Decode (S : in String) return Wide_Wide_String
      renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Decode;

   --  ------------------------------
   --  Return an Object from the select item record.
   --  Returns a NULL object if the item is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item) return Util.Beans.Objects.Object is
   begin
      if Item.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_Access := new Select_Item;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item instance from a generic bean object.
   --  Returns an empty item if the object does not hold a Select_Item.
   --  ------------------------------
   function To_Select_Item (Object : in Util.Beans.Objects.Object) return Select_Item is
      Bean   : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item'Class) then
         return Result;
      end if;
      Result := Select_Item (Bean.all);
      return Result;
   end To_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item (Label       : in String;
                                Value       : in String;
                                Description : in String := "";
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Accessor := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (UTF8_Decode (Label));
         Item.Value       := To_Unbounded_Wide_Wide_String (UTF8_Decode (Value));
         Item.Description := To_Unbounded_Wide_Wide_String (UTF8_Decode (Description));
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Creates a Select_Item with the specified label and value.
   --  ------------------------------
   function Create_Select_Item_Wide (Label       : in Wide_Wide_String;
                                     Value       : in Wide_Wide_String;
                                     Description : in Wide_Wide_String := "";
                                     Disabled    : in Boolean := False;
                                     Escaped     : in Boolean := True) return Select_Item is
      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Accessor := Result.Item.Value;
      begin
         Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         Item.Description := To_Unbounded_Wide_Wide_String (Description);
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item_Wide;

   --  ------------------------------
   --  Creates a Select_Item with the specified label, value and description.
   --  The objects are converted to a wide wide string.  The empty string is used if they
   --  are null.
   --  ------------------------------
   function Create_Select_Item (Label       : in Util.Beans.Objects.Object;
                                Value       : in Util.Beans.Objects.Object;
                                Description : in Util.Beans.Objects.Object;
                                Disabled    : in Boolean := False;
                                Escaped     : in Boolean := True) return Select_Item is
      use Util.Beans.Objects;

      Result : Select_Item;
   begin
      Result.Item := Select_Item_Refs.Create;
      declare
         Item : constant Select_Item_Record_Accessor := Result.Item.Value;
      begin
         if not Is_Null (Label) then
            Item.Label       := To_Unbounded_Wide_Wide_String (Label);
         end if;
         if not Is_Null (Value) then
            Item.Value       := To_Unbounded_Wide_Wide_String (Value);
         end if;
         if not Is_Null (Description) then
            Item.Description := To_Unbounded_Wide_Wide_String (Description);
         end if;
         Item.Disabled    := Disabled;
         Item.Escape      := Escaped;
      end;
      return Result;
   end Create_Select_Item;

   --  ------------------------------
   --  Get the item label.
   --  ------------------------------
   function Get_Label (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Label);
      end if;
   end Get_Label;

   --  ------------------------------
   --  Get the item value.
   --  ------------------------------
   function Get_Value (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Value);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the item description.
   --  ------------------------------
   function Get_Description (Item : in Select_Item) return Wide_Wide_String is
   begin
      if Item.Item.Is_Null then
         return "";
      else
         return To_Wide_Wide_String (Item.Item.Value.Description);
      end if;
   end Get_Description;

   --  ------------------------------
   --  Returns true if the item is disabled.
   --  ------------------------------
   function Is_Disabled (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Disabled;
      end if;
   end Is_Disabled;

   --  ------------------------------
   --  Returns true if the label must be escaped using HTML escape rules.
   --  ------------------------------
   function Is_Escaped (Item : in Select_Item) return Boolean is
   begin
      if Item.Item.Is_Null then
         return False;
      else
         return Item.Item.Value.Escape;
      end if;
   end Is_Escaped;

   --  ------------------------------
   --  Returns true if the select item component is empty.
   --  ------------------------------
   function Is_Empty (Item : in Select_Item) return Boolean is
   begin
      return Item.Item.Is_Null;
   end Is_Empty;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Select_Item;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Item.Is_Null then
         return Util.Beans.Objects.Null_Object;
      end if;
      declare
         Item : constant Select_Item_Record_Accessor := From.Item.Value;
      begin
         if Name = "name" then
            return Util.Beans.Objects.To_Object (Item.Label);
         elsif Name = "value" then
            return Util.Beans.Objects.To_Object (Item.Value);
         elsif Name = "description" then
            return Util.Beans.Objects.To_Object (Item.Description);
         elsif Name = "disabled" then
            return Util.Beans.Objects.To_Object (Item.Disabled);
         elsif Name = "escaped" then
            return Util.Beans.Objects.To_Object (Item.Escape);
         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end;
   end Get_Value;

   --  ------------------------------
   --  Select Item List
   --  ------------------------------

   --  ------------------------------
   --  Return an Object from the select item list.
   --  Returns a NULL object if the list is empty.
   --  ------------------------------
   function To_Object (Item : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      if Item.List.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         declare
            Bean : constant Select_Item_List_Access := new Select_Item_List;
         begin
            Bean.all := Item;
            return Util.Beans.Objects.To_Object (Bean.all'Access);
         end;
      end if;
   end To_Object;

   --  ------------------------------
   --  Return the Select_Item_List instance from a generic bean object.
   --  Returns an empty list if the object does not hold a Select_Item_List.
   --  ------------------------------
   function To_Select_Item_List (Object : in Util.Beans.Objects.Object) return Select_Item_List is
      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class
        := Util.Beans.Objects.To_Bean (Object);
      Result : Select_Item_List;
   begin
      if Bean = null then
         return Result;
      end if;
      if not (Bean.all in Select_Item_List'Class) then
         return Result;
      end if;
      Result := Select_Item_List (Bean.all);
      return Result;
   end To_Select_Item_List;

   --  ------------------------------
   --  Get the number of elements in the list.
   --  ------------------------------
   overriding
   function Get_Count (From : in Select_Item_List) return Natural is
   begin
      return From.Length;
   end Get_Count;

   --  ------------------------------
   --  Set the current row index.  Valid row indexes start at 1.
   --  ------------------------------
   overriding
   procedure Set_Row_Index (From  : in out Select_Item_List;
                            Index : in Natural) is
   begin
      From.Current := From.Get_Select_Item (Index);
      From.Row     := Util.Beans.Objects.To_Object (From.Current'Unchecked_Access,
                                                    Util.Beans.Objects.STATIC);
   end Set_Row_Index;

   --  ------------------------------
   --  Get the element at the current row index.
   --  ------------------------------
   overriding
   function Get_Row (From  : in Select_Item_List) return Util.Beans.Objects.Object is
   begin
      return From.Row;
   end Get_Row;

   --  ------------------------------
   --  Get the number of items in the list.
   --  ------------------------------
   function Length (List : in Select_Item_List) return Natural is
   begin
      if List.List.Is_Null then
         return 0;
      else
         return Natural (List.List.Value.List.Length);
      end if;
   end Length;

   --  ------------------------------
   --  Get the select item from the list
   --  ------------------------------
   function Get_Select_Item (List : in Select_Item_List'Class;
                             Pos  : in Positive) return Select_Item is
   begin
      if List.List.Is_Null then
         raise Constraint_Error with "Select item list is empty";
      end if;
      return List.List.Value.List.Element (Pos);
   end Get_Select_Item;

   --  ------------------------------
   --  Add the item at the end of the list.
   --  ------------------------------
   procedure Append (List : in out Select_Item_List;
                     Item : in Select_Item'Class) is
   begin
      if List.List.Is_Null then
         List.List := Select_Item_Vector_Refs.Create;
      end if;
      List.List.Value.List.Append (Select_Item (Item));
   end Append;

   --  ------------------------------
   --  Add the item at the end of the list.  This is a shortcut for
   --  Append (Create_List_Item (Label, Value))
   --  ------------------------------
   procedure Append (List  : in out Select_Item_List;
                     Label : in String;
                     Value : in String) is
   begin
      List.Append (Create_Select_Item (Label, Value));
   end Append;

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

end ASF.Models.Selects;

Update to use Implicit_Deference

Update to use Implicit_Deference


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

--  The Util.Encodes.HMAC.SHA256 package generates HMAC-SHA256 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA256 is

   --  Sign the data string with the key and return the HMAC-SHA256 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA256 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA256 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA256.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA256 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Hash_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Digest);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA256.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA256.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA256;

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

--  The Util.Encodes.HMAC.SHA256 package generates HMAC-SHA256 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA256 is

   HASH_SIZE : constant := Util.Encoders.SHA256.HASH_SIZE;

   --  Sign the data string with the key and return the HMAC-SHA256 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA256 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA256 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA256.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA256 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Hash_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Digest);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA256.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA256.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA256;

Declare the HASH_SIZE constant

Declare the HASH_SIZE constant


-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 2017, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log;
with Util.Commands.Parsers;
private with Ada.Strings.Unbounded;
private with Ada.Containers.Indefinite_Ordered_Maps;

--  == Command line driver ==
--  The <tt>Util.Commands.Drivers</tt> generic package provides a support to build command line
--  tools that have different commands identified by a name.
generic
   --  The command execution context.
   type Context_Type (<>) is limited private;
   with package Config_Parser is new Util.Commands.Parsers.Config_Parser (<>);
   Driver_Name : String := "Drivers";
package Util.Commands.Drivers is

   subtype Config_Type is Config_Parser.Config_Type;

   --  A simple command handler executed when the command with the given name is executed.
   type Command_Handler is not null access procedure (Name    : in String;
                                                      Args    : in Argument_List'Class;
                                                      Context : in out Context_Type);

   --  A more complex command handler that has a command instance as context.
   type Command_Type is abstract tagged limited private;
   type Command_Access is access all Command_Type'Class;

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is abstract;

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Command_Type;
                    Config  : in out Config_Type;
                    Context : in out Context_Type) is null;

   --  Write the help associated with the command.
   procedure Help (Command   : in out Command_Type;
                   Context   : in out Context_Type) is abstract;

   --  Write the command usage.
   procedure Usage (Command : in out Command_Type;
                    Name    : in String;
                    Context : in out Context_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

   type Help_Command_Type is new Command_Type with private;

   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   overriding
   procedure Execute (Command   : in out Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in out Help_Command_Type;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited private;

   --  Report the command usage.
   procedure Usage (Driver  : in Driver_Type;
                    Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "");

   --  Set the driver description printed in the usage.
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String);

   --  Set the driver usage printed in the usage.
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String);

   --  Register the command under the given name.
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access);

   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Command     : in Command_Access);

   --  Register the command under the given name.
   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Handler     : in Command_Handler);

   --  Find the command having the given name.
   --  Returns null if the command was not found.
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access;

   --  Execute the command registered under the given name.
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

private

   package Command_Maps is
     new Ada.Containers.Indefinite_Ordered_Maps (Key_Type     => String,
                                                 Element_Type => Command_Access,
                                                 "<"          => "<");

   type Command_Type is abstract tagged limited record
      Driver      : access Driver_Type'Class;
      Description : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Help_Command_Type is new Command_Type with null record;

   type Handler_Command_Type is new Command_Type with record
      Handler : Command_Handler;
   end record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Command   : in out Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in out Handler_Command_Type;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited record
      List  : Command_Maps.Map;
      Desc  : Ada.Strings.Unbounded.Unbounded_String;
      Usage : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Util.Commands.Drivers;

-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 2017, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log;
with Util.Commands.Parsers;
private with Ada.Strings.Unbounded;
private with Ada.Containers.Indefinite_Ordered_Maps;

--  == Command line driver ==
--  The <tt>Util.Commands.Drivers</tt> generic package provides a support to build command line
--  tools that have different commands identified by a name.
generic
   --  The command execution context.
   type Context_Type (<>) is limited private;
   with package Config_Parser is new Util.Commands.Parsers.Config_Parser (<>);
   Driver_Name : String := "Drivers";
package Util.Commands.Drivers is

   subtype Config_Type is Config_Parser.Config_Type;

   --  A simple command handler executed when the command with the given name is executed.
   type Command_Handler is not null access procedure (Name    : in String;
                                                      Args    : in Argument_List'Class;
                                                      Context : in out Context_Type);

   --  A more complex command handler that has a command instance as context.
   type Command_Type is abstract tagged limited private;
   type Command_Access is access all Command_Type'Class;

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is abstract;

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Command_Type;
                    Config  : in out Config_Type;
                    Context : in out Context_Type) is null;

   --  Write the help associated with the command.
   procedure Help (Command   : in out Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is abstract;

   --  Write the command usage.
   procedure Usage (Command : in out Command_Type;
                    Name    : in String;
                    Context : in out Context_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

   type Help_Command_Type is new Command_Type with private;

   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   overriding
   procedure Execute (Command   : in out Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in out Help_Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited private;

   --  Report the command usage.
   procedure Usage (Driver  : in Driver_Type;
                    Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "");

   --  Set the driver description printed in the usage.
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String);

   --  Set the driver usage printed in the usage.
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String);

   --  Register the command under the given name.
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access);

   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Command     : in Command_Access);

   --  Register the command under the given name.
   procedure Add_Command (Driver      : in out Driver_Type;
                          Name        : in String;
                          Description : in String;
                          Handler     : in Command_Handler);

   --  Find the command having the given name.
   --  Returns null if the command was not found.
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access;

   --  Execute the command registered under the given name.
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

private

   package Command_Maps is
     new Ada.Containers.Indefinite_Ordered_Maps (Key_Type     => String,
                                                 Element_Type => Command_Access,
                                                 "<"          => "<");

   type Command_Type is abstract tagged limited record
      Driver      : access Driver_Type'Class;
      Description : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Help_Command_Type is new Command_Type with null record;

   type Handler_Command_Type is new Command_Type with record
      Handler : Command_Handler;
   end record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Command   : in out Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in out Handler_Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited record
      List  : Command_Maps.Map;
      Desc  : Ada.Strings.Unbounded.Unbounded_String;
      Usage : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Util.Commands.Drivers;

Add Name parameter to the Help procedure


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

with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with ASF.Helpers.Beans;

with Wiki.Strings;
with Wiki.Attributes;
with Wiki.Plugins.Templates;

with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Components.Wikis;

--  == Wiki Beans ==
--  Several bean types are provided to represent and manage the blogs and their posts.
--  The blog module registers the bean constructors when it is initialized.
--  To use them, one must declare a bean definition in the application XML configuration.
--
--  == Ada Beans ==
--  @include wikis.xml
package AWA.Wikis.Beans is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wiki_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Wiki_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Wiki_Links_Bean;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  The Wiki template plugin that retrieves the template content from the Wiki space.
   type Wiki_Template_Bean is new Wiki.Plugins.Templates.Template_Plugin
      and Util.Beans.Basic.Readonly_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Template_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Get the template content for the plugin evaluation.
   overriding
   procedure Get_Template (Plugin   : in out Wiki_Template_Bean;
                           Params   : in out Wiki.Attributes.Attribute_List;
                           Template : out Wiki.Strings.UString);

   type Wiki_View_Bean is new AWA.Wikis.Models.Wiki_View_Info with record
      --  The wiki module instance.
      Module        : Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;

      --  List of tags associated with the wiki page.
      Tags          : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean     : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read page counter associated with the wiki page.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.WIKI_PAGE_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki page links.
      Links         : aliased Wiki_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki plugins.
      Plugins       : aliased Wiki_Template_Bean;
      Plugins_Bean  : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_View_Bean_Access is access all Wiki_View_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_View_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_View_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the information about the wiki page to display it.
   overriding
   procedure Load (Bean    : in out Wiki_View_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_View_Bean bean instance.
   function Create_Wiki_View_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   function Get_Wiki_View_Bean is
     new ASF.Helpers.Beans.Get_Bean (Element_Type   => Wiki_View_Bean,
                                     Element_Access => Wiki_View_Bean_Access);

   --  Get a select item list which contains a list of wiki formats.
   function Create_Format_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Module    : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki space.
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki space information.
   overriding
   procedure Load (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Page Bean
   --  ------------------------------
   --  The <tt>Wiki_Page_Bean</tt> is used to edit a wiki page.  The model type inherit from
   --  the <tt>Wiki_Page</tt> and the wiki page text is hold in the <tt>Content</tt> member.
   --  When a new content is updated, the <tt>Set_Value</tt> procedure sets it in the
   --  <tt>New_Content</tt> member.  It is compared to the current wiki text to decide whether
   --  we have to create a new version or not.
   type Wiki_Page_Bean is new AWA.Wikis.Models.Wiki_Page_Bean with record
      Module     : Modules.Wiki_Module_Access := null;

      --  The page content.
      Content     : Models.Wiki_Content_Ref;
      Has_Content : Boolean := False;
      Format      : AWA.Wikis.Models.Format_Type := AWA.Wikis.Models.FORMAT_CREOLE;
      New_Content : Ada.Strings.Unbounded.Unbounded_String;
      New_Comment : Ada.Strings.Unbounded.Unbounded_String;

      Wiki_Space  : Wiki_Space_Bean;

      --  List of tags associated with the wiki page.
      Tags        : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean   : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Page_Bean_Access is access all Wiki_Page_Bean'Class;

   --  Returns True if the wiki page has a new text content and requires
   --  a new version to be created.
   function Has_New_Content (Bean : in Wiki_Page_Bean) return Boolean;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Page_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Page_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki page.
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki page.
   overriding
   procedure Load (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Setup the wiki page for the creation.
   overriding
   procedure Setup (Bean    : in out Wiki_Page_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Page_Bean bean instance.
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki List Bean
   --  ------------------------------
   --  The Wiki_List_Bean gives a list of visible wikis to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Wiki_List_Bean is new AWA.Wikis.Models.Wiki_Page_List_Bean with record
      Module     : Modules.Wiki_Module_Access := null;
      Pages      : aliased AWA.Wikis.Models.Wiki_Page_Info_List_Bean;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Pages_Bean : AWA.Wikis.Models.Wiki_Page_Info_List_Bean_Access;
   end record;
   type Wiki_List_Bean_Access is access all Wiki_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Wiki_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of pages.  If a tag was set, filter the list of pages with the tag.
   procedure Load_List (Into : in out Wiki_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Version List Bean
   --  ------------------------------
   type Wiki_Version_List_Bean is new AWA.Wikis.Models.Wiki_Version_List_Bean with record
      Module        : Modules.Wiki_Module_Access := null;
      Versions      : aliased AWA.Wikis.Models.Wiki_Version_Info_List_Bean;
      Versions_Bean : AWA.Wikis.Models.Wiki_Version_Info_List_Bean_Access;
   end record;
   type Wiki_Version_List_Bean_Access is access all Wiki_Version_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Version_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Version_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (Into    : in out Wiki_Version_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_Version_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                           return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_WIKI_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Wiki_Admin_Bean is used for the administration of a wiki.  It gives the
   --  list of wikis and pages that are created, published or not.
   type Wiki_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Wikis.Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Wiki_List        : aliased AWA.Wikis.Models.Wiki_Info_List_Bean;
      Wiki_List_Bean   : AWA.Wikis.Models.Wiki_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Wiki_Admin_Bean_Access is access all Wiki_Admin_Bean;

   --  Get the wiki space identifier.
   function Get_Wiki_Id (List : in Wiki_Admin_Bean) return ADO.Identifier;

   overriding
   function Get_Value (List : in Wiki_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of wikis.
   procedure Load_Wikis (List : in Wiki_Admin_Bean);

   --  Create the Wiki_Admin_Bean bean instance.
   function Create_Wiki_Admin_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

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

with Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with ASF.Helpers.Beans;

with Wiki.Strings;
with Wiki.Attributes;
with Wiki.Plugins.Templates;

with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Components.Wikis;

--  == Wiki Beans ==
--  Several bean types are provided to represent and manage the blogs and their posts.
--  The blog module registers the bean constructors when it is initialized.
--  To use them, one must declare a bean definition in the application XML configuration.
--
--  == Ada Beans ==
--  @include wikis.xml
package AWA.Wikis.Beans is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wiki_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Wiki_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Wiki_Links_Bean;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  The Wiki template plugin that retrieves the template content from the Wiki space.
   type Wiki_Template_Bean is new Wiki.Plugins.Templates.Template_Plugin
      and Wiki.Plugins.Plugin_Factory
      and Util.Beans.Basic.Readonly_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Template_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Get the template content for the plugin evaluation.
   overriding
   procedure Get_Template (Plugin   : in out Wiki_Template_Bean;
                           Params   : in out Wiki.Attributes.Attribute_List;
                           Template : out Wiki.Strings.UString);

   --  Find a plugin knowing its name.
   overriding
   function Find (Factory : in Wiki_Template_Bean;
                  Name    : in String) return Wiki.Plugins.Wiki_Plugin_Access;

   type Wiki_View_Bean is new AWA.Wikis.Models.Wiki_View_Info with record
      --  The wiki module instance.
      Module        : Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;

      --  List of tags associated with the wiki page.
      Tags          : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean     : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read page counter associated with the wiki page.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.WIKI_PAGE_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki page links.
      Links         : aliased Wiki_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki plugins.
      Plugins       : aliased Wiki_Template_Bean;
      Plugins_Bean  : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_View_Bean_Access is access all Wiki_View_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_View_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_View_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the information about the wiki page to display it.
   overriding
   procedure Load (Bean    : in out Wiki_View_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_View_Bean bean instance.
   function Create_Wiki_View_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   function Get_Wiki_View_Bean is
     new ASF.Helpers.Beans.Get_Bean (Element_Type   => Wiki_View_Bean,
                                     Element_Access => Wiki_View_Bean_Access);

   --  Get a select item list which contains a list of wiki formats.
   function Create_Format_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Module    : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Space_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Space_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki space.
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki space information.
   overriding
   procedure Load (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Page Bean
   --  ------------------------------
   --  The <tt>Wiki_Page_Bean</tt> is used to edit a wiki page.  The model type inherit from
   --  the <tt>Wiki_Page</tt> and the wiki page text is hold in the <tt>Content</tt> member.
   --  When a new content is updated, the <tt>Set_Value</tt> procedure sets it in the
   --  <tt>New_Content</tt> member.  It is compared to the current wiki text to decide whether
   --  we have to create a new version or not.
   type Wiki_Page_Bean is new AWA.Wikis.Models.Wiki_Page_Bean with record
      Module     : Modules.Wiki_Module_Access := null;

      --  The page content.
      Content     : Models.Wiki_Content_Ref;
      Has_Content : Boolean := False;
      Format      : AWA.Wikis.Models.Format_Type := AWA.Wikis.Models.FORMAT_CREOLE;
      New_Content : Ada.Strings.Unbounded.Unbounded_String;
      New_Comment : Ada.Strings.Unbounded.Unbounded_String;

      Wiki_Space  : Wiki_Space_Bean;

      --  List of tags associated with the wiki page.
      Tags        : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean   : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Page_Bean_Access is access all Wiki_Page_Bean'Class;

   --  Returns True if the wiki page has a new text content and requires
   --  a new version to be created.
   function Has_New_Content (Bean : in Wiki_Page_Bean) return Boolean;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Page_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Page_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the wiki page.
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki page.
   overriding
   procedure Load (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Setup the wiki page for the creation.
   overriding
   procedure Setup (Bean    : in out Wiki_Page_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Page_Bean bean instance.
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki List Bean
   --  ------------------------------
   --  The Wiki_List_Bean gives a list of visible wikis to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Wiki_List_Bean is new AWA.Wikis.Models.Wiki_Page_List_Bean with record
      Module     : Modules.Wiki_Module_Access := null;
      Pages      : aliased AWA.Wikis.Models.Wiki_Page_Info_List_Bean;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Pages_Bean : AWA.Wikis.Models.Wiki_Page_Info_List_Bean_Access;
   end record;
   type Wiki_List_Bean_Access is access all Wiki_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Wiki_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of pages.  If a tag was set, filter the list of pages with the tag.
   procedure Load_List (Into : in out Wiki_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Version List Bean
   --  ------------------------------
   type Wiki_Version_List_Bean is new AWA.Wikis.Models.Wiki_Version_List_Bean with record
      Module        : Modules.Wiki_Module_Access := null;
      Versions      : aliased AWA.Wikis.Models.Wiki_Version_Info_List_Bean;
      Versions_Bean : AWA.Wikis.Models.Wiki_Version_Info_List_Bean_Access;
   end record;
   type Wiki_Version_List_Bean_Access is access all Wiki_Version_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Wiki_Version_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Version_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (Into    : in out Wiki_Version_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_Version_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                           return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_WIKI_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Wiki_Admin_Bean is used for the administration of a wiki.  It gives the
   --  list of wikis and pages that are created, published or not.
   type Wiki_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Wikis.Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Wiki_List        : aliased AWA.Wikis.Models.Wiki_Info_List_Bean;
      Wiki_List_Bean   : AWA.Wikis.Models.Wiki_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Wiki_Admin_Bean_Access is access all Wiki_Admin_Bean;

   --  Get the wiki space identifier.
   function Get_Wiki_Id (List : in Wiki_Admin_Bean) return ADO.Identifier;

   overriding
   function Get_Value (List : in Wiki_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Wiki_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of wikis.
   procedure Load_Wikis (List : in Wiki_Admin_Bean);

   --  Create the Wiki_Admin_Bean bean instance.
   function Create_Wiki_Admin_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

Update the Wiki_Template_Bean type to implement the Plugin factory interface Declare the Find procedure


-----------------------------------------------------------------------
--  security-policies-roles -- Role based policies
--  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 Util.Log.Loggers;
with Util.Serialize.Mappers.Record_Mapper;

with Security.Controllers;
with Security.Controllers.Roles;

package body Security.Policies.Roles is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Security.Policies.Roles");

   --  ------------------------------
   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   --  ------------------------------
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in Role_Map) is
      Policy : constant Security.Policies.Policy_Access := Context.Get_Policy (NAME);
      Data   : Role_Policy_Context_Access;
   begin
      if Policy = null then
         Log.Error ("There is no security policy: " & NAME);
      end if;
      Data := new Role_Policy_Context;
      Data.Roles := Roles;

      Context.Set_Policy_Context (Policy, Data.all'Access);
   end Set_Role_Context;

   --  ------------------------------
   --  Get the policy name.
   --  ------------------------------
   overriding
   function Get_Name (From : in Role_Policy) return String is
      pragma Unreferenced (From);
   begin
      return NAME;
   end Get_Name;

   --  ------------------------------
   --  Get the role name.
   --  ------------------------------
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      if Manager.Names (Role) = null then
         return "";
      else
         return Manager.Names (Role).all;
      end if;
   end Get_Role_Name;

   --  ------------------------------
   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   --  ------------------------------
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      Log.Debug ("Searching role {0}", Name);

      for I in Role_Type'First .. Manager.Next_Role loop
         exit when Manager.Names (I) = null;
         if Name = Manager.Names (I).all then
            return I;
         end if;
      end loop;

      Log.Debug ("Role {0} not found", Name);
      raise Invalid_Name;
   end Find_Role;

   --  ------------------------------
   --  Create a role
   --  ------------------------------
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type) is
   begin
      Role := Manager.Next_Role;
      Log.Info ("Role {0} is {1}", Name, Role_Type'Image (Role));

      if Manager.Next_Role = Role_Type'Last then
         Log.Error ("Too many roles allocated.  Number of roles is {0}",
                    Role_Type'Image (Role_Type'Last));
      else
         Manager.Next_Role := Manager.Next_Role + 1;
      end if;
      Manager.Names (Role) := new String '(Name);
   end Create_Role;

   --  ------------------------------
   --  Get or build a permission type for the given name.
   --  ------------------------------
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type) is
   begin
      Result := Manager.Find_Role (Name);

   exception
      when Invalid_Name =>
         Manager.Create_Role (Name, Result);
   end Add_Role_Type;

   type Config_Fields is (FIELD_NAME, FIELD_ROLE, FIELD_ROLE_PERMISSION, FIELD_ROLE_NAME);

   type Controller_Config_Access is access all Controller_Config;

   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Called while parsing the XML policy file when the <name>, <role> and <role-permission>
   --  XML entities are found.  Create the new permission when the complete permission definition
   --  has been parsed and save the permission in the security manager.
   --  ------------------------------
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use Security.Controllers.Roles;
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_ROLE =>
            declare
               Role : constant String := Util.Beans.Objects.To_String (Value);
            begin
               Into.Roles (Into.Count + 1) := Into.Manager.Find_Role (Role);
               Into.Count := Into.Count + 1;

            exception
               when Permissions.Invalid_Name =>
                  raise Util.Serialize.Mappers.Field_Error with "Invalid role: " & Role;
            end;

         when FIELD_ROLE_PERMISSION =>
            if Into.Count = 0 then
               raise Util.Serialize.Mappers.Field_Error with "Missing at least one role";
            end if;
            declare
               Name : constant String := Util.Beans.Objects.To_String (Into.Name);
               Perm : constant Role_Controller_Access
                 := new Role_Controller '(Count => Into.Count,
                                          Roles => Into.Roles (1 .. Into.Count));
            begin
               Into.Manager.Add_Permission (Name, Perm.all'Access);
               Into.Count := 0;
            end;

         when FIELD_ROLE_NAME =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Value);
               Role : Role_Type;
            begin
               Into.Manager.Add_Role_Type (Name, Role);
            end;
      end case;
   end Set_Member;

   package Config_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Controller_Config,
                                               Element_Type_Access => Controller_Config_Access,
                                               Fields              => Config_Fields,
                                               Set_Member          => Set_Member);

   Mapper : aliased Config_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the role-permission description.
   --  ------------------------------
   procedure Prepare_Config (Policy : in out Role_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser) is
      Config : Controller_Config_Access := new Controller_Config;
   begin
      Reader.Add_Mapping ("policy-rules", Mapper'Access);
      Reader.Add_Mapping ("module", Mapper'Access);
      Config.Manager := Policy'Unchecked_Access;
      Config_Mapper.Set_Context (Reader, Config);
   end Prepare_Config;

   --  ------------------------------
   --  Finalize the policy manager.
   --  ------------------------------
   overriding
   procedure Finalize (Policy : in out Role_Policy) is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      for I in Policy.Names'Range loop
         exit when Policy.Names (I) = null;
         Ada.Strings.Unbounded.Free (Policy.Names (I));
      end loop;
   end Finalize;

begin
   Mapper.Add_Mapping ("role-permission", FIELD_ROLE_PERMISSION);
   Mapper.Add_Mapping ("role-permission/name", FIELD_NAME);
   Mapper.Add_Mapping ("role-permission/role", FIELD_ROLE);
   Mapper.Add_Mapping ("security-role/role-name", FIELD_ROLE_NAME);
end Security.Policies.Roles;

-----------------------------------------------------------------------
--  security-policies-roles -- Role based policies
--  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 Util.Log.Loggers;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Strings.Tokenizers;

with Security.Controllers;
with Security.Controllers.Roles;

package body Security.Policies.Roles is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Security.Policies.Roles");

   --  ------------------------------
   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   --  ------------------------------
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in Role_Map) is
      Policy : constant Security.Policies.Policy_Access := Context.Get_Policy (NAME);
      Data   : Role_Policy_Context_Access;
   begin
      if Policy = null then
         Log.Error ("There is no security policy: " & NAME);
      end if;
      Data := new Role_Policy_Context;
      Data.Roles := Roles;

      Context.Set_Policy_Context (Policy, Data.all'Access);
   end Set_Role_Context;

   --  ------------------------------
   --  Get the policy name.
   --  ------------------------------
   overriding
   function Get_Name (From : in Role_Policy) return String is
      pragma Unreferenced (From);
   begin
      return NAME;
   end Get_Name;

   --  ------------------------------
   --  Get the role name.
   --  ------------------------------
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      if Manager.Names (Role) = null then
         return "";
      else
         return Manager.Names (Role).all;
      end if;
   end Get_Role_Name;

   --  ------------------------------
   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   --  ------------------------------
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      Log.Debug ("Searching role {0}", Name);

      for I in Role_Type'First .. Manager.Next_Role loop
         exit when Manager.Names (I) = null;
         if Name = Manager.Names (I).all then
            return I;
         end if;
      end loop;

      Log.Debug ("Role {0} not found", Name);
      raise Invalid_Name;
   end Find_Role;

   --  ------------------------------
   --  Create a role
   --  ------------------------------
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type) is
   begin
      Role := Manager.Next_Role;
      Log.Info ("Role {0} is {1}", Name, Role_Type'Image (Role));

      if Manager.Next_Role = Role_Type'Last then
         Log.Error ("Too many roles allocated.  Number of roles is {0}",
                    Role_Type'Image (Role_Type'Last));
      else
         Manager.Next_Role := Manager.Next_Role + 1;
      end if;
      Manager.Names (Role) := new String '(Name);
   end Create_Role;

   --  ------------------------------
   --  Get or build a permission type for the given name.
   --  ------------------------------
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type) is
   begin
      Result := Manager.Find_Role (Name);

   exception
      when Invalid_Name =>
         Manager.Create_Role (Name, Result);
   end Add_Role_Type;

   --  ------------------------------
   --  Set the roles specified in the <tt>Roles</tt> parameter.  Each role is represented by
   --  its name and multiple roles are separated by ','.
   --  Raises Invalid_Name if a role was not found.
   --  ------------------------------
   procedure Set_Roles (Manager : in Role_Policy;
                        Roles   : in String;
                        Into    : out Role_Map) is
      procedure Process (Role : in String;
                         Done : out Boolean);

      procedure Process (Role : in String;
                         Done : out Boolean) is
      begin
         Into (Manager.Find_Role (Role)) := True;
         Done := False;
      end Process;

   begin
      Into := (others => False);
      Util.Strings.Tokenizers.Iterate_Tokens (Content => Roles,
                                              Pattern => ",",
                                              Process => Process'Access,
                                              Going   => Ada.Strings.Forward);
   end Set_Roles;

   type Config_Fields is (FIELD_NAME, FIELD_ROLE, FIELD_ROLE_PERMISSION, FIELD_ROLE_NAME);

   type Controller_Config_Access is access all Controller_Config;

   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Called while parsing the XML policy file when the <name>, <role> and <role-permission>
   --  XML entities are found.  Create the new permission when the complete permission definition
   --  has been parsed and save the permission in the security manager.
   --  ------------------------------
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use Security.Controllers.Roles;
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_ROLE =>
            declare
               Role : constant String := Util.Beans.Objects.To_String (Value);
            begin
               Into.Roles (Into.Count + 1) := Into.Manager.Find_Role (Role);
               Into.Count := Into.Count + 1;

            exception
               when Permissions.Invalid_Name =>
                  raise Util.Serialize.Mappers.Field_Error with "Invalid role: " & Role;
            end;

         when FIELD_ROLE_PERMISSION =>
            if Into.Count = 0 then
               raise Util.Serialize.Mappers.Field_Error with "Missing at least one role";
            end if;
            declare
               Name : constant String := Util.Beans.Objects.To_String (Into.Name);
               Perm : constant Role_Controller_Access
                 := new Role_Controller '(Count => Into.Count,
                                          Roles => Into.Roles (1 .. Into.Count));
            begin
               Into.Manager.Add_Permission (Name, Perm.all'Access);
               Into.Count := 0;
            end;

         when FIELD_ROLE_NAME =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Value);
               Role : Role_Type;
            begin
               Into.Manager.Add_Role_Type (Name, Role);
            end;
      end case;
   end Set_Member;

   package Config_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Controller_Config,
                                               Element_Type_Access => Controller_Config_Access,
                                               Fields              => Config_Fields,
                                               Set_Member          => Set_Member);

   Mapper : aliased Config_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the role-permission description.
   --  ------------------------------
   procedure Prepare_Config (Policy : in out Role_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser) is
      Config : Controller_Config_Access := new Controller_Config;
   begin
      Reader.Add_Mapping ("policy-rules", Mapper'Access);
      Reader.Add_Mapping ("module", Mapper'Access);
      Config.Manager := Policy'Unchecked_Access;
      Config_Mapper.Set_Context (Reader, Config);
   end Prepare_Config;

   --  ------------------------------
   --  Finalize the policy manager.
   --  ------------------------------
   overriding
   procedure Finalize (Policy : in out Role_Policy) is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      for I in Policy.Names'Range loop
         exit when Policy.Names (I) = null;
         Ada.Strings.Unbounded.Free (Policy.Names (I));
      end loop;
   end Finalize;

begin
   Mapper.Add_Mapping ("role-permission", FIELD_ROLE_PERMISSION);
   Mapper.Add_Mapping ("role-permission/name", FIELD_NAME);
   Mapper.Add_Mapping ("role-permission/role", FIELD_ROLE);
   Mapper.Add_Mapping ("security-role/role-name", FIELD_ROLE_NAME);
end Security.Policies.Roles;

Implement Set_Roles

Implement Set_Roles