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

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text, others => <>));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

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

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text, others => <>));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

Implement Is_Using_TOC and emit the N_TOC_DISPLAY node


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

with ASF.Components.Html;
with ASF.Contexts.Faces;
package ASF.Components.Widgets.Likes is

   --  ------------------------------
   --  UILike
   --  ------------------------------
   --  The <b>UILike</b> component displays a social like button to recommend a page.
   type UILike is new ASF.Components.Html.UIHtmlComponent with null record;

   --  Get the link to submit in the like action.
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String;

   --  Render the like button for Facebook or Google+.
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Like Generator
   --  ------------------------------
   --  The <tt>Like_Generator</tt> represents the specific method for the generation of
   --  a social like generator.  A generator is registered under a given name with the
   --  <tt>Register_Like</tt> operation.  The current implementation provides a Facebook
   --  like generator.
   type Like_Generator is limited interface;
   type Like_Generator_Access is access all Like_Generator'Class;

   --  Render the like button according to the generator and the component attributes.
   procedure Render_Like (Generator : in Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is abstract;

   --  Maximum number of generators that can be registered.
   MAX_LIKE_GENERATOR : constant Positive := 5;

   --  Register the like generator under the given name.
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access);

   --  ------------------------------
   --  Facebook like generator
   --  ------------------------------
   type Facebook_Like_Generator is new Like_Generator with null record;

   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Google like generator
   --  ------------------------------
   type Google_Like_Generator is new Like_Generator with null record;

   overriding
   procedure Render_Like (Generator : in Google_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Twitter like generator
   --  ------------------------------
   type Twitter_Like_Generator is new Like_Generator with null record;

   overriding
   procedure Render_Like (Generator : in Twitter_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

end ASF.Components.Widgets.Likes;

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

with ASF.Applications;
with ASF.Components.Html;
with ASF.Contexts.Faces;
package ASF.Components.Widgets.Likes is

   --  ------------------------------
   --  UILike
   --  ------------------------------
   --  The <b>UILike</b> component displays a social like button to recommend a page.
   type UILike is new ASF.Components.Html.UIHtmlComponent with null record;

   --  Get the link to submit in the like action.
   function Get_Link (UI      : in UILike;
                      Context : in ASF.Contexts.Faces.Faces_Context'Class) return String;

   --  Render the like button for Facebook or Google+.
   overriding
   procedure Encode_Begin (UI      : in UILike;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Like Generator
   --  ------------------------------
   --  The <tt>Like_Generator</tt> represents the specific method for the generation of
   --  a social like generator.  A generator is registered under a given name with the
   --  <tt>Register_Like</tt> operation.  The current implementation provides a Facebook
   --  like generator.
   type Like_Generator is limited interface;
   type Like_Generator_Access is access all Like_Generator'Class;

   --  Render the like button according to the generator and the component attributes.
   procedure Render_Like (Generator : in Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class) is abstract;

   --  Maximum number of generators that can be registered.
   MAX_LIKE_GENERATOR : constant Positive := 5;

   --  Register the like generator under the given name.
   procedure Register_Like (Name      : in Util.Strings.Name_Access;
                            Generator : in Like_Generator_Access);

   --  ------------------------------
   --  Facebook like generator
   --  ------------------------------
   type Facebook_Like_Generator is new Like_Generator with null record;

   overriding
   procedure Render_Like (Generator : in Facebook_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  The application configuration parameter that defines which Facebook client ID must be used.
   package P_Facebook_App_Id is
     new ASF.Applications.Parameter ("facebook.client_id", "");

   --  ------------------------------
   --  Google like generator
   --  ------------------------------
   type Google_Like_Generator is new Like_Generator with null record;

   overriding
   procedure Render_Like (Generator : in Google_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  Twitter like generator
   --  ------------------------------
   type Twitter_Like_Generator is new Like_Generator with null record;

   overriding
   procedure Render_Like (Generator : in Twitter_Like_Generator;
                          UI        : in UILike'Class;
                          Href      : in String;
                          Context   : in out ASF.Contexts.Faces.Faces_Context'Class);

end ASF.Components.Widgets.Likes;

Declare the P_Facebook_App_Id application configuration parameter


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

with Util.Log.Loggers;

with ASF.Principals;
with ASF.Sessions;
with ASF.Events.Faces.Actions;
with ASF.Contexts.Faces;
with ASF.Contexts.Flash;
with ASF.Cookies;
with ASF.Applications.Messages.Factory;
with ASF.Security.Filters;

with AWA.Services.Contexts;
package body AWA.Users.Beans is

   use Util.Log;
   use AWA.Users.Models;
   use ASF.Applications;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Users.Beans");

   --  Helper to send a remove cookie in the current response
   procedure Remove_Cookie (Name : in String);

   --  ------------------------------
   --  Action to register a user
   --  ------------------------------
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_signup_sent", Messages.INFO);

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

         Messages.Factory.Add_Message (Ctx.all, "users.signup_error_message");
   end Register_User;

   --  ------------------------------
   --  Action to verify the user after the registration
   --  ------------------------------
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      Principal : AWA.Users.Principals.Principal_Access;
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                IpAddr  => "",
                                Principal => Principal);

      Data.Set_Session_Principal (Principal);
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_registration_done", Messages.INFO);

   exception
      when Services.Not_Found =>
         Outcome := To_Unbounded_String ("failure");
         Messages.Factory.Add_Message (Ctx.all, "users.error_verify_register_key");
   end Verify_User;

   --  ------------------------------
   --  Action to trigger the lost password email process.
   --  ------------------------------
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_lost_password_sent", Messages.INFO);

   exception
      when Services.Not_Found =>
         Messages.Factory.Add_Message (Ctx.all, "users.error_email_not_found");

   end Lost_Password;

   --  ------------------------------
   --  Action to validate the reset password key and set a new password.
   --  ------------------------------
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
      Principal : AWA.Users.Principals.Principal_Access;
   begin
      Data.Manager.Reset_Password (Key       => To_String (Data.Access_Key),
                                   Password  => To_String (Data.Password),
                                   IpAddr    => "",
                                   Principal => Principal);
      Data.Set_Session_Principal (Principal);
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_reset_password_done", Messages.INFO);

   exception
      when Services.Not_Found =>
         Messages.Factory.Add_Message (Ctx.all, "users.error_reset_password");
   end Reset_Password;

   procedure Set_Session_Principal (Data      : in Authenticate_Bean;
                                    Principal : in AWA.Users.Principals.Principal_Access) is
      pragma Unreferenced (Data);

      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
   begin
      Session.Set_Principal (Principal.all'Access);
   end Set_Session_Principal;

   procedure Set_Authenticate_Cookie (Data    : in out Authenticate_Bean;
                                      Principal : in AWA.Users.Principals.Principal_Access) is
      Cookie : constant String := Data.Manager.Get_Authenticate_Cookie (Principal.Get_Session_Identifier);
      Ctx    : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      C      : ASF.Cookies.Cookie := ASF.Cookies.Create (ASF.Security.Filters.AID_COOKIE, Cookie);
   begin
      ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
      ASF.Cookies.Set_Max_Age (C, 15 * 86400);
      Ctx.Get_Response.Add_Cookie (Cookie => C);
   end Set_Authenticate_Cookie;

   --  ------------------------------
   --  Action to authenticate a user (password authentication).
   --  ------------------------------
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      Principal : AWA.Users.Principals.Principal_Access;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 Principal => Principal);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (Principal);
      Data.Set_Authenticate_Cookie (Principal);

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

         ASF.Applications.Messages.Factory.Add_Message ("users.login_signup_fail_message");
   end Authenticate_User;

   --  ------------------------------
   --  Helper to send a remove cookie in the current response
   --  ------------------------------
   procedure Remove_Cookie (Name : in String) is
      Ctx : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      C   : ASF.Cookies.Cookie := ASF.Cookies.Create (Name, "");
   begin
      ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
      ASF.Cookies.Set_Max_Age (C, 0);
      Ctx.Get_Response.Add_Cookie (Cookie => C);
   end Remove_Cookie;

   --  ------------------------------
   --  Logout the user and closes the session.
   --  ------------------------------
   procedure Logout_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      use type ASF.Principals.Principal_Access;

      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => False);
   begin
      Outcome := To_Unbounded_String ("success");

      --  If there is no session, we are done.
      if not Session.Is_Valid then
         return;
      end if;

      declare
         Principal : constant ASF.Principals.Principal_Access := Session.Get_Principal;
      begin
         if Principal /= null and then Principal.all in AWA.Users.Principals.Principal'Class then
            declare
               P : constant AWA.Users.Principals.Principal_Access :=
                 AWA.Users.Principals.Principal'Class (Principal.all)'Access;
            begin
               Data.Manager.Close_Session (Id => P.Get_Session_Identifier,
                                           Logout => True);

            exception
               when others =>
                  Log.Error ("Exception when closing user session...");
            end;
         end if;
         Session.Invalidate;
      end;

      --  Remove the session cookie.
      Remove_Cookie (ASF.Security.Filters.SID_COOKIE);
      Remove_Cookie (ASF.Security.Filters.AID_COOKIE);
   end Logout_User;

   --  ------------------------------
   --  Create an authenticate bean.
   --  ------------------------------
   function Create_Authenticate_Bean (Module : in AWA.Users.Modules.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Modules.Get_User_Manager;
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Authenticate_User,
                                                      Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Register_User,
                                                      Name   => "register");

   package Verify_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Verify_User,
                                                      Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Lost_Password,
                                                      Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Reset_Password,
                                                      Name   => "resetPassword");

   package Logout_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Logout_User,
                                                      Name   => "logout");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Access,
         Register_Binding.Proxy'Access,
         Verify_Binding.Proxy'Access,
         Lost_Password_Binding.Proxy'Access,
         Reset_Password_Binding.Proxy'Access,
         Logout_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = EMAIL_ATTR then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = PASSWORD_ATTR then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = FIRST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.First_Name);
      elsif Name = LAST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.Last_Name);
      elsif Name = KEY_ATTR then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = EMAIL_ATTR then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = PASSWORD_ATTR then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = FIRST_NAME_ATTR then
         From.First_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = LAST_NAME_ATTR then
         From.Last_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = KEY_ATTR then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

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

   --  ------------------------------
   --  Get the value identified by the name.  The following names are recognized:
   --    o isLogged  Boolean  True if a user is logged
   --    o name      String   The user name
   --    o email     String   The user email address
   --    o id        Long     The user identifier
   --  ------------------------------
   overriding
   function Get_Value (From : in Current_User_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From);
      use type AWA.Services.Contexts.Service_Context_Access;

      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
   begin
      if Ctx = null then
         if Name = IS_LOGGED_ATTR then
            return Util.Beans.Objects.To_Object (False);
         else
            return Util.Beans.Objects.Null_Object;
         end if;
      else
         declare
            User : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
         begin
            if User.Is_Null then
               if Name = IS_LOGGED_ATTR then
                  return Util.Beans.Objects.To_Object (False);
               else
                  return Util.Beans.Objects.Null_Object;
               end if;
            else
               if Name = USER_NAME_ATTR then
                  return Util.Beans.Objects.To_Object (String '(User.Get_Name));

               elsif Name = USER_EMAIL_ATTR then
                  return Util.Beans.Objects.To_Object (String '(User.Get_Email.Get_Email));

               elsif Name = USER_ID_ATTR then
                  return Util.Beans.Objects.To_Object (Long_Long_Integer (User.Get_Id));

               elsif Name = IS_LOGGED_ATTR then
                  return Util.Beans.Objects.To_Object (True);

               else
                  return Util.Beans.Objects.Null_Object;
               end if;
            end if;
         end;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Create the current user bean.
   --  ------------------------------
   function Create_Current_User_Bean (Module : in AWA.Users.Modules.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Current_User_Bean_Access := new Current_User_Bean;
   begin
      return Object.all'Access;
   end Create_Current_User_Bean;

end AWA.Users.Beans;

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

with Util.Log.Loggers;

with ASF.Principals;
with ASF.Sessions;
with ASF.Events.Faces.Actions;
with ASF.Contexts.Faces;
with ASF.Contexts.Flash;
with ASF.Cookies;
with ASF.Applications.Messages.Factory;
with ASF.Security.Filters;

with ADO.Sessions;

with AWA.Services.Contexts;
package body AWA.Users.Beans is

   use Util.Log;
   use AWA.Users.Models;
   use ASF.Applications;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Users.Beans");

   --  Helper to send a remove cookie in the current response
   procedure Remove_Cookie (Name : in String);

   --  ------------------------------
   --  Action to register a user
   --  ------------------------------
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_signup_sent", Messages.INFO);

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

         Messages.Factory.Add_Message (Ctx.all, "users.signup_error_message");
   end Register_User;

   --  ------------------------------
   --  Action to verify the user after the registration
   --  ------------------------------
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      Principal : AWA.Users.Principals.Principal_Access;
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                IpAddr  => "",
                                Principal => Principal);

      Data.Set_Session_Principal (Principal);
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_registration_done", Messages.INFO);

   exception
      when Services.Not_Found =>
         Outcome := To_Unbounded_String ("failure");
         Messages.Factory.Add_Message (Ctx.all, "users.error_verify_register_key");
   end Verify_User;

   --  ------------------------------
   --  Action to trigger the lost password email process.
   --  ------------------------------
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_lost_password_sent", Messages.INFO);

   exception
      when Services.Not_Found =>
         Messages.Factory.Add_Message (Ctx.all, "users.error_email_not_found");

   end Lost_Password;

   --  ------------------------------
   --  Action to validate the reset password key and set a new password.
   --  ------------------------------
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      Ctx   : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Flash : constant ASF.Contexts.Faces.Flash_Context_Access := Ctx.Get_Flash;
      Principal : AWA.Users.Principals.Principal_Access;
   begin
      Data.Manager.Reset_Password (Key       => To_String (Data.Access_Key),
                                   Password  => To_String (Data.Password),
                                   IpAddr    => "",
                                   Principal => Principal);
      Data.Set_Session_Principal (Principal);
      Outcome := To_Unbounded_String ("success");

      --  Add a message to the flash context so that it will be displayed on the next page.
      Flash.Set_Keep_Messages (True);
      Messages.Factory.Add_Message (Ctx.all, "users.message_reset_password_done", Messages.INFO);

   exception
      when Services.Not_Found =>
         Messages.Factory.Add_Message (Ctx.all, "users.error_reset_password");
   end Reset_Password;

   procedure Set_Session_Principal (Data      : in Authenticate_Bean;
                                    Principal : in AWA.Users.Principals.Principal_Access) is
      pragma Unreferenced (Data);

      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
   begin
      Session.Set_Principal (Principal.all'Access);
   end Set_Session_Principal;

   procedure Set_Authenticate_Cookie (Data    : in out Authenticate_Bean;
                                      Principal : in AWA.Users.Principals.Principal_Access) is
      Cookie : constant String := Data.Manager.Get_Authenticate_Cookie (Principal.Get_Session_Identifier);
      Ctx    : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      C      : ASF.Cookies.Cookie := ASF.Cookies.Create (ASF.Security.Filters.AID_COOKIE, Cookie);
   begin
      ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
      ASF.Cookies.Set_Max_Age (C, 15 * 86400);
      Ctx.Get_Response.Add_Cookie (Cookie => C);
   end Set_Authenticate_Cookie;

   --  ------------------------------
   --  Action to authenticate a user (password authentication).
   --  ------------------------------
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      Principal : AWA.Users.Principals.Principal_Access;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 Principal => Principal);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (Principal);
      Data.Set_Authenticate_Cookie (Principal);

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

         ASF.Applications.Messages.Factory.Add_Message ("users.login_signup_fail_message");
   end Authenticate_User;

   --  ------------------------------
   --  Helper to send a remove cookie in the current response
   --  ------------------------------
   procedure Remove_Cookie (Name : in String) is
      Ctx : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      C   : ASF.Cookies.Cookie := ASF.Cookies.Create (Name, "");
   begin
      ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
      ASF.Cookies.Set_Max_Age (C, 0);
      Ctx.Get_Response.Add_Cookie (Cookie => C);
   end Remove_Cookie;

   --  ------------------------------
   --  Logout the user and closes the session.
   --  ------------------------------
   procedure Logout_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      use type ASF.Principals.Principal_Access;

      Ctx       : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => False);
   begin
      Outcome := To_Unbounded_String ("success");

      --  If there is no session, we are done.
      if not Session.Is_Valid then
         return;
      end if;

      declare
         Principal : constant ASF.Principals.Principal_Access := Session.Get_Principal;
      begin
         if Principal /= null and then Principal.all in AWA.Users.Principals.Principal'Class then
            declare
               P : constant AWA.Users.Principals.Principal_Access :=
                 AWA.Users.Principals.Principal'Class (Principal.all)'Access;
            begin
               Data.Manager.Close_Session (Id => P.Get_Session_Identifier,
                                           Logout => True);

            exception
               when others =>
                  Log.Error ("Exception when closing user session...");
            end;
         end if;
         Session.Invalidate;
      end;

      --  Remove the session cookie.
      Remove_Cookie (ASF.Security.Filters.SID_COOKIE);
      Remove_Cookie (ASF.Security.Filters.AID_COOKIE);
   end Logout_User;

   --  ------------------------------
   --  Create an authenticate bean.
   --  ------------------------------
   function Create_Authenticate_Bean (Module : in AWA.Users.Modules.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Modules.Get_User_Manager;
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Authenticate_User,
                                                      Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Register_User,
                                                      Name   => "register");

   package Verify_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Verify_User,
                                                      Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Lost_Password,
                                                      Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Reset_Password,
                                                      Name   => "resetPassword");

   package Logout_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                      Method => Logout_User,
                                                      Name   => "logout");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Access,
         Register_Binding.Proxy'Access,
         Verify_Binding.Proxy'Access,
         Lost_Password_Binding.Proxy'Access,
         Reset_Password_Binding.Proxy'Access,
         Logout_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = EMAIL_ATTR then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = PASSWORD_ATTR then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = FIRST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.First_Name);
      elsif Name = LAST_NAME_ATTR then
         return Util.Beans.Objects.To_Object (From.Last_Name);
      elsif Name = KEY_ATTR then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = EMAIL_ATTR then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = PASSWORD_ATTR then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = FIRST_NAME_ATTR then
         From.First_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = LAST_NAME_ATTR then
         From.Last_Name := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = KEY_ATTR then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

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

   --  ------------------------------
   --  Get the value identified by the name.  The following names are recognized:
   --    o isLogged  Boolean  True if a user is logged
   --    o name      String   The user name
   --    o email     String   The user email address
   --    o id        Long     The user identifier
   --  ------------------------------
   overriding
   function Get_Value (From : in Current_User_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      package ASC renames AWA.Services.Contexts;

      pragma Unreferenced (From);
      use type ASC.Service_Context_Access;

      Ctx : constant ASC.Service_Context_Access := ASC.Current;
   begin
      if Ctx = null then
         if Name = IS_LOGGED_ATTR then
            return Util.Beans.Objects.To_Object (False);
         else
            return Util.Beans.Objects.Null_Object;
         end if;
      else
         declare
            User : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
         begin
            if User.Is_Null then
               if Name = IS_LOGGED_ATTR then
                  return Util.Beans.Objects.To_Object (False);
               else
                  return Util.Beans.Objects.Null_Object;
               end if;
            else
               if Name = USER_NAME_ATTR then
                  return Util.Beans.Objects.To_Object (String '(User.Get_Name));

               elsif Name = USER_EMAIL_ATTR then
                  declare
                     Email : AWA.Users.Models.Email_Ref'Class := User.Get_Email;
                  begin
                     if not Email.Is_Loaded then
                        --  The email object was not loaded.  Load it using a new database session.
                        declare
                           Session : ADO.Sessions.Session := ASC.Get_Session (Ctx);
                        begin
                           Email.Load (Session, Email.Get_Id);
                        end;
                     end if;
                     return Util.Beans.Objects.To_Object (String '(Email.Get_Email));
                  end;

               elsif Name = USER_ID_ATTR then
                  return Util.Beans.Objects.To_Object (Long_Long_Integer (User.Get_Id));

               elsif Name = IS_LOGGED_ATTR then
                  return Util.Beans.Objects.To_Object (True);

               else
                  return Util.Beans.Objects.Null_Object;
               end if;
            end if;
         end;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Create the current user bean.
   --  ------------------------------
   function Create_Current_User_Bean (Module : in AWA.Users.Modules.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Current_User_Bean_Access := new Current_User_Bean;
   begin
      return Object.all'Access;
   end Create_Current_User_Bean;

end AWA.Users.Beans;

Fix retrieval of user email address

Fix retrieval of user email address


-----------------------------------------------------------------------
--  ado-mysql -- MySQL Database Drivers
--  Copyright (C) 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.Properties;

--  === MySQL Database Driver ===
--  The MySQL database driver can be initialize explicitly by using the `ado_mysql`
--  GNAT project and calling the initialization procedure.
--
--    ADO.Mysql.Initialize ("db.properties");
--
--  The set of configuration properties can be set programatically and passed to the
--  `Initialize` operation.
--
--    Config : Util.Properties.Manager;
--    ...
--      Config.Set ("ado.database", "mysql:///mydatabase.db");
--      Config.Set ("ado.queries.path", ".;db");
--      ADO.Mysql.Initialize (Config);
--
package ADO.Mysql is

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

end ADO.Mysql;

-----------------------------------------------------------------------
--  ado-mysql -- MySQL Database Drivers
--  Copyright (C) 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.Properties;

--  === MySQL Database Driver ===
--  The MySQL database driver can be initialize explicitly by using the `ado_mysql`
--  GNAT project and calling the initialization procedure.
--
--    ADO.Mysql.Initialize ("db.properties");
--
--  The set of configuration properties can be set programatically and passed to the
--  `Initialize` operation.
--
--    Config : Util.Properties.Manager;
--    ...
--      Config.Set ("ado.database", "mysql://localhost:3306/ado_test");
--      Config.Set ("ado.queries.path", ".;db");
--      ADO.Mysql.Initialize (Config);
--
--  The MySQL database driver supports the following properties:
--
--  | Name        | Description       |
--  | ----------- | ---------      |
--  | user        | The user name to connect to the server |
--  | password    | The user password to connect to the server |
--  | socket      | The optional Unix socket path for a Unix socket base connection |
--  | encoding    | The encoding to be used for the connection (ex: UTF-8) |
--
package ADO.Mysql is

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

end ADO.Mysql;

Update the documentation for the MySQL database driver


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

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Result : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      MAT.Readers.Tests.Add_Tests (Result);
      return Result;
   end Suite;

end MAT.Testsuite;

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

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Result : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      MAT.Readers.Tests.Add_Tests (Result);
      MAT.Targets.Tests.Add_Tests (Result);
      return Result;
   end Suite;

end MAT.Testsuite;

Add the new unit tests

Add the new unit tests


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

   use ADO.Statements;

   procedure Load_Table_Schema (C : in ADO.Drivers.Connections.Database_Connection'Class;
                                Table : in Table_Definition);

   function String_To_Type (Value : in String) return Column_Type;
   function String_To_Length (Value : in String) return Natural;

   function String_To_Type (Value : in String) return Column_Type is
      Pos : Natural;
   begin
      if Value = "date" then
         return T_DATE;
      elsif Value = "datetime" then
         return T_DATE_TIME;
      elsif Value = "int" or Value = "integer" then
         return T_INTEGER;
      elsif Value = "bigint" then
         return T_LONG_INTEGER;
      elsif Value = "tinyint" then
         return T_TINYINT;
      elsif Value = "smallint" then
         return T_SMALLINT;
      elsif Value = "blob" then
         return T_BLOB;
      end if;
      Pos := Ada.Strings.Fixed.Index (Value, "(");
      if Pos > 0 then
         declare
            Name : constant String := Value (Value'First .. Pos - 1);
         begin
            if Name = "varchar" then
               return T_VARCHAR;
            elsif Name = "real" or Name = "float" or Name = "double" then
               return T_FLOAT;
            elsif Name = "int" then
               return T_INTEGER;
            elsif Name = "bigint" then
               return T_LONG_INTEGER;
            else
               return T_UNKNOWN;
            end if;
         end;
      end if;
      return T_UNKNOWN;
   end String_To_Type;

   function String_To_Length (Value : in String) return Natural is
      First : Natural;
      Last  : Natural;
   begin
      First := Ada.Strings.Fixed.Index (Value, "(");
      if First < 0 then
         return 0;
      end if;
      Last := Ada.Strings.Fixed.Index (Value , ")");
      if Last < First then
         return 0;
      end if;
      return Natural'Value (Value (First + 1 .. Last - 1));

   exception
      when Constraint_Error =>
         return 0;
   end String_To_Length;

   --  ------------------------------
   --  Load the table definition
   --  ------------------------------
   procedure Load_Table_Schema (C : in ADO.Drivers.Connections.Database_Connection'Class;
                                Table : in Table_Definition) is
      Name : constant String := Get_Name (Table);
      Stmt : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("pragma table_info('" & Name & "')"));
      Last : Column_Definition := null;
      Col  : Column_Definition;
      Value : Unbounded_String;
   begin
      Stmt.Execute;
      while Stmt.Has_Elements loop
         Col           := new Column;
         Col.Name      := Stmt.Get_Unbounded_String (1);
         Col.Collation := Stmt.Get_Unbounded_String (2);
         Col.Default   := Stmt.Get_Unbounded_String (5);
         if Last /= null then
            Last.Next_Column := Col;
         else
            Table.First_Column := Col;
         end if;

         Value := Stmt.Get_Unbounded_String (2);
         declare
            Type_Name : constant String
              := Util.Strings.Transforms.To_Lower_Case (To_String (Value));
         begin
            Col.Col_Type := String_To_Type (Type_Name);
            Col.Size := String_To_Length (Type_Name);
         end;

         Value := Stmt.Get_Unbounded_String (3);
         Col.Is_Null := Value = "0";

         Value := Stmt.Get_Unbounded_String (5);
         Col.Is_Primary := Value = "1";

         Last := Col;
         Stmt.Next;
      end loop;
   end Load_Table_Schema;

   --  ------------------------------
   --  Load the database schema
   --  ------------------------------
   procedure Load_Schema (C      : in ADO.Drivers.Connections.Database_Connection'Class;
                          Schema : out Schema_Definition) is
      Stmt  : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("SELECT NAME FROM sqlite_master"));
      Table : Table_Definition;
      Last  : Table_Definition := null;
   begin
      Schema.Schema := new ADO.Schemas.Schema;
      Stmt.Execute;

      while Stmt.Has_Elements loop
         Table      := new ADO.Schemas.Table;
         Table.Name := Stmt.Get_Unbounded_String (0);
         if Last /= null then
            Last.Next_Table := Table;
         else
            Schema.Schema.First_Table := Table;
         end if;
         Load_Table_Schema (C, Table);
         Last := Table;
         Stmt.Next;
      end loop;
   end Load_Schema;

end ADO.Schemas.Sqlite;

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

   use ADO.Statements;

   procedure Load_Table_Schema (C : in ADO.Drivers.Connections.Database_Connection'Class;
                                Table : in Table_Definition);

   function String_To_Type (Value : in String) return Column_Type;
   function String_To_Length (Value : in String) return Natural;

   function String_To_Type (Value : in String) return Column_Type is
      Pos : Natural;
   begin
      if Value = "date" then
         return T_DATE;
      elsif Value = "datetime" then
         return T_DATE_TIME;
      elsif Value = "int" or Value = "integer" then
         return T_INTEGER;
      elsif Value = "bigint" then
         return T_LONG_INTEGER;
      elsif Value = "tinyint" then
         return T_TINYINT;
      elsif Value = "smallint" then
         return T_SMALLINT;
      elsif Value = "blob" then
         return T_BLOB;
      end if;
      Pos := Ada.Strings.Fixed.Index (Value, "(");
      if Pos > 0 then
         declare
            Name : constant String := Value (Value'First .. Pos - 1);
         begin
            if Name = "varchar" then
               return T_VARCHAR;
            elsif Name = "real" or Name = "float" or Name = "double" then
               return T_FLOAT;
            elsif Name = "int" then
               return T_INTEGER;
            elsif Name = "bigint" then
               return T_LONG_INTEGER;
            else
               return T_UNKNOWN;
            end if;
         end;
      end if;
      return T_UNKNOWN;
   end String_To_Type;

   function String_To_Length (Value : in String) return Natural is
      First : Natural;
      Last  : Natural;
   begin
      First := Ada.Strings.Fixed.Index (Value, "(");
      if First = 0 then
         return 0;
      end if;
      Last := Ada.Strings.Fixed.Index (Value, ")");
      if Last < First then
         return 0;
      end if;
      return Natural'Value (Value (First + 1 .. Last - 1));

   exception
      when Constraint_Error =>
         return 0;
   end String_To_Length;

   --  ------------------------------
   --  Load the table definition
   --  ------------------------------
   procedure Load_Table_Schema (C : in ADO.Drivers.Connections.Database_Connection'Class;
                                Table : in Table_Definition) is
      Name : constant String := Get_Name (Table);
      Stmt : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("pragma table_info('" & Name & "')"));
      Last : Column_Definition := null;
      Col  : Column_Definition;
      Value : Unbounded_String;
   begin
      Stmt.Execute;
      while Stmt.Has_Elements loop
         Col           := new Column;
         Col.Name      := Stmt.Get_Unbounded_String (1);
         Col.Collation := Stmt.Get_Unbounded_String (2);
         Col.Default   := Stmt.Get_Unbounded_String (5);
         if Last /= null then
            Last.Next_Column := Col;
         else
            Table.First_Column := Col;
         end if;

         Value := Stmt.Get_Unbounded_String (2);
         declare
            Type_Name : constant String
              := Util.Strings.Transforms.To_Lower_Case (To_String (Value));
         begin
            Col.Col_Type := String_To_Type (Type_Name);
            Col.Size := String_To_Length (Type_Name);
         end;

         Value := Stmt.Get_Unbounded_String (3);
         Col.Is_Null := Value = "0";

         Value := Stmt.Get_Unbounded_String (5);
         Col.Is_Primary := Value = "1";

         Last := Col;
         Stmt.Next;
      end loop;
   end Load_Table_Schema;

   --  ------------------------------
   --  Load the database schema
   --  ------------------------------
   procedure Load_Schema (C      : in ADO.Drivers.Connections.Database_Connection'Class;
                          Schema : out Schema_Definition) is
      Stmt  : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("SELECT NAME FROM sqlite_master"));
      Table : Table_Definition;
      Last  : Table_Definition := null;
   begin
      Schema.Schema := new ADO.Schemas.Schema;
      Stmt.Execute;

      while Stmt.Has_Elements loop
         Table      := new ADO.Schemas.Table;
         Table.Name := Stmt.Get_Unbounded_String (0);
         if Last /= null then
            Last.Next_Table := Table;
         else
            Schema.Schema.First_Table := Table;
         end if;
         Load_Table_Schema (C, Table);
         Last := Table;
         Stmt.Next;
      end loop;
   end Load_Schema;

end ADO.Schemas.Sqlite;

Fix compilation warning

Fix compilation warning


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

with Security.Auth;

--  == OpenID ==
--  The Security.OpenID package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  There are basically two steps that an application must implement:
--
--    * Discovery: to resolve and use the OpenID provider and redirect the user to the
--      provider authentication form.
--    * Verify: to decode the authentication and check its result.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  The authentication process is the following:
--
--    * The application should redirect the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  === Initialization ===
--  The initialization process must be done before each two steps (discovery and verify).
--  The OpenID manager must be declared and configured.
--
--    Mgr   : Security.OpenID.Manager;
--
--  For the configuration, the Initialize procedure is called to configure
--  the OpenID realm and set the OpenID return callback URL.  The return callback
--  must be a valid URL that is based on the realm.  Example:
--
--    Mgr.Initialize (Name      => "http://app.site.com/auth",
--                    Return_To => "http://app.site.com/auth/verify");
--
--  After this initialization, the OpenID manager can be used in the authentication process.
--
--  === Discovery: creating the authentication URL ===
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenID manager, discover the OpenID provider,
--  do the association and get an End_Point.  The OpenID provider is specified as an
--  URL, below is an example for Google OpenID:
--
--    Provider : constant String := "https://www.google.com/accounts/o8/id";
--    OP       : Security.OpenID.End_Point;
--    Assoc    : constant Security.OpenID.Association_Access := new Security.OpenID.Association;
--
--  The following steps are performed:
--
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned in <tt>OP</tt>.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  === Verify: acknowledge the authentication in the callback URL ===
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : OpenID.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Security.OpenID.Get_Status (Auth) = Security.OpenID.AUTHENTICATED then ...  -- Success.
--
--  === Principal creation ===
--  After the user is successfully authenticated, a user principal can be created and saved in
--  the session.  The user principal can then be used to assign permissions to that user and
--  enforce the application permissions using the security policy manger.
--
--    P : Security.OpenID.Principal_Access := Security.OpenID.Create_Principal (Auth);
--
package Security.OpenID is

   pragma Obsolescent ("Use the Security.Auth package instead");

   Invalid_End_Point : exception;

   Service_Error     : exception;

   subtype Parameters is Security.Auth.Parameters;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   subtype End_Point is Security.Auth.End_Point;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   subtype Association is Security.Auth.End_Point;

   subtype Auth_Result is Security.Auth.Auth_Result;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   subtype Authentication is Security.Auth.Authentication;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   subtype Principal is Security.Auth.Principal;
   subtype Principal_Access is Security.Auth.Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   subtype Manager is Security.Auth.Manager;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

private

   use Ada.Strings.Unbounded;
--
--     type Manager is new Ada.Finalization.Limited_Controlled with record
--        Realm     : Unbounded_String;
--        Return_To : Unbounded_String;
--     end record;

end Security.OpenID;

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

--  == OpenID ==
--  The Security.OpenID package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  There are basically two steps that an application must implement:
--
--    * Discovery: to resolve and use the OpenID provider and redirect the user to the
--      provider authentication form.
--    * Verify: to decode the authentication and check its result.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  The authentication process is the following:
--
--    * The application should redirect the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  === Initialization ===
--  The initialization process must be done before each two steps (discovery and verify).
--  The OpenID manager must be declared and configured.
--
--    Mgr   : Security.OpenID.Manager;
--
--  For the configuration, the Initialize procedure is called to configure
--  the OpenID realm and set the OpenID return callback URL.  The return callback
--  must be a valid URL that is based on the realm.  Example:
--
--    Mgr.Initialize (Name      => "http://app.site.com/auth",
--                    Return_To => "http://app.site.com/auth/verify");
--
--  After this initialization, the OpenID manager can be used in the authentication process.
--
--  === Discovery: creating the authentication URL ===
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenID manager, discover the OpenID provider,
--  do the association and get an End_Point.  The OpenID provider is specified as an
--  URL, below is an example for Google OpenID:
--
--    Provider : constant String := "https://www.google.com/accounts/o8/id";
--    OP       : Security.OpenID.End_Point;
--    Assoc    : constant Security.OpenID.Association_Access := new Security.OpenID.Association;
--
--  The following steps are performed:
--
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned in <tt>OP</tt>.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  === Verify: acknowledge the authentication in the callback URL ===
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : OpenID.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Security.OpenID.Get_Status (Auth) = Security.OpenID.AUTHENTICATED then ...  -- Success.
--
--  === Principal creation ===
--  After the user is successfully authenticated, a user principal can be created and saved in
--  the session.  The user principal can then be used to assign permissions to that user and
--  enforce the application permissions using the security policy manger.
--
--    P : Security.OpenID.Principal_Access := Security.OpenID.Create_Principal (Auth);
--
package Security.OpenID is

   pragma Obsolescent ("Use the Security.Auth package instead");

   Invalid_End_Point : exception;

   Service_Error     : exception;

   subtype Parameters is Security.Auth.Parameters;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   subtype End_Point is Security.Auth.End_Point;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   subtype Association is Security.Auth.End_Point;

   subtype Auth_Result is Security.Auth.Auth_Result;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   subtype Authentication is Security.Auth.Authentication;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   subtype Principal is Security.Auth.Principal;
   subtype Principal_Access is Security.Auth.Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   subtype Manager is Security.Auth.Manager;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

end Security.OpenID;

Remove unused with clauses

Remove unused with clauses