------------------------------------------------------------------------------
-- Copyright (c) 2014-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Cron.Tests is

   --------------------
   -- Test Callbacks --
   --------------------

   overriding procedure Run (Self : in out Test_Callback) is
   begin
      Append (Self.Backend.all, Self.Symbol);
   end Run;

   overriding procedure Run (Self : in out Long_Callback) is
   begin
      Append (Self.Backend.all, Self.Open);
      delay Self.Wait;
      Append (Self.Backend.all, Self.Close);
   end Run;

   --------------------
   -- Bounded String --
   --------------------

   procedure Append (S : in out Bounded_String; C : Character) is
   begin
      S.Size := S.Size + 1;
      S.Data (S.Size) := C;
   end Append;

   function Get (S : Bounded_String) return String is
   begin
      return S.Data (1 .. S.Size);
   end Get;

   procedure Reset (S : in out Bounded_String) is
   begin
      S.Size := 0;
   end Reset;

   -----------------
   -- Test Helper --
   -----------------

   function Quote (Data : String) return String
     is ('"' & Data & '"');

   procedure Check is new NT.Generic_Check (String, "=", Quote, False);

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Basic_Usage (Report);
      Delete_While_Busy (Report);
      Insert_While_Busy (Report);
      Time_Collision (Report);
      Delete_While_Collision (Report);
      Event_List_Fusion (Report);
   end All_Tests;

   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Basic_Usage (Report : in out NT.Reporter'Class) is
      use type Ada.Calendar.Time;

      Test : NT.Test := Report.Item ("Basic black-box usage");
      Total : constant Duration := 10.0;
      Tick : constant Duration := Total / 10;
      Half_Tick : constant Duration := Tick / 2;
      Log : aliased Bounded_String (256);
   begin
      declare
         Beat : constant Cron_Entry := Create
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           (Ada.Calendar.Clock + Half_Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 'o'));
         pragma Unreferenced (One_Time_Entry);

         Test_Entry : Cron_Entry;
      begin
         delay Half_Tick;
         Test_Entry.Set
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         delay 3 * Tick + Half_Tick;
         Test_Entry.Reset;
         delay Half_Tick;
      end;

      Append (Log, '|');
      delay Tick / 10;

      declare
         Beat : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Half_Tick,
             Period => Tick),
            Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Tick,
             Period => -Half_Tick),
            Test_Callback'(Backend => Log'Access, Symbol => 'O'));
         pragma Unreferenced (One_Time_Entry);

         Slow, Fast : Cron_Entry;
      begin
         Slow.Set
           (2 * Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 's'));
         delay 2 * Tick;
         Fast.Set
           (Tick / 5,
            Test_Callback'(Backend => Log'Access, Symbol => 'f'));
         delay Tick + Half_Tick;
         Fast.Reset;
         delay Tick + Half_Tick;
      end;

      --  Timeline, in ticks:
      --  Beat: set at 0.0, finalized at 4.5, run at 1.0, 2.0, 3.0, 4.0.
      --  Test_Entry: set at 0.5, reset at 4.0, run at 1.5, 2.5, 3.5.
      --  Beat: set at 4.5, finalized at 9.5, run at 5.0, 6.0, 7.0, 8.0, 9.0.
      --  Slow: set at 4.5, finalized at 9.5, run at 6.5, 8.5.
      --  Fast: set at 6.5, reset at 8.0,
      --        run at 6.7, 6.9, 7.1, 7.3, 7.5, 7.7, 7.9

      Check (Test, Get (Log), "o.1.1.1.|.O.sff.fffff.s.");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Basic_Usage;

   procedure Delete_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Delete entry while callback is running");
      Total : constant Duration := 0.01;
      Log : aliased Bounded_String (256);
   begin
      declare
         Test_Entry : Cron_Entry;
      begin
         Test_Entry.Set (Total / 8, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 4));
         delay Total / 4;
      end;

      Check (Test, Get (Log), "(", "Before wait");
      delay Total / 2;
      Check (Test, Get (Log), "()", "After wait");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Busy;

   procedure Delete_While_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test
        := Report.Item ("Delete entry while callback list is running");
      Total : constant Duration := 0.0625;
      Tick : constant Duration := Total / 8;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time
           := (Origin => Ada.Calendar.Clock + 2 * Tick,
               Period => 8 * Tick);
         First, Second : Cron_Entry;
      begin
         First.Set (Common, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => 2 * Tick));
         Second.Set (Common, Long_Callback'
           (Backend => Log'Access,
            Open => '<',
            Close => '>',
            Wait => 2 * Tick));
         delay 3 * Tick;
      end;

      --  Timeline:  0  .  1/4  .  1/2  .  3/4  .   1   .  5/4
      --  Triggers:         *                               *
      --  Log:              (       )<      >               (
      --  End of Block:         ^
      --  End of Test:                          ^

      Check (Test, Get (Log), "(");
      delay 4 * Tick;
      Check (Test, Get (Log), "()<>");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Collision;

   procedure Event_List_Fusion (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Fusion of synchronized callbacks");
      Total : constant Duration := 0.25;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         First_Tick : constant Periodic_Time
           := (Origin => Ada.Calendar.Clock + Total / 8,
               Period => Total / 4);
         Second_Tick : constant Periodic_Time
           := (Origin => First_Tick.Origin + First_Tick.Period,
               Period => First_Tick.Period);

         A_Head, A_Tail, B_Head, B_Tail : Cron_Entry;
      begin
         A_Head.Set (First_Tick, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 8));
         A_Tail.Set (First_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'A'));

         delay Total / 8 + Total / 16;
         Check (Test, Get (Log), "(");

         B_Head.Set (Second_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'B'));
         B_Tail.Set (Second_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'b'));

         delay Total / 4 + Total / 8;
         Check (Test, Get (Log), "()ABb()A");

         A_Tail.Reset;
         B_Tail.Reset;

         delay Total / 4;
         Check (Test, Get (Log), "()ABb()AB()");
      end;

      --  Timeline:  0   .   1/4   .   1/2   .   3/4   .   1
      --  Log:           (    )A  Bb(   )A   B(   )
      --  Code:      *     *               *         *   *

      delay Total / 8;
      Check (Test, Get (Log), "()ABb()AB()");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Event_List_Fusion;

   procedure Insert_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Insert entry while callback is running");
      Total : constant Duration := 1.0;
      Log : aliased Bounded_String (256);
   begin
      declare
         Long, Short : Cron_Entry;
      begin
         Long.Set
           (Total / 8,
            Long_Callback'
              (Backend => Log'Access,
               Open => '(',
               Close => ')',
               Wait => Total / 5));

         delay Total / 8 + Total / 16;

         Short.Set
           (Total / 8,
            Test_Callback'(Backend => Log'Access, Symbol => '.'));

         delay Total / 2 + Total / 8;
      end;

      --  Timeline: 0 . 1/8 . 1/4 .   3/8 . 1/2 .   5/8 . 3/4 . 7/8 . 1
      --  Set:      L       S
      --  Finalize:                                        *
      --  Ticks:         L     L  S    L  S  L  S    L  S  L
      --  Run:           <----L---->S  <----L---->S  <----L---->

      delay Total / 8;
      Check (Test, Get (Log), "().().()");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Insert_While_Busy;

   procedure Time_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Simultaneous activation of events");
      Total : constant Duration := 0.01;
      Tick : constant Duration := Total / 4;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time := (Ada.Calendar.Clock + Tick, Tick);
         First, Second, Third : Cron_Entry;
      begin
         First.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         Second.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '2'));
         Third.Set
           ((Origin => Common.Origin, Period => 2 * Common.Period),
            Test_Callback'(Backend => Log'Access, Symbol => '3'));
         delay Total - Tick / 2;
      end;

      Check (Test, Get (Log), "12312123");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Time_Collision;

