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

with MAT.Expressions.Parser;
package body MAT.Expressions is

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => Node_Type,
                                     Name   => Node_Type_Access);

   --  Destroy recursively the node, releasing the storage.
   procedure Destroy (Node : in out Node_Type_Access);

   --  ------------------------------
   --  Create a NOT expression node.
   --  ------------------------------
   function Create_Not (Expr : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_NOT,
                                    Expr        => Expr.Node);
      Util.Concurrent.Counters.Increment (Expr.Node.Ref_Counter);
      return Result;
   end Create_Not;

   --  ------------------------------
   --  Create a AND expression node.
   --  ------------------------------
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_AND,
                                    Left        => Left.Node,
                                    Right       => Right.Node);
      Util.Concurrent.Counters.Increment (Left.Node.Ref_Counter);
      Util.Concurrent.Counters.Increment (Right.Node.Ref_Counter);
      return Result;
   end Create_And;

   --  ------------------------------
   --  Create a OR expression node.
   --  ------------------------------
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_OR,
                                    Left        => Left.Node,
                                    Right       => Right.Node);
      Util.Concurrent.Counters.Increment (Left.Node.Ref_Counter);
      Util.Concurrent.Counters.Increment (Right.Node.Ref_Counter);
      return Result;
   end Create_Or;

   --  ------------------------------
   --  Create an INSIDE expression node.
   --  ------------------------------
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_INSIDE,
                                    Name        => Name,
                                    Inside      => Kind);
      return Result;
   end Create_Inside;

   --  ------------------------------
   --  Create an size range expression node.
   --  ------------------------------
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_RANGE_SIZE,
                                    Min_Size    => Min,
                                    Max_Size    => Max);
      return Result;
   end Create_Size;

   --  ------------------------------
   --  Create an addr range expression node.
   --  ------------------------------
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_RANGE_ADDR,
                                    Min_Addr    => Min,
                                    Max_Addr    => Max);
      return Result;
   end Create_Addr;

   --  ------------------------------
   --  Create an time range expression node.
   --  ------------------------------
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_RANGE_TIME,
                                    Min_Time    => Min,
                                    Max_Time    => Max);
      return Result;
   end Create_Time;

   --  ------------------------------
   --  Create a thread ID range expression node.
   --  ------------------------------
   function Create_Thread (Min : in MAT.Types.Target_Thread_Ref;
                           Max : in MAT.Types.Target_Thread_Ref) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_THREAD,
                                    Min_Thread  => Min,
                                    Max_Thread  => Max);
      return Result;
   end Create_Thread;

   --  ------------------------------
   --  Create an event ID range expression node.
   --  ------------------------------
   function Create_Event (Min : in MAT.Events.Targets.Event_Id_Type;
                          Max : in MAT.Events.Targets.Event_Id_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_EVENT,
                                    Min_Event   => Min,
                                    Max_Event   => Max);
      return Result;
   end Create_Event;

   --  ------------------------------
   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   --  ------------------------------
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean is
   begin
      if Node.Node = null then
         return True;
      else
         return Is_Selected (Node.Node.all, Addr, Allocation);
      end if;
   end Is_Selected;

   --  ------------------------------
   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   --  ------------------------------
   function Is_Selected (Node       : in Expression_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean is
   begin
      return Is_Selected (Node.Node.all, Event);
   end Is_Selected;

   --  ------------------------------
   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   --  ------------------------------
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean is
      use type MAT.Types.Target_Size;
      use type MAT.Types.Target_Tick_Ref;
   begin
      case Node.Kind is
         when N_NOT =>
            return not Is_Selected (Node.Expr.all, Addr, Allocation);

         when N_AND =>
            return Is_Selected (Node.Left.all, Addr, Allocation)
              and then Is_Selected (Node.Right.all, Addr, Allocation);

         when N_OR =>
            return Is_Selected (Node.Left.all, Addr, Allocation)
              or else Is_Selected (Node.Right.all, Addr, Allocation);

         when N_RANGE_SIZE =>
            return Allocation.Size >= Node.Min_Size
              and Allocation.Size <= Node.Max_Size;

         when N_RANGE_ADDR =>
            return Addr >= Node.Min_Addr
              and Addr <= Node.Max_Addr;

         when N_RANGE_TIME =>
            return Allocation.Time >= Node.Min_Time
              and Allocation.Time <= Node.Max_Time;

         when others =>
            return False;

      end case;
   end Is_Selected;

   --  ------------------------------
   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   --  ------------------------------
   function Is_Selected (Node       : in Node_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean is
      use type MAT.Types.Target_Size;
      use type MAT.Types.Target_Tick_Ref;
      use type MAT.Types.Target_Thread_Ref;
      use type MAT.Events.Targets.Event_Id_Type;
   begin
      case Node.Kind is
         when N_NOT =>
            return not Is_Selected (Node.Expr.all, Event);

         when N_AND =>
            return Is_Selected (Node.Left.all, Event)
              and then Is_Selected (Node.Right.all, Event);

         when N_OR =>
            return Is_Selected (Node.Left.all, Event)
              or else Is_Selected (Node.Right.all, Event);

         when N_RANGE_SIZE =>
            return Event.Size >= Node.Min_Size
              and Event.Size <= Node.Max_Size;

         when N_RANGE_ADDR =>
            return Event.Addr >= Node.Min_Addr
              and Event.Addr <= Node.Max_Addr;

         when N_RANGE_TIME =>
            return Event.Time >= Node.Min_Time
              and Event.Time <= Node.Max_Time;

         when N_EVENT =>
            return Event.Id >= Node.Min_Event
              and Event.Id <= Node.Max_Event;

         when N_THREAD =>
            return Event.Thread >= Node.Min_Thread
              and Event.Thread <= Node.Max_Thread;

         when others =>
            return False;

      end case;
   end Is_Selected;

   --  ------------------------------
   --  Parse the string and return the expression tree.
   --  ------------------------------
   function Parse (Expr : in String) return Expression_Type is
   begin
      return MAT.Expressions.Parser.Parse (Expr);
   end Parse;

   --  ------------------------------
   --  Destroy recursively the node, releasing the storage.
   --  ------------------------------
   procedure Destroy (Node : in out Node_Type_Access) is
      Release : Boolean;
   begin
      if Node /= null then
         Util.Concurrent.Counters.Decrement (Node.Ref_Counter, Release);
         if Release then
            case Node.Kind is
            when N_NOT =>
               Destroy (Node.Expr);

            when N_AND | N_OR =>
               Destroy (Node.Left);
               Destroy (Node.Right);

            when others =>
               null;
            end case;
            Free (Node);
         else
            Node := null;
         end if;
      end if;
   end Destroy;

   --  ------------------------------
   --  Release the reference and destroy the expression tree if it was the last reference.
   --  ------------------------------
   overriding
   procedure Finalize (Obj : in out Expression_Type) is
   begin
      if Obj.Node /= null then
         Destroy (Obj.Node);
      end if;
   end Finalize;

   --  ------------------------------
   --  Update the reference after an assignment.
   --  ------------------------------
   overriding
   procedure Adjust (Obj : in out Expression_Type) is
   begin
      if Obj.Node /= null then
         Util.Concurrent.Counters.Increment (Obj.Node.Ref_Counter);
      end if;
   end Adjust;

end MAT.Expressions;

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

with MAT.Expressions.Parser;
package body MAT.Expressions is

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => Node_Type,
                                     Name   => Node_Type_Access);

   --  Destroy recursively the node, releasing the storage.
   procedure Destroy (Node : in out Node_Type_Access);

   --  ------------------------------
   --  Create a NOT expression node.
   --  ------------------------------
   function Create_Not (Expr : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_NOT,
                                    Expr        => Expr.Node);
      Util.Concurrent.Counters.Increment (Expr.Node.Ref_Counter);
      return Result;
   end Create_Not;

   --  ------------------------------
   --  Create a AND expression node.
   --  ------------------------------
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_AND,
                                    Left        => Left.Node,
                                    Right       => Right.Node);
      Util.Concurrent.Counters.Increment (Left.Node.Ref_Counter);
      Util.Concurrent.Counters.Increment (Right.Node.Ref_Counter);
      return Result;
   end Create_And;

   --  ------------------------------
   --  Create a OR expression node.
   --  ------------------------------
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_OR,
                                    Left        => Left.Node,
                                    Right       => Right.Node);
      Util.Concurrent.Counters.Increment (Left.Node.Ref_Counter);
      Util.Concurrent.Counters.Increment (Right.Node.Ref_Counter);
      return Result;
   end Create_Or;

   --  ------------------------------
   --  Create an INSIDE expression node.
   --  ------------------------------
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_INSIDE,
                                    Name        => Name,
                                    Inside      => Kind);
      return Result;
   end Create_Inside;

   --  ------------------------------
   --  Create an size range expression node.
   --  ------------------------------
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_RANGE_SIZE,
                                    Min_Size    => Min,
                                    Max_Size    => Max);
      return Result;
   end Create_Size;

   --  ------------------------------
   --  Create an addr range expression node.
   --  ------------------------------
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_RANGE_ADDR,
                                    Min_Addr    => Min,
                                    Max_Addr    => Max);
      return Result;
   end Create_Addr;

   --  ------------------------------
   --  Create an time range expression node.
   --  ------------------------------
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_RANGE_TIME,
                                    Min_Time    => Min,
                                    Max_Time    => Max);
      return Result;
   end Create_Time;

   --  ------------------------------
   --  Create a thread ID range expression node.
   --  ------------------------------
   function Create_Thread (Min : in MAT.Types.Target_Thread_Ref;
                           Max : in MAT.Types.Target_Thread_Ref) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_THREAD,
                                    Min_Thread  => Min,
                                    Max_Thread  => Max);
      return Result;
   end Create_Thread;

   --  ------------------------------
   --  Create a event type expression check.
   --  ------------------------------
   function Create_Event_Type (Event_Kind : in MAT.Events.Targets.Probe_Index_Type)
                               return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_TYPE,
                                    Event_Kind  => Event_Kind);
      return Result;
   end Create_Event_Type;

   --  ------------------------------
   --  Create an event ID range expression node.
   --  ------------------------------
   function Create_Event (Min : in MAT.Events.Targets.Event_Id_Type;
                          Max : in MAT.Events.Targets.Event_Id_Type) return Expression_Type is
      Result : Expression_Type;
   begin
      Result.Node := new Node_Type'(Ref_Counter => Util.Concurrent.Counters.ONE,
                                    Kind        => N_EVENT,
                                    Min_Event   => Min,
                                    Max_Event   => Max);
      return Result;
   end Create_Event;

   --  ------------------------------
   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   --  ------------------------------
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean is
   begin
      if Node.Node = null then
         return True;
      else
         return Is_Selected (Node.Node.all, Addr, Allocation);
      end if;
   end Is_Selected;

   --  ------------------------------
   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   --  ------------------------------
   function Is_Selected (Node       : in Expression_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean is
   begin
      return Is_Selected (Node.Node.all, Event);
   end Is_Selected;

   --  ------------------------------
   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   --  ------------------------------
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean is
      use type MAT.Types.Target_Size;
      use type MAT.Types.Target_Tick_Ref;
   begin
      case Node.Kind is
         when N_NOT =>
            return not Is_Selected (Node.Expr.all, Addr, Allocation);

         when N_AND =>
            return Is_Selected (Node.Left.all, Addr, Allocation)
              and then Is_Selected (Node.Right.all, Addr, Allocation);

         when N_OR =>
            return Is_Selected (Node.Left.all, Addr, Allocation)
              or else Is_Selected (Node.Right.all, Addr, Allocation);

         when N_RANGE_SIZE =>
            return Allocation.Size >= Node.Min_Size
              and Allocation.Size <= Node.Max_Size;

         when N_RANGE_ADDR =>
            return Addr >= Node.Min_Addr
              and Addr <= Node.Max_Addr;

         when N_RANGE_TIME =>
            return Allocation.Time >= Node.Min_Time
              and Allocation.Time <= Node.Max_Time;

         when others =>
            return False;

      end case;
   end Is_Selected;

   --  ------------------------------
   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   --  ------------------------------
   function Is_Selected (Node       : in Node_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean is
      use type MAT.Types.Target_Size;
      use type MAT.Types.Target_Tick_Ref;
      use type MAT.Types.Target_Thread_Ref;
      use type MAT.Events.Targets.Event_Id_Type;
   begin
      case Node.Kind is
         when N_NOT =>
            return not Is_Selected (Node.Expr.all, Event);

         when N_AND =>
            return Is_Selected (Node.Left.all, Event)
              and then Is_Selected (Node.Right.all, Event);

         when N_OR =>
            return Is_Selected (Node.Left.all, Event)
              or else Is_Selected (Node.Right.all, Event);

         when N_RANGE_SIZE =>
            return Event.Size >= Node.Min_Size
              and Event.Size <= Node.Max_Size;

         when N_RANGE_ADDR =>
            return Event.Addr >= Node.Min_Addr
              and Event.Addr <= Node.Max_Addr;

         when N_RANGE_TIME =>
            return Event.Time >= Node.Min_Time
              and Event.Time <= Node.Max_Time;

         when N_EVENT =>
            return Event.Id >= Node.Min_Event
              and Event.Id <= Node.Max_Event;

         when N_THREAD =>
            return Event.Thread >= Node.Min_Thread
              and Event.Thread <= Node.Max_Thread;

         when others =>
            return False;

      end case;
   end Is_Selected;

   --  ------------------------------
   --  Parse the string and return the expression tree.
   --  ------------------------------
   function Parse (Expr : in String) return Expression_Type is
   begin
      return MAT.Expressions.Parser.Parse (Expr);
   end Parse;

   --  ------------------------------
   --  Destroy recursively the node, releasing the storage.
   --  ------------------------------
   procedure Destroy (Node : in out Node_Type_Access) is
      Release : Boolean;
   begin
      if Node /= null then
         Util.Concurrent.Counters.Decrement (Node.Ref_Counter, Release);
         if Release then
            case Node.Kind is
            when N_NOT =>
               Destroy (Node.Expr);

            when N_AND | N_OR =>
               Destroy (Node.Left);
               Destroy (Node.Right);

            when others =>
               null;
            end case;
            Free (Node);
         else
            Node := null;
         end if;
      end if;
   end Destroy;

   --  ------------------------------
   --  Release the reference and destroy the expression tree if it was the last reference.
   --  ------------------------------
   overriding
   procedure Finalize (Obj : in out Expression_Type) is
   begin
      if Obj.Node /= null then
         Destroy (Obj.Node);
      end if;
   end Finalize;

   --  ------------------------------
   --  Update the reference after an assignment.
   --  ------------------------------
   overriding
   procedure Adjust (Obj : in out Expression_Type) is
   begin
      if Obj.Node /= null then
         Util.Concurrent.Counters.Increment (Obj.Node.Ref_Counter);
      end if;
   end Adjust;

end MAT.Expressions;

Implement Create_Event_Type to build a new expression node


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

--  The Util.Encodes.SHA1 package generates SHA-1 hash according to
--  RFC3174 or [FIPS-180-1].
package Util.Encoders.AES is

   type AES_Mode is (ECB, CBC, PCBC, CFB, OFB, CTR);

   type Key_Type is private;

   --  ------------------------------
   --  ------------------------------
   subtype Block_Type is Ada.Streams.Stream_Element_Array (1 .. 16);

   AES_128_Length : constant := 16;
   AES_192_Length : constant := 24;
   AES_256_Length : constant := 32;

   subtype AES_128_Key is Ada.Streams.Stream_Element_Array (1 .. 16);
   subtype AES_192_Key is Ada.Streams.Stream_Element_Array (1 .. 24);
   subtype AES_256_Key is Ada.Streams.Stream_Element_Array (1 .. 32);

   type Word_Block_Type is array (1 .. 4) of Interfaces.Unsigned_32;

   procedure Set_Encrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Set_Decrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Encrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);
   procedure Encrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   procedure Encrypt (Input  : in Ada.Streams.Stream_Element_Array;
                      Output : out Ada.Streams.Stream_Element_Array;
                      Last   : out Ada.Streams.Stream_Element_Offset;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   type Cipher is tagged limited private;

   --  Set the encryption initialization vector before starting the encryption.
   procedure Set_IV (E  : in out Cipher;
                     IV : in Word_Block_Type);

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the encryption key to use.
   procedure Set_Key (E    : in out Encoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset)
     with Pre => Into'Length >= Block_Type'Length,
     Post => Last = Into'First - 1 or Last = Into'First + Block_Type'Length - 1;

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Decoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the decryption key to use.
   procedure Set_Key (E    : in out Decoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Decoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset);

private

   use Interfaces;

   type Block_Key is array (0 .. 59) of Unsigned_32;

   type Key_Type is record
      Key    : Block_Key := (others => 0);
      Rounds : Natural := 0;
   end record;

   type Cipher is limited new Ada.Finalization.Limited_Controlled with record
      IV         : Word_Block_Type;
      Key        : Key_Type;
      Mode       : AES_Mode := CBC;
      Data_Count : Ada.Streams.Stream_Element_Offset := 0;
      Data       : Block_Type;
   end record;

   overriding
   procedure Finalize (Object : in out Cipher);

   type Encoder is new Cipher and Util.Encoders.Transformer with null record;

   type Decoder is new Cipher and Util.Encoders.Transformer with null record;

end Util.Encoders.AES;

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

--  The Util.Encodes.SHA1 package generates SHA-1 hash according to
--  RFC3174 or [FIPS-180-1].
package Util.Encoders.AES is

   type AES_Mode is (ECB, CBC, PCBC, CFB, OFB, CTR);

   type Key_Type is private;

   --  ------------------------------
   --  ------------------------------
   subtype Block_Type is Ada.Streams.Stream_Element_Array (1 .. 16);

   AES_128_Length : constant := 16;
   AES_192_Length : constant := 24;
   AES_256_Length : constant := 32;

   subtype AES_128_Key is Ada.Streams.Stream_Element_Array (1 .. 16);
   subtype AES_192_Key is Ada.Streams.Stream_Element_Array (1 .. 24);
   subtype AES_256_Key is Ada.Streams.Stream_Element_Array (1 .. 32);

   type Word_Block_Type is array (1 .. 4) of Interfaces.Unsigned_32;

   procedure Set_Encrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Set_Decrypt_Key (Key  : out Key_Type;
                              Data : in Secret_Key)
     with Pre => Data.Length = 16 or Data.Length = 24 or Data.Length = 32;

   procedure Encrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);
   procedure Encrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   procedure Encrypt (Input  : in Ada.Streams.Stream_Element_Array;
                      Output : out Ada.Streams.Stream_Element_Array;
                      Last   : out Ada.Streams.Stream_Element_Offset;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   type Cipher is tagged limited private;

   --  Set the encryption initialization vector before starting the encryption.
   procedure Set_IV (E  : in out Cipher;
                     IV : in Word_Block_Type);

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the encryption key to use.
   procedure Set_Key (E    : in out Encoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset)
     with Pre => Into'Length >= Block_Type'Length,
     Post => Last = Into'First - 1 or Last = Into'First + Block_Type'Length - 1;

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Decoder is new Cipher and Util.Encoders.Transformer with private;

   --  Set the decryption key to use.
   procedure Set_Key (E    : in out Decoder;
                      Data : in Secret_Key;
                      Mode : in AES_Mode := CBC);

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Decoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset);

private

   use Interfaces;

   subtype Count_Type is Ada.Streams.Stream_Element_Offset range 0 .. 16;

   type Block_Key is array (0 .. 59) of Unsigned_32;

   type Key_Type is record
      Key    : Block_Key := (others => 0);
      Rounds : Natural := 0;
   end record;

   type Cipher is limited new Ada.Finalization.Limited_Controlled with record
      IV         : Word_Block_Type := (others => 0);
      Key        : Key_Type;
      Mode       : AES_Mode := CBC;
      Data_Count : Count_Type := 0;
      Data       : Block_Type;
      Data2      : Block_Type;
   end record;

   overriding
   procedure Finalize (Object : in out Cipher);

   type Encoder is new Cipher and Util.Encoders.Transformer with null record;

   type Decoder is new Cipher and Util.Encoders.Transformer with null record;

end Util.Encoders.AES;

Add Count_Type to better detect array indexing issues Add Data2 for some AES modes


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

with Util.Tests;
with Util.Test_Caller;

with ASF.Tests;
with AWA.Tests;
with AWA.Users.Models;
with AWA.Users.Services.Tests.Helpers;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Principals;
package body AWA.Users.Tests is

   use ASF.Tests;
   use AWA.Tests;

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Create_User (/users/register.xhtml)",
                       Test_Create_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Close_Session",
                       Test_Logout_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Login_User (/users/login.xhtml)",
                       Test_Login_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Lost_Password, Reset_Password",
                       Test_Reset_Password_User'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of user by simulating web requests.
   --  ------------------------------
   procedure Test_Create_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
	  Email   : constant String := "Joe-" & Util.Tests.Get_UUID & "@gmail.com";
      Principal : Services.Tests.Helpers.Test_User;
   begin
      Services.Tests.Helpers.Initialize (Principal);

      Do_Get (Request, Reply, "/auth/register.html", "create-user-1.html");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("password", "asdf");
      Request.Set_Parameter ("password2", "asdf");
      Request.Set_Parameter ("firstName", "joe");
      Request.Set_Parameter ("lastName", "dalton");
      Request.Set_Parameter ("register", "1");
      Do_Post (Request, Reply, "/auth/register.html", "create-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

	  --  Now, get the access key and simulate a click on the validation link.
	  declare

		 Key       : AWA.Users.Models.Access_Key_Ref;
      begin
	     Services.Tests.Helpers.Find_Access_Key (Principal, Email, Key);
		 T.Assert (not Key.Is_Null, "There is no access key associated with the user");
		 Request.Set_Parameter ("key", Key.Get_Access_Key);
		 Do_Get (Request, Reply, "/auth/validate.html", "validate-user-1.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");
      end;

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Create_User;

   procedure Test_Logout_User (T : in out Test) is
   begin
      null;
   end Test_Logout_User;

   --  ------------------------------
   --  Test user authentication by simulating a web request.
   --  ------------------------------
   procedure Test_Login_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Principal :Services.Tests.Helpers.Test_User;
   begin
      AWA.Tests.Set_Application_Context;
      Services.Tests.Helpers.Create_User (Principal, "Joe@gmail.com");

      Do_Get (Request, Reply, "/auth/login.html", "login-user-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

      Request.Set_Parameter ("email", "Joe@gmail.com");
      Request.Set_Parameter ("password", "admin");
      Request.Set_Parameter ("login", "1");
      Do_Post (Request, Reply, "/auth/login.html", "login-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Login_User;

   --  ------------------------------
   --  Test the reset password by simulating web requests.
   --  ------------------------------
   procedure Test_Reset_Password_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Email   : constant String := "Joe@gmail.com";
   begin
      Do_Get (Request, Reply, "/auth/lost-password.html", "lost-password-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("lost-password", "1");
      Do_Post (Request, Reply, "/auth/lost-password.html", "lost-password-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

	  --  Now, get the access key and simulate a click on the reset password link.
	  declare
         Principal : Services.Tests.Helpers.Test_User;
         Key       : AWA.Users.Models.Access_Key_Ref;
      begin
         AWA.Tests.Set_Application_Context;
	     Services.Tests.Helpers.Find_Access_Key (Principal, Email, Key);
		 T.Assert (not Key.Is_Null, "There is no access key associated with the user");

         --  Simulate user clicking on the reset password link.
         --  This verifies the key, login the user and redirect him to the change-password page
         Request.Set_Parameter ("key", Key.Get_Access_Key);
		 Do_Get (Request, Reply, "/auth/reset-password.html", "reset-password-1.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

         --  Post the reset password
		 Request.Set_Parameter ("password", "asd");
		 Request.Set_Parameter ("reset-password", "1");
		 Do_Post (Request, Reply, "/auth/change-password.html", "reset-password-2.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

         --  Check that the user is logged and we have a user principal now.
         t.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
	 end;
  end Test_Reset_Password_User;

end AWA.Users.Tests;

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

with Util.Tests;
with Util.Test_Caller;

with ASF.Tests;
with AWA.Tests;
with AWA.Users.Models;
with AWA.Users.Services.Tests.Helpers;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Principals;
package body AWA.Users.Tests is

   use ASF.Tests;
   use AWA.Tests;

   package Caller is new Util.Test_Caller (Test);

   procedure Add_Tests (Suite : AUnit.Test_Suites.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Create_User (/users/register.xhtml)",
                       Test_Create_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Close_Session",
                       Test_Logout_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Tests.Login_User (/users/login.xhtml)",
                       Test_Login_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Users.Services.Lost_Password, Reset_Password",
                       Test_Reset_Password_User'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of user by simulating web requests.
   --  ------------------------------
   procedure Test_Create_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
	  Email   : constant String := "Joe-" & Util.Tests.Get_UUID & "@gmail.com";
      Principal : Services.Tests.Helpers.Test_User;
   begin
      Services.Tests.Helpers.Initialize (Principal);

      Do_Get (Request, Reply, "/auth/register.html", "create-user-1.html");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("password", "asdf");
      Request.Set_Parameter ("password2", "asdf");
      Request.Set_Parameter ("firstName", "joe");
      Request.Set_Parameter ("lastName", "dalton");
      Request.Set_Parameter ("register", "1");
      Request.Set_Parameter ("register-button", "1");
      Do_Post (Request, Reply, "/auth/register.html", "create-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

	  --  Now, get the access key and simulate a click on the validation link.
	  declare

		 Key       : AWA.Users.Models.Access_Key_Ref;
      begin
	     Services.Tests.Helpers.Find_Access_Key (Principal, Email, Key);
		 T.Assert (not Key.Is_Null, "There is no access key associated with the user");
		 Request.Set_Parameter ("key", Key.Get_Access_Key);
		 Do_Get (Request, Reply, "/auth/validate.html", "validate-user-1.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");
      end;

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Create_User;

   procedure Test_Logout_User (T : in out Test) is
   begin
      null;
   end Test_Logout_User;

   --  ------------------------------
   --  Test user authentication by simulating a web request.
   --  ------------------------------
   procedure Test_Login_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Principal :Services.Tests.Helpers.Test_User;
   begin
      AWA.Tests.Set_Application_Context;
      Services.Tests.Helpers.Create_User (Principal, "Joe@gmail.com");

      Do_Get (Request, Reply, "/auth/login.html", "login-user-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      --  Check that the user is NOT logged.
      T.Assert (Request.Get_User_Principal = null, "A user principal should not be defined");

      Request.Set_Parameter ("email", "Joe@gmail.com");
      Request.Set_Parameter ("password", "admin");
      Request.Set_Parameter ("login", "1");
      Request.Set_Parameter ("login-button", "1");
      Do_Post (Request, Reply, "/auth/login.html", "login-user-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

      --  Check that the user is logged and we have a user principal now.
      T.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
   end Test_Login_User;

   --  ------------------------------
   --  Test the reset password by simulating web requests.
   --  ------------------------------
   procedure Test_Reset_Password_User (T : in out Test) is
      use type ASF.Principals.Principal_Access;

      Request : ASF.Requests.Mockup.Request;
      Reply   : ASF.Responses.Mockup.Response;
      Email   : constant String := "Joe@gmail.com";
   begin
      Do_Get (Request, Reply, "/auth/lost-password.html", "lost-password-1.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

      Request.Set_Parameter ("email", Email);
      Request.Set_Parameter ("lost-password", "1");
      Request.Set_Parameter ("lost-password-button", "1");
      Do_Post (Request, Reply, "/auth/lost-password.html", "lost-password-2.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

	  --  Now, get the access key and simulate a click on the reset password link.
	  declare
         Principal : Services.Tests.Helpers.Test_User;
         Key       : AWA.Users.Models.Access_Key_Ref;
      begin
         AWA.Tests.Set_Application_Context;
	     Services.Tests.Helpers.Find_Access_Key (Principal, Email, Key);
		 T.Assert (not Key.Is_Null, "There is no access key associated with the user");

         --  Simulate user clicking on the reset password link.
         --  This verifies the key, login the user and redirect him to the change-password page
         Request.Set_Parameter ("key", Key.Get_Access_Key);
		 Do_Get (Request, Reply, "/auth/reset-password.html", "reset-password-1.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY, "Invalid response");

         --  Post the reset password
		 Request.Set_Parameter ("password", "asd");
		 Request.Set_Parameter ("reset-password", "1");
		 Do_Post (Request, Reply, "/auth/change-password.html", "reset-password-2.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_OK, "Invalid response");

         --  Check that the user is logged and we have a user principal now.
         t.Assert (Request.Get_User_Principal /= null, "A user principal should be defined");
	 end;
  end Test_Reset_Password_User;

end AWA.Users.Tests;

Fix unit test after changes in XHTML files


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

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

with ASF.Contexts.Faces;
with ASF.Components;
with ASF.Components.Html;

with Wiki.Strings;
with Wiki.Render;
with Wiki.Plugins;
with Wiki.Render.Links;
package AWA.Components.Wikis is

   use ASF.Contexts.Faces;

   --  The wiki format of the wiki text.  The valid values are:
   --  dotclear, google, creole, phpbb, mediawiki
   FORMAT_NAME : constant String := "format";

   VALUE_NAME  : constant String := ASF.Components.VALUE_NAME;

   --  The link renderer bean that controls the generation of page and image links.
   LINKS_NAME  : constant String := "links";

   --  The plugin factory bean that must be used for Wiki plugins.
   PLUGINS_NAME  : constant String := "plugins";

   --  ------------------------------
   --  Wiki component
   --  ------------------------------
   --
   --  <awa:wiki value="wiki-text" format="dotclear|google|creole|phpbb" styleClass="class"/>
   --
   type UIWiki is new ASF.Components.Html.UIHtmlComponent with null record;
   type UIWiki_Access is access all UIWiki'Class;

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

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

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

   --  Render the wiki text
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class);

   use Ada.Strings.Wide_Wide_Unbounded;

   IMAGE_PREFIX_ATTR : constant String := "image_prefix";
   PAGE_PREFIX_ATTR  : constant String := "page_prefix";

   type Link_Renderer_Bean is new Util.Beans.Basic.Bean
     and Wiki.Render.Links.Link_Renderer with record
      Page_Prefix  : Unbounded_Wide_Wide_String;
      Image_Prefix : Unbounded_Wide_Wide_String;
   end record;

   --  Make a link adding a prefix unless the link is already absolute.
   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);

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

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

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

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

private

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean;

end AWA.Components.Wikis;

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

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

with ASF.Contexts.Faces;
with ASF.Components;
with ASF.Components.Html;

with Wiki.Strings;
with Wiki.Render;
with Wiki.Plugins;
with Wiki.Render.Links;
package AWA.Components.Wikis is

   use ASF.Contexts.Faces;

   --  The wiki format of the wiki text.  The valid values are:
   --  dotclear, google, creole, phpbb, mediawiki
   FORMAT_NAME : constant String := "format";

   VALUE_NAME  : constant String := ASF.Components.VALUE_NAME;

   --  The link renderer bean that controls the generation of page and image links.
   LINKS_NAME  : constant String := "links";

   --  The plugin factory bean that must be used for Wiki plugins.
   PLUGINS_NAME  : constant String := "plugins";

   --  ------------------------------
   --  Wiki component
   --  ------------------------------
   --
   --  <awa:wiki value="wiki-text" format="dotclear|google|creole|phpbb" styleClass="class"/>
   --
   type UIWiki is new ASF.Components.Html.UIHtmlComponent with null record;
   type UIWiki_Access is access all UIWiki'Class;

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

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

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

   --  Render the wiki text
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class);

   use Ada.Strings.Wide_Wide_Unbounded;

   IMAGE_PREFIX_ATTR : constant String := "image_prefix";
   PAGE_PREFIX_ATTR  : constant String := "page_prefix";

   type Link_Renderer_Bean is new Util.Beans.Basic.Bean
     and Wiki.Render.Links.Link_Renderer with record
      Page_Prefix  : Unbounded_Wide_Wide_String;
      Image_Prefix : Unbounded_Wide_Wide_String;
   end record;

   --  Make a link adding a prefix unless the link is already absolute.
   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);

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

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

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

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

private

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean;

end AWA.Components.Wikis;

Change the link renderer to in out parameter


-----------------------------------------------------------------------
--  awa-mail-client -- Mail client interface
--  Copyright (C) 2012, 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 Ada.Strings.Unbounded;
with Util.Properties;

--  The AWA.Mail.Clients package defines a mail client API used by the mail module.
--  It defines two interfaces that must be implemented.  This allows to have an implementation
--  based on an external application such as <tt>sendmail</tt> and other implementation that
--  use an SMTP connection.
package AWA.Mail.Clients is

   use Ada.Strings.Unbounded;

   type Recipient_Type is (TO, CC, BCC);

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The Mail_Message represents an abstract mail message that can be initialized
   --  before being sent.
   type Mail_Message is limited interface;
   type Mail_Message_Access is access all Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   procedure Set_From (Message : in out Mail_Message;
                       Name    : in String;
                       Address : in String) is abstract;

   --  Add a recipient for the message.
   procedure Add_Recipient (Message : in out Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is abstract;

   --  Set the subject of the message.
   procedure Set_Subject (Message : in out Mail_Message;
                          Subject : in String) is abstract;

   --  Set the body of the message.
   procedure Set_Body (Message      : in out Mail_Message;
                       Content      : in Unbounded_String;
                       Alternative  : in Unbounded_String;
                       Content_Type : in String := "") is abstract;

   --  Add an attachment with the given content.
   procedure Add_Attachment (Message      : in out Mail_Message;
                             Content      : in Unbounded_String;
                             Content_Id   : in String;
                             Content_Type : in String) is abstract;

   --  Send the email message.
   procedure Send (Message : in out Mail_Message) is abstract;

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type Mail_Manager is limited interface;
   type Mail_Manager_Access is access all Mail_Manager'Class;

   --  Create a new mail message.
   function Create_Message (Manager : in Mail_Manager) return Mail_Message_Access is abstract;

   --  Factory to create the mail manager.  The mail manager implementation is identified by
   --  the Name.  It is configured according to the properties defined in Props.
   --  Returns null if the mail manager identified by the name is not supported.
   function Factory (Name  : in String;
                     Props : in Util.Properties.Manager'Class)
                     return Mail_Manager_Access;

end AWA.Mail.Clients;

-----------------------------------------------------------------------
--  awa-mail-client -- Mail client interface
--  Copyright (C) 2012, 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 Ada.Strings.Unbounded;
with Util.Properties;

--  The AWA.Mail.Clients package defines a mail client API used by the mail module.
--  It defines two interfaces that must be implemented.  This allows to have an implementation
--  based on an external application such as <tt>sendmail</tt> and other implementation that
--  use an SMTP connection.
package AWA.Mail.Clients is

   use Ada.Strings.Unbounded;

   type Recipient_Type is (TO, CC, BCC);

   --  ------------------------------
   --  Mail Message
   --  ------------------------------
   --  The Mail_Message represents an abstract mail message that can be initialized
   --  before being sent.
   type Mail_Message is limited interface;
   type Mail_Message_Access is access all Mail_Message'Class;

   --  Set the <tt>From</tt> part of the message.
   procedure Set_From (Message : in out Mail_Message;
                       Name    : in String;
                       Address : in String) is abstract;

   --  Add a recipient for the message.
   procedure Add_Recipient (Message : in out Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is abstract;

   --  Set the subject of the message.
   procedure Set_Subject (Message : in out Mail_Message;
                          Subject : in String) is abstract;

   --  Set the body of the message.
   procedure Set_Body (Message      : in out Mail_Message;
                       Content      : in Unbounded_String;
                       Alternative  : in Unbounded_String;
                       Content_Type : in String := "") is abstract;

   --  Add an attachment with the given content.
   procedure Add_Attachment (Message      : in out Mail_Message;
                             Content      : in Unbounded_String;
                             Content_Id   : in String;
                             Content_Type : in String) is abstract;

   --  Add a file attachment.
   procedure Add_File_Attachment (Message      : in out Mail_Message;
                                  Filename     : in String;
                                  Content_Id   : in String;
                                  Content_Type : in String) is abstract;

   --  Send the email message.
   procedure Send (Message : in out Mail_Message) is abstract;

   --  ------------------------------
   --  Mail Manager
   --  ------------------------------
   --  The Mail_Manager is the entry point to create a new mail message
   --  and be able to send it.
   type Mail_Manager is limited interface;
   type Mail_Manager_Access is access all Mail_Manager'Class;

   --  Create a new mail message.
   function Create_Message (Manager : in Mail_Manager) return Mail_Message_Access is abstract;

   --  Factory to create the mail manager.  The mail manager implementation is identified by
   --  the Name.  It is configured according to the properties defined in Props.
   --  Returns null if the mail manager identified by the name is not supported.
   function Factory (Name  : in String;
                     Props : in Util.Properties.Manager'Class)
                     return Mail_Manager_Access;

end AWA.Mail.Clients;

Declare the Add_File_Attachment procedure


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

with ADO;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

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

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

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

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

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

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

   --  Load the image data associated with a blog post.  The image must be public and the
   --  post visible for the image to be retrieved by anonymous users.
   procedure Load_Image (Model    : in Blog_Module;
                         Post_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref);

private

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

end AWA.Blogs.Modules;

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

with ADO;
with Wiki.Strings;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  The configuration parameter that defines the image link prefix in rendered HTML content.
   PARAM_IMAGE_PREFIX : constant String := "image_prefix";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

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

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Blog_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

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

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

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

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

   --  Load the image data associated with a blog post.  The image must be public and the
   --  post visible for the image to be retrieved by anonymous users.
   procedure Load_Image (Model    : in Blog_Module;
                         Post_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref);

private

   type Blog_Module is new AWA.Modules.Module with record
      Image_Prefix : Wiki.Strings.UString;
   end record;

end AWA.Blogs.Modules;

Declare PARAM_IMAGE_PREFIX constant and override the Configure procedure