-----------------------------------------------------------------------
--  components-core-views -- ASF View Components
--  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.Unchecked_Deallocation;

with Util.Log.Loggers;

with ASF.Events.Phases;
with ASF.Components.Base;
with ASF.Events.Faces.Actions;

package body ASF.Components.Core.Views is

   use ASF;
   use EL.Objects;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Components.Core.Views");

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Events.Faces.Faces_Event'Class,
                                     Name   => Faces_Event_Access);

   --  ------------------------------
   --  Get the content type returned by the view.
   --  ------------------------------
   function Get_Content_Type (UI      : in UIView;
                              Context : in Faces_Context'Class) return String is
   begin
      if Util.Beans.Objects.Is_Null (UI.Content_Type) then
         return UI.Get_Attribute (Name => "contentType", Context => Context);
      else
         return Util.Beans.Objects.To_String (UI.Content_Type);
      end if;
   end Get_Content_Type;

   --  ------------------------------
   --  Set the content type returned by the view.
   --  ------------------------------
   procedure Set_Content_Type (UI     : in out UIView;
                               Value  : in String) is
   begin
      UI.Content_Type := Util.Beans.Objects.To_Object (Value);
   end Set_Content_Type;

   --  ------------------------------
   --  Encode the begining of the view.  Set the response content type.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIView;
                           Context : in out Faces_Context'Class) is
      Content_Type : constant String := UI.Get_Content_Type (Context => Context);
   begin
      Context.Get_Response.Set_Content_Type (Content_Type);
   end Encode_Begin;

   --  ------------------------------
   --  Decode any new state of the specified component from the request contained
   --  in the specified context and store that state on the component.
   --
   --  During decoding, events may be enqueued for later processing
   --  (by event listeners that have registered an interest), by calling
   --  the Queue_Event on the associated component.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Decodes (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.APPLY_REQUEST_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Decodes;

   --  ------------------------------
   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Validators (UI      : in out UIView;
                                 Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Validators (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.PROCESS_VALIDATION, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Validators;

   --  ------------------------------
   --  Perform the component tree processing required by the Update Model Values
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows.
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Updates/b> of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Updates (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Updates (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.UPDATE_MODEL_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Updates;

   --  ------------------------------
   --  Broadcast any events that have been queued for the Invoke Application
   --  phase of the request processing lifecycle and to clear out any events
   --  for later phases if the event processing for this phase caused
   --  renderResponse or responseComplete to be called.
   --  ------------------------------
   procedure Process_Application (UI      : in out UIView;
                                  Context : in out Faces_Context'Class) is
   begin
      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.INVOKE_APPLICATION, Context);
   end Process_Application;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   procedure Queue_Event (UI    : in out UIView;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
      use type Base.UIComponent_Access;

      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         Parent.Queue_Event (Event);
      else
         UI.Phase_Events (Event.Get_Phase).Append (Event.all'Access);
      end if;
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   procedure Broadcast (UI      : in out UIView;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is

      Pos : Natural := 0;

      --  Broadcast the event to the component's listeners
      --  and free that event.
      procedure Broadcast (Ev : in out Faces_Event_Access);

      procedure Broadcast (Ev : in out Faces_Event_Access) is
      begin
         if Ev /= null then
            declare
               C  : constant Base.UIComponent_Access := Ev.Get_Component;
            begin
               C.Broadcast (Ev, Context);
            end;
            Free (Ev);
         end if;
      end Broadcast;

   begin
      --  Dispatch events in the order in which they were queued.
      --  More events could be queued as a result of the dispatch.
      --  After dispatching an event, it is freed but not removed
      --  from the event queue (the access will be cleared).
      loop
         exit when Pos > UI.Phase_Events (Phase).Last_Index;
         UI.Phase_Events (Phase).Update_Element (Pos, Broadcast'Access);
         Pos := Pos + 1;
      end loop;

      --  Now, clear the queue.
      UI.Phase_Events (Phase).Clear;
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   procedure Clear_Events (UI : in out UIView) is
   begin
      for Phase in UI.Phase_Events'Range loop
         for I in 0 .. UI.Phase_Events (Phase).Last_Index loop
            declare
               Ev : Faces_Event_Access := UI.Phase_Events (Phase).Element (I);
            begin
               Free (Ev);
            end;
         end loop;
         UI.Phase_Events (Phase).Clear;
      end loop;
   end Clear_Events;

   --  ------------------------------
   --  Set the metadata facet on the UIView component.
   --  ------------------------------
   procedure Set_Metadata (UI    : in out UIView;
                           Meta  : in UIViewMetaData_Access;
                           Tag   : access ASF.Views.Nodes.Tag_Node'Class) is
   begin
      if UI.Meta /= null then
         UI.Log_Error ("A <f:metadata> component was already registered.");
--           Delete (UI.Meta);
      end if;
      Meta.Root := UI'Unchecked_Access;
      UI.Meta := Meta;
      UI.Add_Facet (METADATA_FACET_NAME, Meta.all'Access, Tag);
   end Set_Metadata;

   --  ------------------------------
   --  Decode the request and prepare for the execution for the view action.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIViewAction;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      begin
         ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                              Method => UI.Get_Action_Expression (Context));

      exception
         when EL.Expressions.Invalid_Expression =>
            null;
      end;
   end Process_Decodes;

   --  ------------------------------
   --  Start encoding the UIComponent.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIViewMetaData;
                           Context : in out Faces_Context'Class) is
   begin
      UI.Root.Encode_Begin (Context);
   end Encode_Begin;

   --  ------------------------------
   --  Encode the children of this component.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIViewMetaData;
                              Context : in out Faces_Context'Class) is
   begin
      UI.Root.Encode_Children (Context);
   end Encode_Children;

   --  ------------------------------
   --  Finish encoding the component.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIViewMetaData;
                         Context : in out Faces_Context'Class) is
   begin
      UI.Root.Encode_Begin (Context);
   end Encode_End;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   overriding
   procedure Queue_Event (UI    : in out UIViewMetaData;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
   begin
      UI.Root.Queue_Event (Event);
   end Queue_Event;

   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   overriding
   procedure Broadcast (UI      : in out UIViewMetaData;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is
   begin
      UI.Root.Broadcast (Phase, Context);
   end Broadcast;

   --  Clear the events that were queued.
   overriding
   procedure Clear_Events (UI : in out UIViewMetaData) is
   begin
      UI.Root.Clear_Events;
   end Clear_Events;

end ASF.Components.Core.Views;

-----------------------------------------------------------------------
--  components-core-views -- ASF View Components
--  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.Unchecked_Deallocation;

with Util.Log.Loggers;

with ASF.Events.Phases;
with ASF.Components.Base;
with ASF.Events.Faces.Actions;

package body ASF.Components.Core.Views is

   use ASF;
   use EL.Objects;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Components.Core.Views");

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Events.Faces.Faces_Event'Class,
                                     Name   => Faces_Event_Access);

   --  ------------------------------
   --  Get the content type returned by the view.
   --  ------------------------------
   function Get_Content_Type (UI      : in UIView;
                              Context : in Faces_Context'Class) return String is
   begin
      if Util.Beans.Objects.Is_Null (UI.Content_Type) then
         return UI.Get_Attribute (Name => "contentType", Context => Context);
      else
         return Util.Beans.Objects.To_String (UI.Content_Type);
      end if;
   end Get_Content_Type;

   --  ------------------------------
   --  Set the content type returned by the view.
   --  ------------------------------
   procedure Set_Content_Type (UI     : in out UIView;
                               Value  : in String) is
   begin
      UI.Content_Type := Util.Beans.Objects.To_Object (Value);
   end Set_Content_Type;

   --  ------------------------------
   --  Encode the begining of the view.  Set the response content type.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIView;
                           Context : in out Faces_Context'Class) is
      Content_Type : constant String := UI.Get_Content_Type (Context => Context);
   begin
      Context.Get_Response.Set_Content_Type (Content_Type);
   end Encode_Begin;

   --  ------------------------------
   --  Decode any new state of the specified component from the request contained
   --  in the specified context and store that state on the component.
   --
   --  During decoding, events may be enqueued for later processing
   --  (by event listeners that have registered an interest), by calling
   --  the Queue_Event on the associated component.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Decodes (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.APPLY_REQUEST_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Decodes;

   --  ------------------------------
   --  Perform the component tree processing required by the Process Validations
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows:
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Validators of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Validators (UI      : in out UIView;
                                 Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Validators (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.PROCESS_VALIDATION, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Validators;

   --  ------------------------------
   --  Perform the component tree processing required by the Update Model Values
   --  phase of the request processing lifecycle for all facets of this component,
   --  all children of this component, and this component itself, as follows.
   --

   --
If this component rendered property is false, skip further processing.
   --
Call the Process_Updates/b> of all facets and children.
   --

   --  ------------------------------
   overriding
   procedure Process_Updates (UI      : in out UIView;
                              Context : in out Faces_Context'Class) is
   begin
      Base.UIComponent (UI).Process_Updates (Context);

      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.UPDATE_MODEL_VALUES, Context);

      --  Drop other events if the response is to be returned.
      if Context.Get_Render_Response or Context.Get_Response_Completed then
         UIView'Class (UI).Clear_Events;
      end if;
   end Process_Updates;

   --  ------------------------------
   --  Broadcast any events that have been queued for the Invoke Application
   --  phase of the request processing lifecycle and to clear out any events
   --  for later phases if the event processing for this phase caused
   --  renderResponse or responseComplete to be called.
   --  ------------------------------
   procedure Process_Application (UI      : in out UIView;
                                  Context : in out Faces_Context'Class) is
   begin
      --  Dispatch events queued for this phase.
      UIView'Class (UI).Broadcast (ASF.Events.Phases.INVOKE_APPLICATION, Context);
   end Process_Application;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   procedure Queue_Event (UI    : in out UIView;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
      use type Base.UIComponent_Access;

      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         Parent.Queue_Event (Event);
      else
         UI.Phase_Events (Event.Get_Phase).Append (Event.all'Access);
      end if;
   end Queue_Event;

   --  ------------------------------
   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   --  ------------------------------
   procedure Broadcast (UI      : in out UIView;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is

      Pos : Natural := 0;

      --  Broadcast the event to the component's listeners
      --  and free that event.
      procedure Broadcast (Ev : in out Faces_Event_Access);

      procedure Broadcast (Ev : in out Faces_Event_Access) is
      begin
         if Ev /= null then
            declare
               C  : constant Base.UIComponent_Access := Ev.Get_Component;
            begin
               C.Broadcast (Ev, Context);
            end;
            Free (Ev);
         end if;
      end Broadcast;

      use type Base.UIComponent_Access;

      Parent : constant Base.UIComponent_Access := UI.Get_Parent;
   begin
      if Parent /= null then
         UIView'Class (Parent.all).Broadcast (Phase, Context);
      else
         --  Dispatch events in the order in which they were queued.
         --  More events could be queued as a result of the dispatch.
         --  After dispatching an event, it is freed but not removed
         --  from the event queue (the access will be cleared).
         loop
            exit when Pos > UI.Phase_Events (Phase).Last_Index;
            UI.Phase_Events (Phase).Update_Element (Pos, Broadcast'Access);
            Pos := Pos + 1;
         end loop;

         --  Now, clear the queue.
         UI.Phase_Events (Phase).Clear;
      end if;
   end Broadcast;

   --  ------------------------------
   --  Clear the events that were queued.
   --  ------------------------------
   procedure Clear_Events (UI : in out UIView) is
   begin
      for Phase in UI.Phase_Events'Range loop
         for I in 0 .. UI.Phase_Events (Phase).Last_Index loop
            declare
               Ev : Faces_Event_Access := UI.Phase_Events (Phase).Element (I);
            begin
               Free (Ev);
            end;
         end loop;
         UI.Phase_Events (Phase).Clear;
      end loop;
   end Clear_Events;

   --  ------------------------------
   --  Set the metadata facet on the UIView component.
   --  ------------------------------
   procedure Set_Metadata (UI    : in out UIView;
                           Meta  : in UIViewMetaData_Access;
                           Tag   : access ASF.Views.Nodes.Tag_Node'Class) is
   begin
      if UI.Meta /= null then
         UI.Log_Error ("A <f:metadata> component was already registered.");
--           Delete (UI.Meta);
      end if;
      Meta.Root := UI'Unchecked_Access;
      UI.Meta := Meta;
      UI.Add_Facet (METADATA_FACET_NAME, Meta.all'Access, Tag);
   end Set_Metadata;

   --  ------------------------------
   --  Decode the request and prepare for the execution for the view action.
   --  ------------------------------
   overriding
   procedure Process_Decodes (UI      : in out UIViewAction;
                              Context : in out Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      begin
         ASF.Events.Faces.Actions.Post_Event (UI     => UI,
                                              Method => UI.Get_Action_Expression (Context));

      exception
         when EL.Expressions.Invalid_Expression =>
            null;
      end;
   end Process_Decodes;

   --  ------------------------------
   --  Start encoding the UIComponent.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIViewMetaData;
                           Context : in out Faces_Context'Class) is
   begin
      UI.Root.Encode_Begin (Context);
   end Encode_Begin;

   --  ------------------------------
   --  Encode the children of this component.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIViewMetaData;
                              Context : in out Faces_Context'Class) is
   begin
      UI.Root.Encode_Children (Context);
   end Encode_Children;

   --  ------------------------------
   --  Finish encoding the component.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIViewMetaData;
                         Context : in out Faces_Context'Class) is
   begin
      UI.Root.Encode_Begin (Context);
   end Encode_End;

   --  ------------------------------
   --  Queue an event for broadcast at the end of the current request
   --  processing lifecycle phase.  The event object
   --  will be freed after being dispatched.
   --  ------------------------------
   overriding
   procedure Queue_Event (UI    : in out UIViewMetaData;
                          Event : not null access ASF.Events.Faces.Faces_Event'Class) is
   begin
      UI.Root.Queue_Event (Event);
   end Queue_Event;

   --  Broadcast the events after the specified lifecycle phase.
   --  Events that were queued will be freed.
   overriding
   procedure Broadcast (UI      : in out UIViewMetaData;
                        Phase   : in ASF.Lifecycles.Phase_Type;
                        Context : in out Faces_Context'Class) is
   begin
      UI.Root.Broadcast (Phase, Context);
   end Broadcast;

   --  Clear the events that were queued.
   overriding
   procedure Clear_Events (UI : in out UIViewMetaData) is
   begin
      UI.Root.Clear_Events;
   end Clear_Events;

end ASF.Components.Core.Views;

Fix broadcast phase events - propagate the broadcast to the parent component until the root is reached


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

with Util.Log.Loggers;
with Util.Strings;
with Util.Http.Clients;
with Util.Properties.JSON;
with Util.Encoders.HMAC.SHA1;

--  The Security.OAuth.Clients package implements the client OAuth 2.0 authorization.
--
--  Note: OAuth 1.0 could be implemented but since it's being deprecated it's not worth doing it.
package body Security.OAuth.Clients is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.OAuth.Clients");

   --  ------------------------------
   --  Access Token
   --  ------------------------------

   package Id_Random is new Ada.Numerics.Discrete_Random (Interfaces.Unsigned_32);

   protected type Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array);

   private
      --  Random number generator used for ID generation.
      Random       : Id_Random.Generator;

      --  Number of 32-bit random numbers used for the ID generation.
      Id_Size      : Ada.Streams.Stream_Element_Offset := 8;
   end Random;

   protected body Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array) is
         use Ada.Streams;
         use Interfaces;
      begin
         --  Generate the random sequence.
         for I in 0 .. Id_Size - 1 loop
            declare
               Value : constant Unsigned_32 := Id_Random.Random (Random);
            begin
               Into (4 * I)     := Stream_Element (Value and 16#0FF#);
               Into (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
               Into (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
               Into (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
            end;
         end loop;
      end Generate;

   end Random;

   --  ------------------------------
   --  Get the principal name.  This is the OAuth access token.
   --  ------------------------------
   function Get_Name (From : in Access_Token) return String is
   begin
      return From.Access_Id;
   end Get_Name;

   --  ------------------------------
   --  Get the id_token that was returned by the authentication process.
   --  ------------------------------
   function Get_Id_Token (From : in OpenID_Token) return String is
   begin
      return From.Id_Token;
   end Get_Id_Token;

   --  ------------------------------
   --  Get the application identifier.
   --  ------------------------------
   function Get_Application_Identifier (App : in Application) return String is
   begin
      return Ada.Strings.Unbounded.To_String (App.Client_Id);
   end Get_Application_Identifier;

   --  ------------------------------
   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   --  ------------------------------
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Client_Id := To_Unbounded_String (Client);
      App.Protect   := App.Client_Id & App.Callback;
   end Set_Application_Identifier;

   --  ------------------------------
   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   --  ------------------------------
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String) is
   begin
      App.Secret := Ada.Strings.Unbounded.To_Unbounded_String (Secret);
      App.Key    := App.Secret;
   end Set_Application_Secret;

   --  ------------------------------
   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   --  ------------------------------
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Callback := To_Unbounded_String (URI);
      App.Protect  := App.Client_Id & App.Callback;
   end Set_Application_Callback;

   --  ------------------------------
   --  Set the OAuth authorization server URI that the application must use
   --  to exchange the OAuth code into an access token.
   --  ------------------------------
   procedure Set_Provider_URI (App : in out Application;
                               URI : in String) is
   begin
      App.Request_URI := Ada.Strings.Unbounded.To_Unbounded_String (URI);
   end Set_Provider_URI;

   --  ------------------------------
   --  Build a unique opaque value used to prevent cross-site request forgery.
   --  The Nonce parameters is an optional but recommended unique value
   --  used only once.  The state value will be returned back by the OAuth provider.
   --  This protects the <tt>client_id</tt> and <tt>redirect_uri</tt> parameters.
   --  ------------------------------
   function Get_State (App   : in Application;
                       Nonce : in String) return String is
      use Ada.Strings.Unbounded;

      Data : constant String := Nonce & To_String (App.Protect);
      Hmac : String := Util.Encoders.HMAC.SHA1.Sign_Base64 (Key  => To_String (App.Key),
                                                            Data => Data,
                                                            URL  => True);
   begin
      --  Avoid the '=' at end of HMAC since it could be replaced by %C20 which is annoying...
      Hmac (Hmac'Last) := '.';
      return Hmac;
   end Get_State;

   --  ------------------------------
   --  Get the authenticate parameters to build the URI to redirect the user to
   --  the OAuth authorization form.
   --  ------------------------------
   function Get_Auth_Params (App : in Application;
                             State : in String;
                             Scope : in String := "") return String is
   begin
      return Security.OAuth.Client_Id
        & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Redirect_Uri
        & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Scope
        & "=" & Scope
        & "&"
        & Security.OAuth.State
        & "=" & State;
   end Get_Auth_Params;

   --  ------------------------------
   --  Verify that the State opaque value was created by the Get_State
   --  operation with the given client and redirect URL.
   --  ------------------------------
   function Is_Valid_State (App   : in Application;
                            Nonce : in String;
                            State : in String) return Boolean is
      Hmac : constant String := Application'Class (App).Get_State (Nonce);
   begin
      return Hmac = State;
   end Is_Valid_State;

   --  ------------------------------
   --  Exchange the OAuth code into an access token.
   --  ------------------------------
   function Request_Access_Token (App  : in Application;
                                  Code : in String) return Access_Token_Access is
      Client   : Util.Http.Clients.Client;
      Response : Util.Http.Clients.Response;

      Data : constant String
        := Security.OAuth.Grant_Type & "=authorization_code"
          & "&"
        & Security.OAuth.Code & "=" & Code
        & "&"
        & Security.OAuth.Redirect_Uri & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Client_Id & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Client_Secret & "=" & Ada.Strings.Unbounded.To_String (App.Secret);
      URI : constant String := Ada.Strings.Unbounded.To_String (App.Request_URI);
   begin
      Log.Info ("Getting access token from {0}", URI);
      Client.Post (URL   => URI,
                   Data  => Data,
                   Reply => Response);
      if Response.Get_Status /= Util.Http.SC_OK then
         Log.Warn ("Cannot get access token from {0}: status is {1} Body {2}",
                   URI, Natural'Image (Response.Get_Status), Response.Get_Body);
         return null;
      end if;

      --  Decode the response.
      declare
         Content      : constant String := Response.Get_Body;
         Content_Type : constant String := Response.Get_Header ("Content-Type");
         Pos          : Natural := Util.Strings.Index (Content_Type, ';');
         Last         : Natural;
         Expires      : Natural;
      begin
         if Pos = 0 then
            Pos := Content_Type'Last;
         else
            Pos := Pos - 1;
         end if;
         Log.Debug ("Content type: {0}", Content_Type);
         Log.Debug ("Data: {0}", Content);

         --  Facebook sends the access token as a 'text/plain' content.
         if Content_Type (Content_Type'First .. Pos) = "text/plain" then
            Pos := Util.Strings.Index (Content, '=');
            if Pos = 0 then
               Log.Error ("Invalid access token response: '{0}'", Content);
               return null;
            end if;
            if Content (Content'First .. Pos) /= "access_token=" then
               Log.Error ("The 'access_token' parameter is missing in response: '{0}'", Content);
               return null;
            end if;
            Last := Util.Strings.Index (Content, '&', Pos + 1);
            if Last = 0 then
               Log.Error ("Invalid 'access_token' parameter: '{0}'", Content);
               return null;
            end if;
            if Content (Last .. Last + 8) /= "&expires=" then
               Log.Error ("Invalid 'expires' parameter: '{0}'", Content);
               return null;
            end if;
            Expires := Natural'Value (Content (Last + 9 .. Content'Last));
            return Application'Class (App).Create_Access_Token (Content (Pos + 1 .. Last - 1),
                                                                "", "",
                                                                Expires);

         elsif Content_Type (Content_Type'First .. Pos) = "application/json" then
            declare
               P : Util.Properties.Manager;
            begin
               Util.Properties.JSON.Parse_JSON (P, Content);
               Expires := Natural'Value (P.Get ("expires_in"));
               return Application'Class (App).Create_Access_Token (P.Get ("access_token"),
                                                                   P.Get ("refresh_token", ""),
                                                                   P.Get ("id_token", ""),
                                                                   Expires);
            end;
         else
            Log.Error ("Content type {0} not supported for access token response", Content_Type);
            Log.Error ("Response: {0}", Content);
            return null;
         end if;
      end;
   end Request_Access_Token;

   --  ------------------------------
   --  Create the access token
   --  ------------------------------
   function Create_Access_Token (App      : in Application;
                                 Token    : in String;
                                 Refresh  : in String;
                                 Id_Token : in String;
                                 Expires  : in Natural) return Access_Token_Access is
      pragma Unreferenced (App, Expires);

   begin
      if Id_Token'Length > 0 then
         declare
            Result : constant OpenID_Token_Access
              := new OpenID_Token '(Len         => Token'Length,
                                    Id_Len      => Id_Token'Length,
                                    Refresh_Len => Refresh'Length,
                                    Access_Id   => Token,
                                    Id_Token    => Id_Token,
                                    Refresh_Token => Refresh);
         begin
            return Result.all'Access;
         end;
      else
         return new Access_Token '(Len => Token'Length,
                                   Access_Id => Token);
      end if;
   end Create_Access_Token;

end Security.OAuth.Clients;

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

with Util.Log.Loggers;
with Util.Strings;
with Util.Http.Clients;
with Util.Properties.JSON;
with Util.Encoders.Base64;
with Util.Encoders.HMAC.SHA1;

--  The Security.OAuth.Clients package implements the client OAuth 2.0 authorization.
--
--  Note: OAuth 1.0 could be implemented but since it's being deprecated it's not worth doing it.
package body Security.OAuth.Clients is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.OAuth.Clients");

   --  ------------------------------
   --  Access Token
   --  ------------------------------

   package Id_Random is new Ada.Numerics.Discrete_Random (Interfaces.Unsigned_32);

   protected type Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array);

   private
      --  Random number generator used for ID generation.
      Random       : Id_Random.Generator;
   end Random;

   protected body Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array) is
         use Ada.Streams;
         use Interfaces;

         Size : constant Ada.Streams.Stream_Element_Offset := Into'Last / 4;
      begin
         --  Generate the random sequence.
         for I in 0 .. Size loop
            declare
               Value : constant Unsigned_32 := Id_Random.Random (Random);
            begin
               Into (4 * I)     := Stream_Element (Value and 16#0FF#);
               Into (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
               Into (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
               Into (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
            end;
         end loop;
      end Generate;

   end Random;

   Random_Generator : Random;

   --  ------------------------------
   --  Generate a random nonce with at last the number of random bits.
   --  The number of bits is rounded up to a multiple of 32.
   --  The random bits are then converted to base64url in the returned string.
   --  ------------------------------
   function Create_Nonce (Bits : in Positive := 256) return String is
      use type Ada.Streams.Stream_Element_Offset;

      Rand_Count : constant Ada.Streams.Stream_Element_Offset
        := Ada.Streams.Stream_Element_Offset (4 * ((Bits + 31) / 32));

      Rand    : Ada.Streams.Stream_Element_Array (0 .. Rand_Count - 1);
      Buffer  : Ada.Streams.Stream_Element_Array (0 .. Rand_Count * 3);
      Encoder : Util.Encoders.Base64.Encoder;
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
   begin
      --  Generate the random sequence.
      Random_Generator.Generate (Rand);

      --  Encode the random stream in base64url and save it into the result string.
      Encoder.Set_URL_Mode (True);
      Encoder.Transform (Data => Rand, Into => Buffer,
                         Last => Last, Encoded => Encoded);
      declare
         Result : String (1 .. Natural (Encoded + 1));
      begin
         for I in 0 .. Encoded loop
            Result (Natural (I + 1)) := Character'Val (Buffer (I));
         end loop;
         return Result;
      end;
   end Create_Nonce;

   --  ------------------------------
   --  Get the principal name.  This is the OAuth access token.
   --  ------------------------------
   function Get_Name (From : in Access_Token) return String is
   begin
      return From.Access_Id;
   end Get_Name;

   --  ------------------------------
   --  Get the id_token that was returned by the authentication process.
   --  ------------------------------
   function Get_Id_Token (From : in OpenID_Token) return String is
   begin
      return From.Id_Token;
   end Get_Id_Token;

   --  ------------------------------
   --  Get the application identifier.
   --  ------------------------------
   function Get_Application_Identifier (App : in Application) return String is
   begin
      return Ada.Strings.Unbounded.To_String (App.Client_Id);
   end Get_Application_Identifier;

   --  ------------------------------
   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   --  ------------------------------
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Client_Id := To_Unbounded_String (Client);
      App.Protect   := App.Client_Id & App.Callback;
   end Set_Application_Identifier;

   --  ------------------------------
   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   --  ------------------------------
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String) is
   begin
      App.Secret := Ada.Strings.Unbounded.To_Unbounded_String (Secret);
      App.Key    := App.Secret;
   end Set_Application_Secret;

   --  ------------------------------
   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   --  ------------------------------
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Callback := To_Unbounded_String (URI);
      App.Protect  := App.Client_Id & App.Callback;
   end Set_Application_Callback;

   --  ------------------------------
   --  Set the OAuth authorization server URI that the application must use
   --  to exchange the OAuth code into an access token.
   --  ------------------------------
   procedure Set_Provider_URI (App : in out Application;
                               URI : in String) is
   begin
      App.Request_URI := Ada.Strings.Unbounded.To_Unbounded_String (URI);
   end Set_Provider_URI;

   --  ------------------------------
   --  Build a unique opaque value used to prevent cross-site request forgery.
   --  The Nonce parameters is an optional but recommended unique value
   --  used only once.  The state value will be returned back by the OAuth provider.
   --  This protects the <tt>client_id</tt> and <tt>redirect_uri</tt> parameters.
   --  ------------------------------
   function Get_State (App   : in Application;
                       Nonce : in String) return String is
      use Ada.Strings.Unbounded;

      Data : constant String := Nonce & To_String (App.Protect);
      Hmac : String := Util.Encoders.HMAC.SHA1.Sign_Base64 (Key  => To_String (App.Key),
                                                            Data => Data,
                                                            URL  => True);
   begin
      --  Avoid the '=' at end of HMAC since it could be replaced by %C20 which is annoying...
      Hmac (Hmac'Last) := '.';
      return Hmac;
   end Get_State;

   --  ------------------------------
   --  Get the authenticate parameters to build the URI to redirect the user to
   --  the OAuth authorization form.
   --  ------------------------------
   function Get_Auth_Params (App : in Application;
                             State : in String;
                             Scope : in String := "") return String is
   begin
      return Security.OAuth.Client_Id
        & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Redirect_Uri
        & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Scope
        & "=" & Scope
        & "&"
        & Security.OAuth.State
        & "=" & State;
   end Get_Auth_Params;

   --  ------------------------------
   --  Verify that the State opaque value was created by the Get_State
   --  operation with the given client and redirect URL.
   --  ------------------------------
   function Is_Valid_State (App   : in Application;
                            Nonce : in String;
                            State : in String) return Boolean is
      Hmac : constant String := Application'Class (App).Get_State (Nonce);
   begin
      return Hmac = State;
   end Is_Valid_State;

   --  ------------------------------
   --  Exchange the OAuth code into an access token.
   --  ------------------------------
   function Request_Access_Token (App  : in Application;
                                  Code : in String) return Access_Token_Access is
      Client   : Util.Http.Clients.Client;
      Response : Util.Http.Clients.Response;

      Data : constant String
        := Security.OAuth.Grant_Type & "=authorization_code"
          & "&"
        & Security.OAuth.Code & "=" & Code
        & "&"
        & Security.OAuth.Redirect_Uri & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Client_Id & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Client_Secret & "=" & Ada.Strings.Unbounded.To_String (App.Secret);
      URI : constant String := Ada.Strings.Unbounded.To_String (App.Request_URI);
   begin
      Log.Info ("Getting access token from {0}", URI);
      Client.Post (URL   => URI,
                   Data  => Data,
                   Reply => Response);
      if Response.Get_Status /= Util.Http.SC_OK then
         Log.Warn ("Cannot get access token from {0}: status is {1} Body {2}",
                   URI, Natural'Image (Response.Get_Status), Response.Get_Body);
         return null;
      end if;

      --  Decode the response.
      declare
         Content      : constant String := Response.Get_Body;
         Content_Type : constant String := Response.Get_Header ("Content-Type");
         Pos          : Natural := Util.Strings.Index (Content_Type, ';');
         Last         : Natural;
         Expires      : Natural;
      begin
         if Pos = 0 then
            Pos := Content_Type'Last;
         else
            Pos := Pos - 1;
         end if;
         Log.Debug ("Content type: {0}", Content_Type);
         Log.Debug ("Data: {0}", Content);

         --  Facebook sends the access token as a 'text/plain' content.
         if Content_Type (Content_Type'First .. Pos) = "text/plain" then
            Pos := Util.Strings.Index (Content, '=');
            if Pos = 0 then
               Log.Error ("Invalid access token response: '{0}'", Content);
               return null;
            end if;
            if Content (Content'First .. Pos) /= "access_token=" then
               Log.Error ("The 'access_token' parameter is missing in response: '{0}'", Content);
               return null;
            end if;
            Last := Util.Strings.Index (Content, '&', Pos + 1);
            if Last = 0 then
               Log.Error ("Invalid 'access_token' parameter: '{0}'", Content);
               return null;
            end if;
            if Content (Last .. Last + 8) /= "&expires=" then
               Log.Error ("Invalid 'expires' parameter: '{0}'", Content);
               return null;
            end if;
            Expires := Natural'Value (Content (Last + 9 .. Content'Last));
            return Application'Class (App).Create_Access_Token (Content (Pos + 1 .. Last - 1),
                                                                "", "",
                                                                Expires);

         elsif Content_Type (Content_Type'First .. Pos) = "application/json" then
            declare
               P : Util.Properties.Manager;
            begin
               Util.Properties.JSON.Parse_JSON (P, Content);
               Expires := Natural'Value (P.Get ("expires_in"));
               return Application'Class (App).Create_Access_Token (P.Get ("access_token"),
                                                                   P.Get ("refresh_token", ""),
                                                                   P.Get ("id_token", ""),
                                                                   Expires);
            end;
         else
            Log.Error ("Content type {0} not supported for access token response", Content_Type);
            Log.Error ("Response: {0}", Content);
            return null;
         end if;
      end;
   end Request_Access_Token;

   --  ------------------------------
   --  Create the access token
   --  ------------------------------
   function Create_Access_Token (App      : in Application;
                                 Token    : in String;
                                 Refresh  : in String;
                                 Id_Token : in String;
                                 Expires  : in Natural) return Access_Token_Access is
      pragma Unreferenced (App, Expires);

   begin
      if Id_Token'Length > 0 then
         declare
            Result : constant OpenID_Token_Access
              := new OpenID_Token '(Len         => Token'Length,
                                    Id_Len      => Id_Token'Length,
                                    Refresh_Len => Refresh'Length,
                                    Access_Id   => Token,
                                    Id_Token    => Id_Token,
                                    Refresh_Token => Refresh);
         begin
            return Result.all'Access;
         end;
      else
         return new Access_Token '(Len => Token'Length,
                                   Access_Id => Token);
      end if;
   end Create_Access_Token;

end Security.OAuth.Clients;

Implement the Create_Nonce by using a random generator and converting the result into base64url


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

with Ada.Characters.Conversions;
with ASF.Contexts.Writer;
with ASF.Utils;

with Wiki.Documents;
with Wiki.Parsers;
with Wiki.Helpers;
with Wiki.Render.Html;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Streams.Html;
package body AWA.Components.Wikis is

   WIKI_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   type Html_Writer_Type is limited new Wiki.Streams.Html.Html_Output_Stream with record
      Writer : ASF.Contexts.Writer.Response_Writer_Access;
   end record;

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wide_Wide_String);

   --  Write a single character to the string builder.
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Wiki.Strings.WString);

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

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

   --  Write a text escaping any character as necessary.
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Wiki.Strings.WString);

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wiki.Strings.WString) is
   begin
      Writer.Writer.Write_Wide_Raw (Content);
   end Write;

   --  ------------------------------
   --  Write a single character to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character) is
   begin
      Writer.Writer.Write_Wide_Char (Char);
   end Write;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Attribute (Name, Content);
   end Write_Wide_Attribute;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Wiki.Strings.WString) is
   begin
      Writer.Writer.Write_Wide_Attribute (Name, Content);
   end Write_Wide_Attribute;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   overriding
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is
   begin
      Writer.Writer.Start_Element (Name);
   end Start_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   overriding
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is
   begin
      Writer.Writer.End_Element (Name);
   end End_Element;

   --  ------------------------------
   --  Write a text escaping any character as necessary.
   --  ------------------------------
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Wiki.Strings.WString) is
   begin
      Writer.Writer.Write_Wide_Text (Content);
   end Write_Wide_Text;

   --  ------------------------------
   --  Get the wiki format style.  The format style is obtained from the <b>format</b>
   --  attribute name.
   --  ------------------------------
   function Get_Wiki_Style (UI      : in UIWiki;
                            Context : in Faces_Context'Class)
                            return Wiki.Wiki_Syntax is
      Format : constant String := UI.Get_Attribute (Name    => FORMAT_NAME,
                                                    Context => Context,
                                                    Default => "dotclear");
   begin
      if Format = "dotclear" or Format = "FORMAT_DOTCLEAR" then
         return Wiki.SYNTAX_DOTCLEAR;
      elsif Format = "google" then
         return Wiki.SYNTAX_GOOGLE;
      elsif Format = "phpbb" or Format = "FORMAT_PHPBB" then
         return Wiki.SYNTAX_PHPBB;
      elsif Format = "creole" or Format = "FORMAT_CREOLE" then
         return Wiki.SYNTAX_CREOLE;
      elsif Format = "mediawiki" or Format = "FORMAT_MEDIAWIKI" then
         return Wiki.SYNTAX_MEDIA_WIKI;
      else
         return Wiki.SYNTAX_MIX;
      end if;
   end Get_Wiki_Style;

   --  ------------------------------
   --  Get the links renderer that must be used to render image and page links.
   --  ------------------------------
   function Get_Links_Renderer (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Render.Links.Link_Renderer_Access is
      Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, LINKS_NAME);
      Bean  : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
   begin
      if Bean = null then
         return null;
      elsif not (Bean.all in Link_Renderer_Bean'Class) then
         return null;
      else
         return Link_Renderer_Bean'Class (Bean.all)'Access;
      end if;
   end Get_Links_Renderer;

   --  ------------------------------
   --  Get the plugin factory that must be used by the Wiki parser.
   --  ------------------------------
   function Get_Plugin_Factory (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Plugins.Plugin_Factory_Access is
      Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, PLUGINS_NAME);
      Bean  : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
   begin
      if Bean = null then
         return null;
      elsif not (Bean.all in Wiki.Plugins.Plugin_Factory'Class) then
         return null;
      else
         return Wiki.Plugins.Plugin_Factory'Class (Bean.all)'Access;
      end if;
   end Get_Plugin_Factory;

   --  ------------------------------
   --  Render the wiki text
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class) is
      use ASF.Contexts.Writer;
      use type Wiki.Render.Links.Link_Renderer_Access;
      use type Wiki.Plugins.Plugin_Factory_Access;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Html     : aliased Html_Writer_Type;
         Doc      : Wiki.Documents.Document;
         TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
         Autolink : aliased Wiki.Filters.Autolink.Autolink_Filter;
         Renderer : aliased Wiki.Render.Html.Html_Renderer;
         Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
         Format   : constant Wiki.Wiki_Syntax := UI.Get_Wiki_Style (Context);
         Value    : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, VALUE_NAME);
         Links    : Wiki.Render.Links.Link_Renderer_Access;
         Plugins  : Wiki.Plugins.Plugin_Factory_Access;
         Engine   : Wiki.Parsers.Parser;
      begin
         Html.Writer := Writer;
         Writer.Start_Element ("div");
         UI.Render_Attributes (Context, WIKI_ATTRIBUTE_NAMES, Writer);

         if not Util.Beans.Objects.Is_Empty (Value) then
            Plugins := UI.Get_Plugin_Factory (Context);
            if Plugins /= null then
               Engine.Set_Plugin_Factory (Plugins);
            end if;
            Links := UI.Get_Links_Renderer (Context);
            if Links /= null then
               Renderer.Set_Link_Renderer (Links);
            end if;
            Engine.Add_Filter (Autolink'Unchecked_Access);
            Engine.Add_Filter (TOC'Unchecked_Access);
            Engine.Add_Filter (Filter'Unchecked_Access);
            Engine.Set_Syntax (Format);
            Engine.Parse (Util.Beans.Objects.To_Wide_Wide_String (Value), Doc);
            Renderer.Set_Output_Stream (Html'Unchecked_Access);
            Renderer.Set_Render_TOC (UI.Get_Attribute (TOC_NAME, Context, False));
            Renderer.Render (Doc);
         end if;
         Writer.End_Element ("div");
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Link_Renderer_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = IMAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Image_Prefix);
      elsif Name = PAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Page_Prefix);
      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 Link_Renderer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = IMAGE_PREFIX_ATTR then
         From.Image_Prefix := Util.Beans.Objects.To_Unbounded_Wide_Wide_String (Value);
      elsif Name = PAGE_PREFIX_ATTR then
         From.Page_Prefix := Util.Beans.Objects.To_Unbounded_Wide_Wide_String (Value);
      end if;
   end Set_Value;

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean is
      use Ada.Characters.Conversions;

      Pos : Positive := 1;
   begin
      if Length (Content) < Item'Length then
         return False;
      end if;
      for I in Item'Range loop
         if Item (I) /= To_Character (Element (Content, Pos)) then
            return False;
         end if;
         Pos := Pos + 1;
      end loop;
      return True;
   end Starts_With;

   procedure Make_Link (Renderer : in Link_Renderer_Bean;
                        Link     : in Wiki.Strings.WString;
                        Prefix   : in Unbounded_Wide_Wide_String;
                        URI      : out Unbounded_Wide_Wide_String) is
   begin
      if Wiki.Helpers.Is_Url (Link) then
         URI := To_Unbounded_Wide_Wide_String (Link);
      else
         URI := Prefix & Link;
      end if;
   end Make_Link;

   --  ------------------------------
   --  Get the image link that must be rendered from the wiki image link.
   --  ------------------------------
   overriding
   procedure Make_Image_Link (Renderer : in out Link_Renderer_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is
   begin
      Renderer.Make_Link (Link, Renderer.Image_Prefix, URI);
      Width  := 0;
      Height := 0;
   end Make_Image_Link;

   --  ------------------------------
   --  Get the page link that must be rendered from the wiki page link.
   --  ------------------------------
   overriding
   procedure Make_Page_Link (Renderer : in out Link_Renderer_Bean;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is
   begin
      Renderer.Make_Link (Link, Renderer.Page_Prefix, URI);
      Exists := True;
   end Make_Page_Link;

begin
   ASF.Utils.Set_Text_Attributes (WIKI_ATTRIBUTE_NAMES);
end AWA.Components.Wikis;

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

with Ada.Characters.Conversions;
with ASF.Contexts.Writer;
with ASF.Utils;

with Wiki.Documents;
with Wiki.Parsers;
with Wiki.Helpers;
with Wiki.Render.Html;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Filters.Autolink;
with Wiki.Streams.Html;
package body AWA.Components.Wikis is

   WIKI_ATTRIBUTE_NAMES  : Util.Strings.String_Set.Set;

   type Html_Writer_Type is limited new Wiki.Streams.Html.Html_Output_Stream with record
      Writer : ASF.Contexts.Writer.Response_Writer_Access;
   end record;

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wide_Wide_String);

   --  Write a single character to the string builder.
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Wiki.Strings.WString);

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

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

   --  Write a text escaping any character as necessary.
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Wiki.Strings.WString);

   overriding
   procedure Write (Writer  : in out Html_Writer_Type;
                    Content : in Wiki.Strings.WString) is
   begin
      Writer.Writer.Write_Wide_Raw (Content);
   end Write;

   --  ------------------------------
   --  Write a single character to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Writer : in out Html_Writer_Type;
                    Char   : in Wide_Wide_Character) is
   begin
      Writer.Writer.Write_Wide_Char (Char);
   end Write;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Unbounded_Wide_Wide_String) is
   begin
      Writer.Writer.Write_Wide_Attribute (Name, Content);
   end Write_Wide_Attribute;

   --  ------------------------------
   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   --  ------------------------------
   overriding
   procedure Write_Wide_Attribute (Writer  : in out Html_Writer_Type;
                                   Name    : in String;
                                   Content : in Wiki.Strings.WString) is
   begin
      Writer.Writer.Write_Wide_Attribute (Name, Content);
   end Write_Wide_Attribute;

   --  ------------------------------
   --  Start an XML element with the given name.
   --  ------------------------------
   overriding
   procedure Start_Element (Writer : in out Html_Writer_Type;
                            Name   : in String) is
   begin
      Writer.Writer.Start_Element (Name);
   end Start_Element;

   --  ------------------------------
   --  Closes an XML element of the given name.
   --  ------------------------------
   overriding
   procedure End_Element (Writer : in out Html_Writer_Type;
                          Name   : in String) is
   begin
      Writer.Writer.End_Element (Name);
   end End_Element;

   --  ------------------------------
   --  Write a text escaping any character as necessary.
   --  ------------------------------
   overriding
   procedure Write_Wide_Text (Writer  : in out Html_Writer_Type;
                              Content : in Wiki.Strings.WString) is
   begin
      Writer.Writer.Write_Wide_Text (Content);
   end Write_Wide_Text;

   --  ------------------------------
   --  Get the wiki format style.  The format style is obtained from the <b>format</b>
   --  attribute name.
   --  ------------------------------
   function Get_Wiki_Style (UI      : in UIWiki;
                            Context : in Faces_Context'Class)
                            return Wiki.Wiki_Syntax is
      Format : constant String := UI.Get_Attribute (Name    => FORMAT_NAME,
                                                    Context => Context,
                                                    Default => "dotclear");
   begin
      if Format = "dotclear" or Format = "FORMAT_DOTCLEAR" then
         return Wiki.SYNTAX_DOTCLEAR;
      elsif Format = "google" then
         return Wiki.SYNTAX_GOOGLE;
      elsif Format = "phpbb" or Format = "FORMAT_PHPBB" then
         return Wiki.SYNTAX_PHPBB;
      elsif Format = "creole" or Format = "FORMAT_CREOLE" then
         return Wiki.SYNTAX_CREOLE;
      elsif Format = "mediawiki" or Format = "FORMAT_MEDIAWIKI" then
         return Wiki.SYNTAX_MEDIA_WIKI;
      else
         return Wiki.SYNTAX_MIX;
      end if;
   end Get_Wiki_Style;

   --  ------------------------------
   --  Get the links renderer that must be used to render image and page links.
   --  ------------------------------
   function Get_Links_Renderer (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Render.Links.Link_Renderer_Access is
      Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, LINKS_NAME);
      Bean  : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
   begin
      if Bean = null then
         return null;
      elsif not (Bean.all in Link_Renderer_Bean'Class) then
         return null;
      else
         return Link_Renderer_Bean'Class (Bean.all)'Access;
      end if;
   end Get_Links_Renderer;

   --  ------------------------------
   --  Get the plugin factory that must be used by the Wiki parser.
   --  ------------------------------
   function Get_Plugin_Factory (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Plugins.Plugin_Factory_Access is
      Value : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, PLUGINS_NAME);
      Bean  : constant access Util.Beans.Basic.Readonly_Bean'Class
           := Util.Beans.Objects.To_Bean (Value);
   begin
      if Bean = null then
         return null;
      elsif not (Bean.all in Wiki.Plugins.Plugin_Factory'Class) then
         return null;
      else
         return Wiki.Plugins.Plugin_Factory'Class (Bean.all)'Access;
      end if;
   end Get_Plugin_Factory;

   --  ------------------------------
   --  Render the wiki text
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class) is
      use ASF.Contexts.Writer;
      use type Wiki.Render.Links.Link_Renderer_Access;
      use type Wiki.Plugins.Plugin_Factory_Access;
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         Writer   : constant Response_Writer_Access := Context.Get_Response_Writer;
         Html     : aliased Html_Writer_Type;
         Doc      : Wiki.Documents.Document;
         TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
         Autolink : aliased Wiki.Filters.Autolink.Autolink_Filter;
         Renderer : aliased Wiki.Render.Html.Html_Renderer;
         Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
         Format   : constant Wiki.Wiki_Syntax := UI.Get_Wiki_Style (Context);
         Value    : constant Util.Beans.Objects.Object := UI.Get_Attribute (Context, VALUE_NAME);
         Links    : Wiki.Render.Links.Link_Renderer_Access;
         Plugins  : Wiki.Plugins.Plugin_Factory_Access;
         Engine   : Wiki.Parsers.Parser;
      begin
         Html.Writer := Writer;
         Writer.Start_Element ("div");
         UI.Render_Attributes (Context, WIKI_ATTRIBUTE_NAMES, Writer);

         if not Util.Beans.Objects.Is_Empty (Value) then
            Plugins := UI.Get_Plugin_Factory (Context);
            if Plugins /= null then
               Engine.Set_Plugin_Factory (Plugins);
            end if;
            Links := UI.Get_Links_Renderer (Context);
            if Links /= null then
               Renderer.Set_Link_Renderer (Links);
            end if;
            Engine.Add_Filter (Autolink'Unchecked_Access);
            Engine.Add_Filter (TOC'Unchecked_Access);
            Engine.Add_Filter (Filter'Unchecked_Access);
            Engine.Set_Syntax (Format);
            Engine.Parse (Util.Beans.Objects.To_String (Value), Doc);
            Renderer.Set_Output_Stream (Html'Unchecked_Access);
            Renderer.Set_Render_TOC (UI.Get_Attribute (TOC_NAME, Context, False));
            Renderer.Render (Doc);
         end if;
         Writer.End_Element ("div");
      end;
   end Encode_Begin;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Link_Renderer_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = IMAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Image_Prefix);
      elsif Name = PAGE_PREFIX_ATTR then
         return Util.Beans.Objects.To_Object (From.Page_Prefix);
      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 Link_Renderer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = IMAGE_PREFIX_ATTR then
         From.Image_Prefix := Util.Beans.Objects.To_Unbounded_Wide_Wide_String (Value);
      elsif Name = PAGE_PREFIX_ATTR then
         From.Page_Prefix := Util.Beans.Objects.To_Unbounded_Wide_Wide_String (Value);
      end if;
   end Set_Value;

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean is
      use Ada.Characters.Conversions;

      Pos : Positive := 1;
   begin
      if Length (Content) < Item'Length then
         return False;
      end if;
      for I in Item'Range loop
         if Item (I) /= To_Character (Element (Content, Pos)) then
            return False;
         end if;
         Pos := Pos + 1;
      end loop;
      return True;
   end Starts_With;

   procedure Make_Link (Renderer : in Link_Renderer_Bean;
                        Link     : in Wiki.Strings.WString;
                        Prefix   : in Unbounded_Wide_Wide_String;
                        URI      : out Unbounded_Wide_Wide_String) is
   begin
      if Wiki.Helpers.Is_Url (Link) then
         URI := To_Unbounded_Wide_Wide_String (Link);
      else
         URI := Prefix & Link;
      end if;
   end Make_Link;

   --  ------------------------------
   --  Get the image link that must be rendered from the wiki image link.
   --  ------------------------------
   overriding
   procedure Make_Image_Link (Renderer : in out Link_Renderer_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is
   begin
      Renderer.Make_Link (Link, Renderer.Image_Prefix, URI);
      Width  := 0;
      Height := 0;
   end Make_Image_Link;

   --  ------------------------------
   --  Get the page link that must be rendered from the wiki page link.
   --  ------------------------------
   overriding
   procedure Make_Page_Link (Renderer : in out Link_Renderer_Bean;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is
   begin
      Renderer.Make_Link (Link, Renderer.Page_Prefix, URI);
      Exists := True;
   end Make_Page_Link;

begin
   ASF.Utils.Set_Text_Attributes (WIKI_ATTRIBUTE_NAMES);
end AWA.Components.Wikis;

Use Util.Beans.Objects.To_String instead of Wide_Wide_String


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

with Util.Tests;
package Util.Encoders.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Hex (T : in out Test);
   procedure Test_Base64_Encode (T : in out Test);
   procedure Test_Base64_Decode (T : in out Test);
   procedure Test_Base64_URL_Encode (T : in out Test);
   procedure Test_Base64_URL_Decode (T : in out Test);
   procedure Test_Encoder (T : in out Test;
                           C : in out Util.Encoders.Encoder);
   procedure Test_Base64_Benchmark (T : in out Test);
   procedure Test_SHA1_Encode (T : in out Test);
   procedure Test_SHA256_Encode (T : in out Test);

   --  Benchmark test for SHA1
   procedure Test_SHA1_Benchmark (T : in out Test);

   --  Test HMAC-SHA1
   procedure Test_HMAC_SHA1_RFC2202_T1 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T2 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T3 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T4 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T5 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T6 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T7 (T : in out Test);

   --  Test encoding leb128.
   procedure Test_LEB128 (T : in out Test);

   --  Test encoding leb128 + base64url.
   procedure Test_Base64_LEB128 (T : in out Test);

end Util.Encoders.Tests;

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

with Util.Tests;
package Util.Encoders.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Hex (T : in out Test);
   procedure Test_Base64_Encode (T : in out Test);
   procedure Test_Base64_Decode (T : in out Test);
   procedure Test_Base64_URL_Encode (T : in out Test);
   procedure Test_Base64_URL_Decode (T : in out Test);
   procedure Test_Encoder (T : in out Test;
                           C : in out Util.Encoders.Encoder);
   procedure Test_Base64_Benchmark (T : in out Test);
   procedure Test_SHA1_Encode (T : in out Test);
   procedure Test_SHA256_Encode (T : in out Test);

   --  Benchmark test for SHA1
   procedure Test_SHA1_Benchmark (T : in out Test);

   --  Test HMAC-SHA1
   procedure Test_HMAC_SHA1_RFC2202_T1 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T2 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T3 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T4 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T5 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T6 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T7 (T : in out Test);

   --  Test HMAC-SHA256
   procedure Test_HMAC_SHA256_RFC4231_T1 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T2 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T3 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T4 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T5 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T6 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T7 (T : in out Test);

   --  Test encoding leb128.
   procedure Test_LEB128 (T : in out Test);

   --  Test encoding leb128 + base64url.
   procedure Test_Base64_LEB128 (T : in out Test);

end Util.Encoders.Tests;

Declare new test procedures for HMAC-SHA256


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

with Util.Tests;
package Util.Encoders.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Hex (T : in out Test);
   procedure Test_Base64_Encode (T : in out Test);
   procedure Test_Base64_Decode (T : in out Test);
   procedure Test_Base64_URL_Encode (T : in out Test);
   procedure Test_Base64_URL_Decode (T : in out Test);
   procedure Test_Encoder (T : in out Test;
                           C : in Util.Encoders.Encoder;
                           D : in Util.Encoders.Decoder);
   procedure Test_Base64_Benchmark (T : in out Test);
   procedure Test_SHA1_Encode (T : in out Test);
   procedure Test_SHA256_Encode (T : in out Test);

   --  Benchmark test for SHA1
   procedure Test_SHA1_Benchmark (T : in out Test);

   --  Test HMAC-SHA1
   procedure Test_HMAC_SHA1_RFC2202_T1 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T2 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T3 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T4 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T5 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T6 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T7 (T : in out Test);

   --  Test HMAC-SHA256
   procedure Test_HMAC_SHA256_RFC4231_T1 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T2 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T3 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T4 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T5 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T6 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T7 (T : in out Test);

   --  Test encoding leb128.
   procedure Test_LEB128 (T : in out Test);

   --  Test encoding leb128 + base64url.
   procedure Test_Base64_LEB128 (T : in out Test);

   --  Test encrypt and decrypt operations.
   procedure Test_AES (T : in out Test);

   --  Test encrypt and decrypt operations.
   procedure Test_Encrypt_Decrypt_Secret (T : in out Test);

   --  Test Decode Quoted-Printable encoding.
   procedure Test_Decode_Quoted_Printable (T : in out Test);

end Util.Encoders.Tests;

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

with Util.Tests;
package Util.Encoders.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Hex (T : in out Test);
   procedure Test_Base64_Encode (T : in out Test);
   procedure Test_Base64_Decode (T : in out Test);
   procedure Test_Base64_URL_Encode (T : in out Test);
   procedure Test_Base64_URL_Decode (T : in out Test);
   procedure Test_Encoder (T : in out Test;
                           C : in Util.Encoders.Encoder;
                           D : in Util.Encoders.Decoder);
   procedure Test_Base64_Benchmark (T : in out Test);
   procedure Test_SHA1_Encode (T : in out Test);
   procedure Test_SHA256_Encode (T : in out Test);

   --  Benchmark test for SHA1
   procedure Test_SHA1_Benchmark (T : in out Test);

   --  Test HMAC-SHA1
   procedure Test_HMAC_SHA1_RFC2202_T1 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T2 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T3 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T4 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T5 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T6 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T7 (T : in out Test);

   --  Test HMAC-SHA256
   procedure Test_HMAC_SHA256_RFC4231_T1 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T2 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T3 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T4 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T5 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T6 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T7 (T : in out Test);

   --  Test encoding leb128.
   procedure Test_LEB128 (T : in out Test);

   --  Test encoding leb128 + base64url.
   procedure Test_Base64_LEB128 (T : in out Test);

   --  Test encrypt and decrypt operations.
   procedure Test_AES (T : in out Test);

   --  Test encrypt and decrypt operations.
   procedure Test_Encrypt_Decrypt_Secret (T : in out Test);
   procedure Test_Encrypt_Decrypt_Secret_OFB (T : in out Test);
   procedure Test_Encrypt_Decrypt_Secret_CFB (T : in out Test);
   procedure Test_Encrypt_Decrypt_Secret_CTR (T : in out Test);

   --  Test Decode Quoted-Printable encoding.
   procedure Test_Decode_Quoted_Printable (T : in out Test);

end Util.Encoders.Tests;

Add Test_Encrypt_Decrypt_Secret_CTR/OFB/CFB to test other encryption modes


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

with Ada.Directories;
with Util.Test_Caller;

with MAT.Readers.Files;
package body MAT.Targets.Tests is

   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Targets.Read_File",
                       Test_Read_File'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a file into a string
   --  Reads this ada source file and checks we have read it correctly
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/files/file-v1.dat");
      Target : MAT.Targets.Target_Type;
      Reader : MAT.Readers.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Path);
      Reader.Read_All;
   end Test_Read_File;

end MAT.Targets.Tests;

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

with Ada.Directories;
with Util.Test_Caller;

with MAT.Readers.Streams.Files;
package body MAT.Targets.Tests is

   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test MAT.Targets.Read_File",
                       Test_Read_File'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a file into a string
   --  Reads this ada source file and checks we have read it correctly
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/files/file-v1.dat");
      Target : MAT.Targets.Target_Type;
      Reader : MAT.Readers.Streams.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Path);
      Reader.Read_All;
   end Test_Read_File;

end MAT.Targets.Tests;

Fix compilation of unit test

Fix compilation of unit test