end Natools.Cron.Tests;

------------------------------------------------------------------------------
-- Copyright (c) 2014-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Cron.Tests is

   --------------------
   -- Test Callbacks --
   --------------------

   overriding procedure Run (Self : in out Test_Callback) is
   begin
      Append (Self.Backend.all, Self.Symbol);
   end Run;

   overriding procedure Run (Self : in out Long_Callback) is
   begin
      Append (Self.Backend.all, Self.Open);
      delay Self.Wait;
      Append (Self.Backend.all, Self.Close);
   end Run;

   --------------------
   -- Bounded String --
   --------------------

   procedure Append (S : in out Bounded_String; C : Character) is
   begin
      S.Size := S.Size + 1;
      S.Data (S.Size) := C;
   end Append;

   function Get (S : Bounded_String) return String is
   begin
      return S.Data (1 .. S.Size);
   end Get;

   procedure Reset (S : in out Bounded_String) is
   begin
      S.Size := 0;
   end Reset;

   -----------------
   -- Test Helper --
   -----------------

   function Quote (Data : String) return String
     is ('"' & Data & '"');

   procedure Check is new NT.Generic_Check (String, "=", Quote, False);

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Basic_Usage (Report);
      Delete_While_Busy (Report);
      Insert_While_Busy (Report);
      Time_Collision (Report);
      Delete_While_Collision (Report);
      Event_List_Fusion (Report);
   end All_Tests;

   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Basic_Usage (Report : in out NT.Reporter'Class) is
      use type Ada.Calendar.Time;

      Test : NT.Test := Report.Item ("Basic black-box usage");
      Total : constant Duration := 10.0;
      Tick : constant Duration := Total / 10;
      Half_Tick : constant Duration := Tick / 2;
      Log : aliased Bounded_String (256);
   begin
      declare
         Beat : constant Cron_Entry := Create
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           (Ada.Calendar.Clock + Half_Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 'o'));
         pragma Unreferenced (One_Time_Entry);

         Test_Entry : Cron_Entry;
      begin
         delay Half_Tick;
         Test_Entry.Set
           (Tick, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         delay 3 * Tick + Half_Tick;
         Test_Entry.Reset;
         delay Half_Tick;
      end;

      Append (Log, '|');
      delay Tick / 10;

      declare
         Beat : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Half_Tick,
             Period => Tick),
            Test_Callback'(Backend => Log'Access, Symbol => '.'));
         pragma Unreferenced (Beat);

         One_Time_Entry : constant Cron_Entry := Create
           ((Origin => Ada.Calendar.Clock + Tick,
             Period => -Half_Tick),
            Test_Callback'(Backend => Log'Access, Symbol => 'O'));
         pragma Unreferenced (One_Time_Entry);

         Slow, Fast : Cron_Entry;
      begin
         Slow.Set
           (2 * Tick,
            Test_Callback'(Backend => Log'Access, Symbol => 's'));
         delay 2 * Tick;
         Fast.Set
           (Tick / 5,
            Test_Callback'(Backend => Log'Access, Symbol => 'f'));
         delay Tick + Half_Tick;
         Fast.Reset;
         delay Tick + Half_Tick;
      end;

      --  Timeline, in ticks:
      --  Beat: set at 0.0, finalized at 4.5, run at 1.0, 2.0, 3.0, 4.0.
      --  Test_Entry: set at 0.5, reset at 4.0, run at 1.5, 2.5, 3.5.
      --  Beat: set at 4.5, finalized at 9.5, run at 5.0, 6.0, 7.0, 8.0, 9.0.
      --  Slow: set at 4.5, finalized at 9.5, run at 6.5, 8.5.
      --  Fast: set at 6.5, reset at 8.0,
      --        run at 6.7, 6.9, 7.1, 7.3, 7.5, 7.7, 7.9

      Check (Test, "o.1.1.1.|.O.sff.fffff.s.", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Basic_Usage;

   procedure Delete_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Delete entry while callback is running");
      Total : constant Duration := 0.01;
      Log : aliased Bounded_String (256);
   begin
      declare
         Test_Entry : Cron_Entry;
      begin
         Test_Entry.Set (Total / 8, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 4));
         delay Total / 4;
      end;

      Check (Test, "(", Get (Log), "Before wait");
      delay Total / 2;
      Check (Test, "()", Get (Log), "After wait");
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Busy;

   procedure Delete_While_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test
        := Report.Item ("Delete entry while callback list is running");
      Total : constant Duration := 0.0625;
      Tick : constant Duration := Total / 8;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time
           := (Origin => Ada.Calendar.Clock + 2 * Tick,
               Period => 8 * Tick);
         First, Second : Cron_Entry;
      begin
         First.Set (Common, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => 2 * Tick));
         Second.Set (Common, Long_Callback'
           (Backend => Log'Access,
            Open => '<',
            Close => '>',
            Wait => 2 * Tick));
         delay 3 * Tick;
      end;

      --  Timeline:  0  .  1/4  .  1/2  .  3/4  .   1   .  5/4
      --  Triggers:         *                               *
      --  Log:              (       )<      >               (
      --  End of Block:         ^
      --  End of Test:                          ^

      Check (Test, "(", Get (Log));
      delay 4 * Tick;
      Check (Test, "()<>", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Delete_While_Collision;

   procedure Event_List_Fusion (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Fusion of synchronized callbacks");
      Total : constant Duration := 0.25;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         First_Tick : constant Periodic_Time
           := (Origin => Ada.Calendar.Clock + Total / 8,
               Period => Total / 4);
         Second_Tick : constant Periodic_Time
           := (Origin => First_Tick.Origin + First_Tick.Period,
               Period => First_Tick.Period);

         A_Head, A_Tail, B_Head, B_Tail : Cron_Entry;
      begin
         A_Head.Set (First_Tick, Long_Callback'
           (Backend => Log'Access,
            Open => '(',
            Close => ')',
            Wait => Total / 8));
         A_Tail.Set (First_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'A'));

         delay Total / 8 + Total / 16;
         Check (Test, "(", Get (Log));

         B_Head.Set (Second_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'B'));
         B_Tail.Set (Second_Tick, Test_Callback'
           (Backend => Log'Access,
            Symbol => 'b'));

         delay Total / 4 + Total / 8;
         Check (Test, "()ABb()A", Get (Log));

         A_Tail.Reset;
         B_Tail.Reset;

         delay Total / 4;
         Check (Test, "()ABb()AB()", Get (Log));
      end;

      --  Timeline:  0   .   1/4   .   1/2   .   3/4   .   1
      --  Log:           (    )A  Bb(   )A   B(   )
      --  Code:      *     *               *         *   *

      delay Total / 8;
      Check (Test, "()ABb()AB()", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Event_List_Fusion;

   procedure Insert_While_Busy (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Insert entry while callback is running");
      Total : constant Duration := 1.0;
      Log : aliased Bounded_String (256);
   begin
      declare
         Long, Short : Cron_Entry;
      begin
         Long.Set
           (Total / 8,
            Long_Callback'
              (Backend => Log'Access,
               Open => '(',
               Close => ')',
               Wait => Total / 5));

         delay Total / 8 + Total / 16;

         Short.Set
           (Total / 8,
            Test_Callback'(Backend => Log'Access, Symbol => '.'));

         delay Total / 2 + Total / 8;
      end;

      --  Timeline: 0 . 1/8 . 1/4 .   3/8 . 1/2 .   5/8 . 3/4 . 7/8 . 1
      --  Set:      L       S
      --  Finalize:                                        *
      --  Ticks:         L     L  S    L  S  L  S    L  S  L
      --  Run:           <----L---->S  <----L---->S  <----L---->

      delay Total / 8;
      Check (Test, "().().()", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Insert_While_Busy;

   procedure Time_Collision (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Simultaneous activation of events");
      Total : constant Duration := 0.01;
      Tick : constant Duration := Total / 4;
      Log : aliased Bounded_String (256);
   begin
      declare
         use type Ada.Calendar.Time;
         Common : constant Periodic_Time := (Ada.Calendar.Clock + Tick, Tick);
         First, Second, Third : Cron_Entry;
      begin
         First.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '1'));
         Second.Set
           (Common, Test_Callback'(Backend => Log'Access, Symbol => '2'));
         Third.Set
           ((Origin => Common.Origin, Period => 2 * Common.Period),
            Test_Callback'(Backend => Log'Access, Symbol => '3'));
         delay Total - Tick / 2;
      end;

      Check (Test, "12312123", Get (Log));
   exception
      when Error : others => Test.Report_Exception (Error);
   end Time_Collision;

end Natools.Cron.Tests;

fix argument order in calls to Check

cron-tests: fix argument order in calls to Check


-----------------------------------------------------------------------
--  druss-commands-get -- Raw JSON API Get command
--  Copyright (C) 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.
-----------------------------------------------------------------------

package Druss.Commands.Get is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   --  Execute the GET API operation and print the raw JSON result.
   procedure Execute_Operation (Command   : in Command_Type;
                                Operation : in String;
                                Context   : in out Context_Type);

   --  Execute a GET operation on the Bbox API and return the raw JSON result.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

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

end Druss.Commands.Get;

-----------------------------------------------------------------------
--  druss-commands-get -- Raw JSON API Get command
--  Copyright (C) 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.
-----------------------------------------------------------------------

package Druss.Commands.Get is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   --  Execute a GET operation on the Bbox API and return the raw JSON result.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

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

end Druss.Commands.Get;

Remove Execute_Operation procedure

Remove Execute_Operation procedure


-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  Copyright (C) 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 ADO;
with ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Helpers.Requests;
with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
package body AWA.Storages.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "folderId" then
         return ADO.Objects.To_Object (From.Get_Folder.Get_Key);
      end if;
      return AWA.Storages.Models.Storage_Ref (From).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
      Folder  : Models.Storage_Folder_Ref;
   begin
      if Name = "folderId" then
         Manager.Load_Folder (Folder, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
         From.Set_Folder (Folder);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Save the uploaded file in the storage service.
   --  ------------------------------
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Bean.Set_Name (Part.Get_Name);
      Bean.Set_Mime_Type (Part.Get_Content_Type);
      Bean.Set_File_Size (Part.Get_Size);
      Manager.Save (Bean, Part, AWA.Storages.Models.DATABASE);
   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is

   begin
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Upload;

   --  ------------------------------
   --  Delete the file.
   --  @method
   --  ------------------------------
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Delete (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Delete;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if ADO.Objects.Is_Null (From) then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Folder_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Save_Folder (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Save;

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return Models.Storage_Info_List_Bean (List).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create the Folder_List_Bean bean instance.
   --  ------------------------------
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Folder_Info_List_Bean_Access := new Folder_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Folder_List_Bean;

   --  ------------------------------
   --  Create the Storage_List_Bean bean instance.
   --  ------------------------------
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Object    : constant Storage_List_Bean_Access := new Storage_List_Bean;
      Session   : ADO.Sessions.Session := Module.Get_Session;
      Query     : ADO.Queries.Context;
      Folder_Id : constant ADO.Identifier := Helpers.Requests.Get_Parameter (FOLDER_ID_PARAMETER);
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Folder_Id = ADO.NO_IDENTIFIER then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Folder_Id);
      end if;
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Storage_List_Bean;

end AWA.Storages.Beans;

-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  Copyright (C) 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 ADO;
with ADO.Queries;
with ADO.Sessions;
with ADO.Objects;
with ADO.Sessions.Entities;

with AWA.Helpers.Requests;
with AWA.Workspaces.Models;
with AWA.Services.Contexts;
with AWA.Storages.Services;
package body AWA.Storages.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "folderId" then
         return ADO.Objects.To_Object (From.Get_Folder.Get_Key);
      elsif From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
      Manager : constant Services.Storage_Service_Access := From.Module.Get_Storage_Manager;
      Folder  : Models.Storage_Folder_Ref;
   begin
      if Name = "folderId" then
         Manager.Load_Folder (Folder, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
         From.Set_Folder (Folder);
      elsif Name = "id" then
         Manager.Load_Storage (From, ADO.Identifier (Util.Beans.Objects.To_Integer (Value)));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Save the uploaded file in the storage service.
   --  ------------------------------
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Bean.Set_Name (Part.Get_Name);
      Bean.Set_Mime_Type (Part.Get_Content_Type);
      Bean.Set_File_Size (Part.Get_Size);
      Manager.Save (Bean, Part, AWA.Storages.Models.DATABASE);
   end Save_Part;

   --  ------------------------------
   --  Upload the file.
   --  ------------------------------
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is

   begin
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Upload;

   --  ------------------------------
   --  Delete the file.
   --  @method
   --  ------------------------------
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Delete (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Delete;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if ADO.Objects.Is_Null (From) then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Storages.Models.Storage_Folder_Ref (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "name" then
         From.Set_Name (Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  ------------------------------
   --  Create or save the folder.
   --  ------------------------------
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Storage_Service_Access := Bean.Module.Get_Storage_Manager;
   begin
      Manager.Save_Folder (Bean);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("success");
   end Save;

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return Models.Storage_Info_List_Bean (List).Get_Value (Name);
   end Get_Value;

   --  ------------------------------
   --  Create the Folder_List_Bean bean instance.
   --  ------------------------------
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;

      Object  : constant Folder_Info_List_Bean_Access := new Folder_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_Folder_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Folder_List_Bean;

   --  ------------------------------
   --  Create the Storage_List_Bean bean instance.
   --  ------------------------------
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Storages.Models;
      use AWA.Services;
      use type ADO.Identifier;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User      : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Object    : constant Storage_List_Bean_Access := new Storage_List_Bean;
      Session   : ADO.Sessions.Session := Module.Get_Session;
      Query     : ADO.Queries.Context;
      Folder_Id : constant ADO.Identifier := Helpers.Requests.Get_Parameter (FOLDER_ID_PARAMETER);
   begin
      Query.Set_Query (AWA.Storages.Models.Query_Storage_List);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE, Session);
      if Folder_Id = ADO.NO_IDENTIFIER then
         Query.Bind_Null_Param ("folder_id");
      else
         Query.Bind_Param ("folder_id", Folder_Id);
      end if;
      AWA.Storages.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Storage_List_Bean;

end AWA.Storages.Beans;

Load the storage object

Load the storage object


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

with Security.Permissions;

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  The authentication process is the following:
--
--    * The Initialize procedure is called to configure the OpenID realm and set the
--      OpenID return callback CB.
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--    * The Get_Authentication_URL builds the provider OpenID authentication
--      URL for the association.
--    * The application should redirected the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  There are basically two steps that an application must implement.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  == Step 1: creating the authentication URL ==
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  do the association and get an End_Point.
--
--    Mgr   : Openid.Manager;
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The
--
--    Server.Initialize (Mgr);
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  == Step 2: verify the authentication in the callback URL ==
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Mgr     : Openid.Manager;
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Server.Initialize (Mgr);
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

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

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Permissions.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
   function Has_Role (User : in Principal;
                      Role : in Permissions.Role_Type) return Boolean;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String;

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

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

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

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

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

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

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

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

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

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

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

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

   type Principal is new Security.Permissions.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

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

--  with Security.Permissions;

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  The authentication process is the following:
--
--    * The Initialize procedure is called to configure the OpenID realm and set the
--      OpenID return callback CB.
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--    * The Get_Authentication_URL builds the provider OpenID authentication
--      URL for the association.
--    * The application should redirected the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  There are basically two steps that an application must implement.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  == Discovery: creating the authentication URL ==
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  do the association and get an End_Point.
--
--    Mgr   : Openid.Manager;
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The
--
--    Server.Initialize (Mgr);
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  == Verify: acknowledge the authentication in the callback URL ==
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Mgr     : Openid.Manager;
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Server.Initialize (Mgr);
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

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

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
--     function Has_Role (User : in Principal;
--                        Role : in Permissions.Role_Type) return Boolean;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String;

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

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

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

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

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

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

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

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

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

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

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

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

   type Principal is new Security.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

Use the Principal defined in the Security package Add some documentation


-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 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 AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Modules.Get;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Users.Models;
with AWA.Wikis.Beans;
with AWA.Modules.Beans;

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

with Util.Log.Loggers;
package body AWA.Wikis.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Wikis.Module");

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

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

      --  Setup the resource bundles.
      App.Register ("wikiMsg", "wikis");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Space_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Space_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Admin_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Admin_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Page_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Page_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_List_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_List_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_View_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_View_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Version_List_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Version_List_Bean'Access);

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

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the wikis module.
   --  ------------------------------
   function Get_Wiki_Module return Wiki_Module_Access is
      function Get is new AWA.Modules.Get (Wiki_Module, Wiki_Module_Access, NAME);
   begin
      return Get;
   end Get_Wiki_Module;

   --  ------------------------------
   --  Create the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating new wiki space {0}", String '(Wiki.Get_Name));

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

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Space.Permission,
                             Entity     => WS);
      Wiki.Set_Workspace (WS);
      Wiki.Set_Create_Date (Ada.Calendar.Clock);
      Wiki.Save (DB);

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

      Log.Info ("Wiki {0} created for user {1}",
                ADO.Identifier'Image (Wiki.Get_Id), ADO.Identifier'Image (User));
   end Create_Wiki_Space;

   --  ------------------------------
   --  Save the wiki space.
   --  ------------------------------
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Updating wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;

      --  Check that the user has the update permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Space.Permission,
                             Entity     => Wiki);
      Wiki.Save (DB);
      Ctx.Commit;
   end Save_Wiki_Space;

   --  ------------------------------
   --  Load the wiki space.
   --  ------------------------------
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Wiki.Load (DB, Id, Found);
   end Load_Wiki_Space;

   --  ------------------------------
   --  Create the wiki page into the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Page (Model   : in Wiki_Module;
                               Into    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                               Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
   begin
      Log.Info ("Create wiki page {0}", String '(Page.Get_Name));

      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Pages.Permission,
                             Entity     => Into);

      Page.Set_Is_Public (Into.Get_Is_Public);
      Page.Set_Wiki (Into);
      Model.Save_Wiki_Content (Page, Content);
   end Create_Wiki_Page;

   --  ------------------------------
   --  Save the wiki page.
   --  ------------------------------
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out AWA.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      --  Check that the user has the update wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Page.Save (DB);
      Ctx.Commit;
   end Save;

   --  ------------------------------
   --  Load the wiki page and its content.
   --  ------------------------------
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Id      : in ADO.Identifier) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      --  Check that the user has the view page permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_View_Wiki_Page.Permission,
                             Entity     => Id);

      Page.Load (DB, Id, Found);
      Tags.Load_Tags (DB, Id);
      Content := Page.Get_Content;
      if not Content.Is_Null then
         Content.Load (DB, Content.Get_Id, Found);
      end if;
   end Load_Page;

   --  ------------------------------
   --  Load the wiki page and its content from the wiki space Id and the page name.
   --  ------------------------------
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Wiki    : in ADO.Identifier;
                        Name    : in String) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
      Query : ADO.SQL.Query;
   begin
      Query.Bind_Param (1, Wiki);
      Query.Bind_Param (2, Name);
      Query.Set_Filter ("o.wiki_id = ? AND o.name = ?");
      Page.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      --  Check that the user has the view page permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_View_Wiki_Page.Permission,
                             Entity     => Page.Get_Id);

      Tags.Load_Tags (DB, Page.Get_Id);
      Content := Page.Get_Content;
      if not Content.Is_Null then
         Content.Load (DB, Content.Get_Id, Found);
      end if;
   end Load_Page;

   --  ------------------------------
   --  Create a new wiki content for the wiki page.
   --  ------------------------------
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
   begin
      --  Check that the user has the update wiki content permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Model.Save_Wiki_Content (Page, Content);
   end Create_Wiki_Content;

   --  ------------------------------
   --  Save a new wiki content for the wiki page.
   --  ------------------------------
   procedure Save_Wiki_Content (Model   : in Wiki_Module;
                                Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
   begin
      Ctx.Start;
      Page.Set_Last_Version (Page.Get_Last_Version + 1);
      if not Page.Is_Inserted then
         Page.Save (DB);
      end if;
      Content.Set_Page (Page);
      Content.Set_Create_Date (Ada.Calendar.Clock);
      Content.Set_Author (User);
      Content.Set_Page_Version (Page.Get_Last_Version);
      Content.Save (DB);
      Page.Set_Content (Content);
      Page.Save (DB);
      Ctx.Commit;
   end Save_Wiki_Content;

end AWA.Wikis.Modules;

-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 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 AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Modules.Get;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Users.Models;
with AWA.Wikis.Beans;
with AWA.Modules.Beans;

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

with Util.Log.Loggers;
package body AWA.Wikis.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Wikis.Module");

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

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

      --  Setup the resource bundles.
      App.Register ("wikiMsg", "wikis");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Space_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Space_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Admin_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Admin_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Page_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Page_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_List_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_List_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_View_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_View_Bean'Access);

      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Version_List_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Version_List_Bean'Access);

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

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the wikis module.
   --  ------------------------------
   function Get_Wiki_Module return Wiki_Module_Access is
      function Get is new AWA.Modules.Get (Wiki_Module, Wiki_Module_Access, NAME);
   begin
      return Get;
   end Get_Wiki_Module;

   --  ------------------------------
   --  Create the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating new wiki space {0}", String '(Wiki.Get_Name));

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

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Space.Permission,
                             Entity     => WS);
      Wiki.Set_Workspace (WS);
      Wiki.Set_Create_Date (Ada.Calendar.Clock);
      Wiki.Save (DB);

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

      Log.Info ("Wiki {0} created for user {1}",
                ADO.Identifier'Image (Wiki.Get_Id), ADO.Identifier'Image (User));
   end Create_Wiki_Space;

   --  ------------------------------
   --  Save the wiki space.
   --  ------------------------------
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Updating wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;

      --  Check that the user has the update permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Space.Permission,
                             Entity     => Wiki);
      Wiki.Save (DB);
      Ctx.Commit;
   end Save_Wiki_Space;

   --  ------------------------------
   --  Load the wiki space.
   --  ------------------------------
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Wiki.Load (DB, Id, Found);
   end Load_Wiki_Space;

   --  ------------------------------
   --  Create the wiki page into the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Page (Model   : in Wiki_Module;
                               Into    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                               Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
   begin
      Log.Info ("Create wiki page {0}", String '(Page.Get_Name));

      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Pages.Permission,
                             Entity     => Into);

      Page.Set_Is_Public (Into.Get_Is_Public);
      Page.Set_Wiki (Into);
      Model.Save_Wiki_Content (Page, Content);
   end Create_Wiki_Page;

   --  ------------------------------
   --  Save the wiki page.
   --  ------------------------------
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out AWA.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      --  Check that the user has the update wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Page.Save (DB);
      Ctx.Commit;
   end Save;

   --  ------------------------------
   --  Load the wiki page and its content.
   --  ------------------------------
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Id      : in ADO.Identifier) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      --  Check that the user has the view page permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_View_Wiki_Page.Permission,
                             Entity     => Id);

      Page.Load (DB, Id, Found);
      Tags.Load_Tags (DB, Id);
      Content := Page.Get_Content;
      if not Content.Is_Null then
         Content.Load (DB, Content.Get_Id, Found);
      end if;
   end Load_Page;

   --  ------------------------------
   --  Load the wiki page and its content from the wiki space Id and the page name.
   --  ------------------------------
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Wiki    : in ADO.Identifier;
                        Name    : in String) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
      Query : ADO.SQL.Query;
   begin
      Query.Bind_Param (1, Wiki);
      Query.Bind_Param (2, Name);
      Query.Set_Filter ("o.wiki_id = ? AND o.name = ?");
      Page.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      --  Check that the user has the view page permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_View_Wiki_Page.Permission,
                             Entity     => Page.Get_Id);

      Tags.Load_Tags (DB, Page.Get_Id);
      Content := Page.Get_Content;
      if not Content.Is_Null then
         Content.Load (DB, Content.Get_Id, Found);
      end if;
   end Load_Page;

   --  ------------------------------
   --  Create a new wiki content for the wiki page.
   --  ------------------------------
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
   begin
      --  Check that the user has the update wiki content permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Model.Save_Wiki_Content (Page, Content);
   end Create_Wiki_Content;

   --  ------------------------------
   --  Save a new wiki content for the wiki page.
   --  ------------------------------
   procedure Save_Wiki_Content (Model   : in Wiki_Module;
                                Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
      Ctx     : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User    : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      Created : constant Boolean := not Page.Is_Inserted;
   begin
      Ctx.Start;
      Page.Set_Last_Version (Page.Get_Last_Version + 1);
      if Created then
         Page.Save (DB);
      end if;
      Content.Set_Page (Page);
      Content.Set_Create_Date (Ada.Calendar.Clock);
      Content.Set_Author (User);
      Content.Set_Page_Version (Page.Get_Last_Version);
      Content.Save (DB);
      Page.Set_Content (Content);
      Page.Save (DB);

      if Created then
         Wiki_Lifecycle.Notify_Create (Model, Page);
      else
         Wiki_Lifecycle.Notify_Update (Model, Page);
      end if;
      Ctx.Commit;
   end Save_Wiki_Content;

end AWA.Wikis.Modules;

Use the wiki lifecycle notification to notify listeners when a wiki page is created or updated