-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 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 Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
with ADO.Statements.Create;
package body ADO.Sessions is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Sessions");

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Value.Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return Connection_Status is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return CLOSED;
      else
         return OPEN;
      end if;
   end Get_Status;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return null;
      else
         return Database.Impl.Database.Value.Get_Driver;
      end if;
   end Get_Driver;

   --  ------------------------------
   --  Close the session.
   --  ------------------------------
   procedure Close (Database : in out Session) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Value.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  Insert a new cache in the manager.  The cache is identified by the given name.
   --  ------------------------------
   procedure Add_Cache (Database : in out Session;
                        Name     : in String;
                        Cache    : in ADO.Caches.Cache_Type_Access) is
   begin
      Check_Session (Database);
      Database.Impl.Values.Add_Cache (Name, Cache);
   end Add_Cache;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  Check if the session contains the object identified by the given key.
   --  ------------------------------
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Query : constant Query_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Query, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Query_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Query);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Queries);
         Stmt : Query_Statement := Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement and initialize the SQL statement with the query definition.
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Database.Impl.Queries, False);
      begin
         return Database.Create_Statement (SQL);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               SQL : constant String
                 := ADO.Queries.Context'Class (Query).Get_SQL (Database.Impl.Queries);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      Check_Session (Database, "Loading schema {0}");
      Database.Impl.Database.Value.Load_Schema (Schema);
   end Load_Schema;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Value.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Value.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Value.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

   --  ------------------------------
   --  Flush the objects that were modified.
   --  ------------------------------
   procedure Flush (Database : in out Master_Session) is
   begin
      Check_Session (Database);
   end Flush;

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy, Detach => True);
            if not Object.Impl.Database.Is_Null then
               Object.Impl.Database.Value.Close;
            end if;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Delete_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Update_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Insert_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   --  ------------------------------
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

-----------------------------------------------------------------------
--  ADO Sessions -- Sessions Management
--  Copyright (C) 2009, 2010, 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 Util.Log;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;

with ADO.Drivers;
with ADO.Sequences;
with ADO.Statements.Create;
package body ADO.Sessions is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Sessions");

   procedure Check_Session (Database : in Session'Class;
                            Message  : in String := "") is
   begin
      if Database.Impl = null then
         Log.Error ("Session is closed or not initialized");
         raise NOT_OPEN;
      end if;
      if Message'Length > 0 then
         Log.Info (Message, Database.Impl.Database.Value.Ident);
      end if;
   end Check_Session;

   --  ---------
   --  Session
   --  ---------

   --  ------------------------------
   --  Get the session status.
   --  ------------------------------
   function Get_Status (Database : in Session) return Connection_Status is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return CLOSED;
      else
         return OPEN;
      end if;
   end Get_Status;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   function Get_Driver (Database : in Session) return ADO.Drivers.Connections.Driver_Access is
   begin
      if Database.Impl = null or else Database.Impl.Database.Is_Null then
         return null;
      else
         return Database.Impl.Database.Value.Get_Driver;
      end if;
   end Get_Driver;

   --  ------------------------------
   --  Close the session.
   --  ------------------------------
   procedure Close (Database : in out Session) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Session_Record,
                                    Name   => Session_Record_Access);

      Is_Zero : Boolean;
   begin
      Log.Info ("Closing session");
      if Database.Impl /= null then
         ADO.Objects.Release_Proxy (Database.Impl.Proxy);
         Database.Impl.Database.Value.Close;
         Util.Concurrent.Counters.Decrement (Database.Impl.Counter, Is_Zero);
         if Is_Zero then
            Free (Database.Impl);
         end if;
         Database.Impl := null;
      end if;
   end Close;

   --  ------------------------------
   --  Insert a new cache in the manager.  The cache is identified by the given name.
   --  ------------------------------
   procedure Add_Cache (Database : in out Session;
                        Name     : in String;
                        Cache    : in ADO.Caches.Cache_Type_Access) is
   begin
      Check_Session (Database);
      Database.Impl.Values.Add_Cache (Name, Cache);
   end Add_Cache;

   --  ------------------------------
   --  Attach the object to the session.
   --  ------------------------------
   procedure Attach (Database : in out Session;
                     Object   : in ADO.Objects.Object_Ref'Class) is
      pragma Unreferenced (Object);
   begin
      Check_Session (Database);
   end Attach;

   --  ------------------------------
   --  Check if the session contains the object identified by the given key.
   --  ------------------------------
   function Contains (Database : in Session;
                      Item     : in ADO.Objects.Object_Key) return Boolean is
   begin
      Check_Session (Database);
      return ADO.Objects.Cache.Contains (Database.Impl.Cache, Item);
   end Contains;

   --  ------------------------------
   --  Remove the object from the session cache.
   --  ------------------------------
   procedure Evict (Database : in out Session;
                    Item     : in ADO.Objects.Object_Key) is
   begin
      Check_Session (Database);
      ADO.Objects.Cache.Remove (Database.Impl.Cache, Item);
   end Evict;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Query : constant Query_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Query, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in String)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Query_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Query);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Context'Class)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL  : constant String := Query.Get_SQL (Database.Impl.Queries.all);
         Stmt : Query_Statement := Database.Create_Statement (SQL);
      begin
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement and initialize the SQL statement with the query definition.
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.Queries.Query_Definition_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         SQL   : constant String := ADO.Queries.Get_SQL (Query, Database.Impl.Queries.all, False);
      begin
         return Database.Create_Statement (SQL);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Session;
                              Query    : in ADO.SQL.Query'Class;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : Query_Statement := Database.Create_Statement (Table);
      begin
         if Query in ADO.Queries.Context'Class then
            declare
               SQL : constant String
                 := ADO.Queries.Context'Class (Query).Get_SQL (Database.Impl.Queries.all);
            begin
               ADO.SQL.Append (Stmt.Get_Query.SQL, SQL);
            end;
         end if;
         Stmt.Set_Parameters (Query);
         return Stmt;
      end;
   end Create_Statement;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   procedure Load_Schema (Database : in Session;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      Check_Session (Database, "Loading schema {0}");
      Database.Impl.Database.Value.Load_Schema (Schema);
   end Load_Schema;

   --  ---------
   --  Master Session
   --  ---------

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Begin transaction {0}");
      Database.Impl.Database.Value.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Commit transaction {0}");
      Database.Impl.Database.Value.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Session) is
   begin
      Check_Session (Database, "Rollback transaction {0}");
      Database.Impl.Database.Value.Rollback;
   end Rollback;

   --  ------------------------------
   --  Allocate an identifier for the table.
   --  ------------------------------
   procedure Allocate (Database : in out Master_Session;
                       Id       : in out ADO.Objects.Object_Record'Class) is
   begin
      Check_Session (Database);
      ADO.Sequences.Allocate (Database.Sequences.all, Id);
   end Allocate;

   --  ------------------------------
   --  Flush the objects that were modified.
   --  ------------------------------
   procedure Flush (Database : in out Master_Session) is
   begin
      Check_Session (Database);
   end Flush;

   overriding
   procedure Adjust (Object : in out Session) is
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Increment (Object.Impl.Counter);
      end if;
   end Adjust;

   overriding
   procedure Finalize (Object : in out Session) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Session_Record,
                                         Name   => Session_Record_Access);
      Is_Zero : Boolean;
   begin
      if Object.Impl /= null then
         Util.Concurrent.Counters.Decrement (Object.Impl.Counter, Is_Zero);
         if Is_Zero then
            ADO.Objects.Release_Proxy (Object.Impl.Proxy, Detach => True);
            if not Object.Impl.Database.Is_Null then
               Object.Impl.Database.Value.Close;
            end if;
            Free (Object.Impl);
         end if;
         Object.Impl := null;
      end if;
   end Finalize;

   --  ------------------------------
   --  Create a delete statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Delete_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Update_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement
   --  ------------------------------
   function Create_Statement (Database : in Master_Session;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Check_Session (Database);
      declare
         Stmt : constant Insert_Statement_Access := Database.Impl.Database.Value.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access, Database.Impl.Values.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Internal method to get the session proxy associated with the given database session.
   --  The session proxy is associated with some ADO objects to be able to retrieve the database
   --  session for the implementation of lazy loading.  The session proxy is kept until the
   --  session exist and at least one ADO object is refering to it.
   --  ------------------------------
   function Get_Session_Proxy (Database : in Session) return ADO.Objects.Session_Proxy_Access is
      use type ADO.Objects.Session_Proxy_Access;
   begin
      Check_Session (Database);
      if Database.Impl.Proxy = null then
         Database.Impl.Proxy := ADO.Objects.Create_Session_Proxy (Database.Impl);
      end if;
      return Database.Impl.Proxy;
   end Get_Session_Proxy;

end ADO.Sessions;

Update to take into account the change in Get_SQL operation


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

with Util.Serialize.IO.JSON;
package body ASF.Streams.JSON is

   --  ------------------------------
   --  Initialize the stream
   --  ------------------------------
   procedure Initialize (Stream : in out Print_Stream;
                         To     : in ASF.Streams.Print_Stream'Class) is
   begin
      Stream.Initialize (To.Target);
   end Initialize;

end ASF.Streams.JSON;

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

package body ASF.Streams.JSON is

   --  ------------------------------
   --  Initialize the stream
   --  ------------------------------
   procedure Initialize (Stream : in out Print_Stream;
                         To     : in ASF.Streams.Print_Stream'Class) is
   begin
      Stream.Initialize (To.Target);
   end Initialize;

end ASF.Streams.JSON;

Remove unused with clause Util.Serialize.IO.JSON


-----------------------------------------------------------------------
--  jobs-tests -- Unit tests for AWA jobs
--  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 Util.Tests;
with Util.Test_Caller;
with AWA.Tests;
with AWA.Jobs.Modules;
with AWA.Services.Contexts;

package body AWA.Jobs.Services.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Jobs.Modules.Register",
                       Test_Job_Schedule'Access);
   end Add_Tests;

   procedure Work_1 (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
   begin
      null;
   end Work_1;

   procedure Work_2 (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
   begin
      null;
   end Work_2;

   --  Test the job factory.
   procedure Test_Job_Schedule (T : in out Test) is
      Context : AWA.Services.Contexts.Service_Context;
      J       : AWA.Jobs.Services.Job_Type;
   begin
      Context.Set_Context (AWA.Tests.Get_Application, null);

      J.Set_Parameter ("count", "1");
      J.Set_Parameter ("message", "Hello");
      J.Schedule (Work_1_Definition.Factory);

   end Test_Job_Schedule;

   --  Execute the job.  This operation must be implemented and should perform the work
   --  represented by the job.  It should use the <tt>Get_Parameter</tt> function to retrieve
   --  the job parameter and it can use the <tt>Set_Result</tt> operation to save the result.
   overriding
   procedure Execute (Job : in out Test_Job) is
   begin
      null;
   end Execute;

end AWA.Jobs.Services.Tests;

-----------------------------------------------------------------------
--  jobs-tests -- Unit tests for AWA jobs
--  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 Util.Test_Caller;
with Util.Log.Loggers;

with AWA.Jobs.Modules;
with AWA.Services.Contexts;

package body AWA.Jobs.Services.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Jobs.Services.Tests");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Jobs.Modules.Register",
                       Test_Job_Schedule'Access);
   end Add_Tests;

   procedure Work_1 (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
      Msg : constant String := Job.Get_Parameter ("message");
      Cnt : constant Natural := Job.Get_Parameter ("count", 0);
   begin
      Log.Info ("Execute work_1 {0}, count {1}", Msg, Natural'Image (Cnt));
   end Work_1;

   procedure Work_2 (Job : in out AWA.Jobs.Services.Abstract_Job_Type'Class) is
   begin
      null;
   end Work_2;

   --  ------------------------------
   --  Test the job factory.
   --  ------------------------------
   procedure Test_Job_Schedule (T : in out Test) is
      use type AWA.Jobs.Models.Job_Status_Type;

      Context : AWA.Services.Contexts.Service_Context;
      J       : AWA.Jobs.Services.Job_Type;
   begin
      Context.Set_Context (AWA.Tests.Get_Application, null);

      J.Set_Parameter ("count", 1);
      Util.Tests.Assert_Equals (T, 1, J.Get_Parameter ("count", 0), "Invalid count param");

      J.Set_Parameter ("message", "Hello");
      Util.Tests.Assert_Equals (T, "Hello", J.Get_Parameter ("message"), "Invalid message param");

      J.Schedule (Work_1_Definition.Factory);

      T.Assert (J.Get_Status = AWA.Jobs.Models.SCHEDULED, "Job is not scheduled");
      --
      for I in 1 .. 10 loop
         delay 0.1;
      end loop;
   end Test_Job_Schedule;

   --  Execute the job.  This operation must be implemented and should perform the work
   --  represented by the job.  It should use the <tt>Get_Parameter</tt> function to retrieve
   --  the job parameter and it can use the <tt>Set_Result</tt> operation to save the result.
   overriding
   procedure Execute (Job : in out Test_Job) is
   begin
      null;
   end Execute;

end AWA.Jobs.Services.Tests;

Update the job unit tests to verify some parameters


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

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

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

   --  Initialize and register the callbacks.
   procedure Initialize (Builder : in Gtkada.Builder.Gtkada_Builder);

   --  Callback executed when the "quit" action is executed from the menu.
   procedure On_Menu_Quit (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "about" action is executed from the menu.
   procedure On_Menu_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

   --  Callback executed when the "close-about" action is executed from the about box.
   procedure On_Close_About (Object : access Gtkada.Builder.Gtkada_Builder_Record'Class);

end MAT.Callbacks;

Define the Initialize procedure

Define the Initialize procedure


------------------------------------------------------------------------------
--                                                                          --
--                     Copyright (C) 2015-2016, AdaCore                     --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with STM32.GPIO;
with STM32.Device;
with OpenMV;
with ST7735R;                 use ST7735R;
with ST7735R.RAM_Framebuffer; use ST7735R.RAM_Framebuffer;
with Ravenscar_Time;

package body OpenMV.LCD_Shield is

   LCD_RST : STM32.GPIO.GPIO_Point renames Shield_PWM1;
   LCD_RS  : STM32.GPIO.GPIO_Point renames Shield_PWM2;
   LCD_CS  : STM32.GPIO.GPIO_Point renames Shield_SEL;
   All_Points  : constant STM32.GPIO.GPIO_Points := (LCD_RS, LCD_CS, LCD_RST);

   LCD_Driver : ST7735R_RAM_Framebuffer_Device (Shield_SPI'Access,
                                                LCD_CS'Access,
                                                LCD_RS'Access,
                                                LCD_RST'Access,
                                                Ravenscar_Time.Delays);
   Is_Initialized : Boolean := False;

   -----------------
   -- Initialized --
   -----------------

   function Initialized return Boolean is (Is_Initialized);

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
      GPIO_Conf : STM32.GPIO.GPIO_Port_Configuration;
   begin

      --  Initalize shield SPI port
      Initialize_Shield_SPI;

      STM32.Device.Enable_Clock (All_Points);

      GPIO_Conf.Mode        := STM32.GPIO.Mode_Out;
      GPIO_Conf.Output_Type := STM32.GPIO.Push_Pull;
      GPIO_Conf.Speed       := STM32.GPIO.Speed_100MHz;
      GPIO_Conf.Resistors   := STM32.GPIO.Floating;

      STM32.GPIO.Configure_IO (All_Points, GPIO_Conf);

      Initialize (LCD_Driver);

      Set_Memory_Data_Access
        (LCD                 => LCD_Driver,
         Color_Order         => RGB_Order,
         Vertical            => Vertical_Refresh_Top_Bottom,
         Horizontal          => Horizontal_Refresh_Left_Right,
         Row_Addr_Order      => Row_Address_Bottom_Top,
         Column_Addr_Order   => Column_Address_Right_Left,
         Row_Column_Exchange => False);

      Set_Pixel_Format (LCD_Driver, Pixel_16bits);

      Set_Frame_Rate_Normal (LCD_Driver,
                             RTN         => 16#01#,
                             Front_Porch => 16#2C#,
                             Back_Porch  => 16#2D#);
      Set_Frame_Rate_Idle (LCD_Driver,
                           RTN         => 16#01#,
                           Front_Porch => 16#2C#,
                           Back_Porch  => 16#2D#);
      Set_Frame_Rate_Partial_Full (LCD_Driver,
                                   RTN_Part         => 16#01#,
                                   Front_Porch_Part => 16#2C#,
                                   Back_Porch_Part  => 16#2D#,
                                   RTN_Full         => 16#01#,
                                   Front_Porch_Full => 16#2C#,
                                   Back_Porch_Full  => 16#2D#);
      Set_Inversion_Control (LCD_Driver,
                             Normal       => Line_Inversion,
                             Idle         => Line_Inversion,
                             Full_Partial => Line_Inversion);
      Set_Power_Control_1 (LCD_Driver,
                           AVDD => 2#101#,    --  5
                           VRHP => 2#0_0010#, --  4.6
                           VRHN => 2#0_0010#, --  -4.6
                           MODE => 2#10#);    --  AUTO

      Set_Power_Control_2 (LCD_Driver,
                           VGH25 => 2#11#,  --  2.4
                           VGSEL => 2#01#,  --  3*AVDD
                           VGHBT => 2#01#); --  -10

      Set_Power_Control_3 (LCD_Driver, 16#0A#, 16#00#);
      Set_Power_Control_4 (LCD_Driver, 16#8A#, 16#2A#);
      Set_Power_Control_5 (LCD_Driver, 16#8A#, 16#EE#);
      Set_Vcom (LCD_Driver, 16#E#);

      Set_Address (LCD_Driver,
                   X_Start => 0,
                   X_End   => 127,
                   Y_Start => 0,
                   Y_End   => 159);
      Turn_On (LCD_Driver);

      LCD_Driver.Initialize_Layer (Layer  => 1,
                                   Mode   => HAL.Bitmap.RGB_565,
                                   X      => 0,
                                   Y      => 0,
                                   Width  => Image_Width,
                                   Height => Image_Height);
      Is_Initialized := True;
   end Initialize;

   ----------------
   -- Get_Bitmap --
   ----------------

   function Get_Bitmap return not null HAL.Bitmap.Any_Bitmap_Buffer is
   begin
      return LCD_Driver.Hidden_Buffer (1);
   end Get_Bitmap;

   ----------------------
   -- Rotate_Screen_90 --
   ----------------------

   procedure Rotate_Screen_90 is
   begin
      Set_Memory_Data_Access
        (LCD                 => LCD_Driver,
         Color_Order         => RGB_Order,
         Vertical            => Vertical_Refresh_Top_Bottom,
         Horizontal          => Horizontal_Refresh_Left_Right,
         Row_Addr_Order      => Row_Address_Top_Bottom,
         Column_Addr_Order   => Column_Address_Left_Right,
         Row_Column_Exchange => False);
   end Rotate_Screen_90;

   ---------------------
   -- Rotate_Screen_0 --
   ---------------------

   procedure Rotate_Screen_0 is
   begin
      Set_Memory_Data_Access
        (LCD                 => LCD_Driver,
         Color_Order         => RGB_Order,
         Vertical            => Vertical_Refresh_Top_Bottom,
         Horizontal          => Horizontal_Refresh_Left_Right,
         Row_Addr_Order      => Row_Address_Bottom_Top,
         Column_Addr_Order   => Column_Address_Right_Left,
         Row_Column_Exchange => False);
   end Rotate_Screen_0;

   -------------
   -- Display --
   -------------

   procedure Display is
   begin
      LCD_Driver.Update_Layer (1);
   end Display;

end OpenMV.LCD_Shield;

------------------------------------------------------------------------------
--                                                                          --
--                     Copyright (C) 2015-2016, AdaCore                     --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with STM32.GPIO;
with STM32.Device;
with OpenMV;
with ST7735R;                 use ST7735R;
with ST7735R.RAM_Framebuffer; use ST7735R.RAM_Framebuffer;
with Ravenscar_Time;

package body OpenMV.LCD_Shield is

   LCD_RST : STM32.GPIO.GPIO_Point renames Shield_PWM1;
   LCD_RS  : STM32.GPIO.GPIO_Point renames Shield_PWM2;
   LCD_CS  : STM32.GPIO.GPIO_Point renames Shield_SEL;
   All_Points  : constant STM32.GPIO.GPIO_Points := (LCD_RS, LCD_CS, LCD_RST);

   LCD_Driver : ST7735R_RAM_Framebuffer_Screen (Shield_SPI'Access,
                                                LCD_CS'Access,
                                                LCD_RS'Access,
                                                LCD_RST'Access,
                                                Ravenscar_Time.Delays);
   Is_Initialized : Boolean := False;

   -----------------
   -- Initialized --
   -----------------

   function Initialized return Boolean is (Is_Initialized);

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
      GPIO_Conf : STM32.GPIO.GPIO_Port_Configuration;
   begin

      --  Initalize shield SPI port
      Initialize_Shield_SPI;

      STM32.Device.Enable_Clock (All_Points);

      GPIO_Conf.Mode        := STM32.GPIO.Mode_Out;
      GPIO_Conf.Output_Type := STM32.GPIO.Push_Pull;
      GPIO_Conf.Speed       := STM32.GPIO.Speed_100MHz;
      GPIO_Conf.Resistors   := STM32.GPIO.Floating;

      STM32.GPIO.Configure_IO (All_Points, GPIO_Conf);

      Initialize (LCD_Driver);

      Set_Memory_Data_Access
        (LCD                 => LCD_Driver,
         Color_Order         => RGB_Order,
         Vertical            => Vertical_Refresh_Top_Bottom,
         Horizontal          => Horizontal_Refresh_Left_Right,
         Row_Addr_Order      => Row_Address_Bottom_Top,
         Column_Addr_Order   => Column_Address_Right_Left,
         Row_Column_Exchange => False);

      Set_Pixel_Format (LCD_Driver, Pixel_16bits);

      Set_Frame_Rate_Normal (LCD_Driver,
                             RTN         => 16#01#,
                             Front_Porch => 16#2C#,
                             Back_Porch  => 16#2D#);
      Set_Frame_Rate_Idle (LCD_Driver,
                           RTN         => 16#01#,
                           Front_Porch => 16#2C#,
                           Back_Porch  => 16#2D#);
      Set_Frame_Rate_Partial_Full (LCD_Driver,
                                   RTN_Part         => 16#01#,
                                   Front_Porch_Part => 16#2C#,
                                   Back_Porch_Part  => 16#2D#,
                                   RTN_Full         => 16#01#,
                                   Front_Porch_Full => 16#2C#,
                                   Back_Porch_Full  => 16#2D#);
      Set_Inversion_Control (LCD_Driver,
                             Normal       => Line_Inversion,
                             Idle         => Line_Inversion,
                             Full_Partial => Line_Inversion);
      Set_Power_Control_1 (LCD_Driver,
                           AVDD => 2#101#,    --  5
                           VRHP => 2#0_0010#, --  4.6
                           VRHN => 2#0_0010#, --  -4.6
                           MODE => 2#10#);    --  AUTO

      Set_Power_Control_2 (LCD_Driver,
                           VGH25 => 2#11#,  --  2.4
                           VGSEL => 2#01#,  --  3*AVDD
                           VGHBT => 2#01#); --  -10

      Set_Power_Control_3 (LCD_Driver, 16#0A#, 16#00#);
      Set_Power_Control_4 (LCD_Driver, 16#8A#, 16#2A#);
      Set_Power_Control_5 (LCD_Driver, 16#8A#, 16#EE#);
      Set_Vcom (LCD_Driver, 16#E#);

      Set_Address (LCD_Driver,
                   X_Start => 0,
                   X_End   => 127,
                   Y_Start => 0,
                   Y_End   => 159);
      Turn_On (LCD_Driver);

      LCD_Driver.Initialize_Layer (Layer  => 1,
                                   Mode   => HAL.Bitmap.RGB_565,
                                   X      => 0,
                                   Y      => 0,
                                   Width  => Image_Width,
                                   Height => Image_Height);
      Is_Initialized := True;
   end Initialize;

   ----------------
   -- Get_Bitmap --
   ----------------

   function Get_Bitmap return not null HAL.Bitmap.Any_Bitmap_Buffer is
   begin
      return LCD_Driver.Hidden_Buffer (1);
   end Get_Bitmap;

   ----------------------
   -- Rotate_Screen_90 --
   ----------------------

   procedure Rotate_Screen_90 is
   begin
      Set_Memory_Data_Access
        (LCD                 => LCD_Driver,
         Color_Order         => RGB_Order,
         Vertical            => Vertical_Refresh_Top_Bottom,
         Horizontal          => Horizontal_Refresh_Left_Right,
         Row_Addr_Order      => Row_Address_Top_Bottom,
         Column_Addr_Order   => Column_Address_Left_Right,
         Row_Column_Exchange => False);
   end Rotate_Screen_90;

   ---------------------
   -- Rotate_Screen_0 --
   ---------------------

   procedure Rotate_Screen_0 is
   begin
      Set_Memory_Data_Access
        (LCD                 => LCD_Driver,
         Color_Order         => RGB_Order,
         Vertical            => Vertical_Refresh_Top_Bottom,
         Horizontal          => Horizontal_Refresh_Left_Right,
         Row_Addr_Order      => Row_Address_Bottom_Top,
         Column_Addr_Order   => Column_Address_Right_Left,
         Row_Column_Exchange => False);
   end Rotate_Screen_0;

   -------------
   -- Display --
   -------------

   procedure Display is
   begin
      LCD_Driver.Update_Layer (1);
   end Display;

end OpenMV.LCD_Shield;

Fix screen type name

OpenMV: Fix screen type name


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

--  The <bASF.Components.Holders defines the value holder interfaces
--  which allow to plug a converter and one or several validators.
--  These interfaces must be implemented by UIOutput component and UIInput
--  component to participate in the JSF/ASF lifecycle (validation phase).
with EL.Objects;
with ASF.Converters;
with ASF.Validators;
package ASF.Components.Holders is

   --  ------------------------------
   --  Value Holder
   --  ------------------------------
   type Value_Holder is limited interface;

   --  Get the local value of the component without evaluating
   --  the associated Value_Expression.
   function Get_Local_Value (Holder : in Value_Holder) return EL.Objects.Object is abstract;

   --  Get the value of the component.  If the component has a local
   --  value which is not null, returns it.  Otherwise, if we have a Value_Expression
   --  evaluate and returns the value.
   function Get_Value (Holder : in Value_Holder) return EL.Objects.Object is abstract;

   --  Set the value of the component.
   procedure Set_Value (Holder : in out Value_Holder;
                        Value  : in EL.Objects.Object) is abstract;

   --  Get the converter that is registered on the component.
   function Get_Converter (Holder : in Value_Holder)
                           return ASF.Converters.Converter_Access is abstract;

   --  Set the converter to be used on the component.
   procedure Set_Converter (Holder    : in out Value_Holder;
                            Converter : in ASF.Converters.Converter_Access) is abstract;

   --  ------------------------------
   --  Editable Value Holder
   --  ------------------------------
   --  The Editable_Value_Holder extends the Value_Holder to provide
   --  operations used when a value can be modified.
   type Editable_Value_Holder is limited interface and Value_Holder;

   --  Add the validator to be used on the component.  The ASF implementation limits
   --  to 5 the number of validators that can be set on a component (See UIInput).
   --  The validator instance will be freed when the editable value holder is deleted
   --  unless Shared is true.
   procedure Add_Validator (Holder    : in out Editable_Value_Holder;
                            Validator : in ASF.Validators.Validator_Access;
                            Shared    : in Boolean := False) is abstract;

   --  ------------------------------
   --  List Holder
   --  ------------------------------
   --  The List_Holder is an interface used by the data scroller to get some information
   --  about how a list is displayed.
   type List_Holder is limited interface;
   type List_Holder_Access is access all List_Holder'Class;

   --  Get the number of rows in the list.
   function Get_Row_Count (List : in List_Holder) return Natural is abstract;

   --  Get the number of rows per page.
   function Get_Row_Per_Page (List : in List_Holder) return Positive is abstract;

   --  Get the current page.
   function Get_Current_Page (List : in List_Holder) return Positive is abstract;

   --  Set the current page number.
   procedure Set_Current_Page (List : in out List_Holder;
                               Page : in Positive) is abstract;

end ASF.Components.Holders;

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

--  The <bASF.Components.Holders defines the value holder interfaces
--  which allow to plug a converter and one or several validators.
--  These interfaces must be implemented by UIOutput component and UIInput
--  component to participate in the JSF/ASF lifecycle (validation phase).
with EL.Objects;
with ASF.Converters;
with ASF.Validators;
package ASF.Components.Holders is

   --  ------------------------------
   --  Value Holder
   --  ------------------------------
   type Value_Holder is limited interface;

   --  Get the local value of the component without evaluating
   --  the associated Value_Expression.
   function Get_Local_Value (Holder : in Value_Holder) return EL.Objects.Object is abstract;

   --  Get the value of the component.  If the component has a local
   --  value which is not null, returns it.  Otherwise, if we have a Value_Expression
   --  evaluate and returns the value.
   function Get_Value (Holder : in Value_Holder) return EL.Objects.Object is abstract;

   --  Set the value of the component.
   procedure Set_Value (Holder : in out Value_Holder;
                        Value  : in EL.Objects.Object) is abstract;

   --  Get the converter that is registered on the component.
   function Get_Converter (Holder : in Value_Holder)
                           return ASF.Converters.Converter_Access is abstract;

   --  Set the converter to be used on the component.
   procedure Set_Converter (Holder    : in out Value_Holder;
                            Converter : in ASF.Converters.Converter_Access;
                            Release   : in Boolean := False) is abstract;

   --  ------------------------------
   --  Editable Value Holder
   --  ------------------------------
   --  The Editable_Value_Holder extends the Value_Holder to provide
   --  operations used when a value can be modified.
   type Editable_Value_Holder is limited interface and Value_Holder;

   --  Add the validator to be used on the component.  The ASF implementation limits
   --  to 5 the number of validators that can be set on a component (See UIInput).
   --  The validator instance will be freed when the editable value holder is deleted
   --  unless Shared is true.
   procedure Add_Validator (Holder    : in out Editable_Value_Holder;
                            Validator : in ASF.Validators.Validator_Access;
                            Shared    : in Boolean := False) is abstract;

   --  ------------------------------
   --  List Holder
   --  ------------------------------
   --  The List_Holder is an interface used by the data scroller to get some information
   --  about how a list is displayed.
   type List_Holder is limited interface;
   type List_Holder_Access is access all List_Holder'Class;

   --  Get the number of rows in the list.
   function Get_Row_Count (List : in List_Holder) return Natural is abstract;

   --  Get the number of rows per page.
   function Get_Row_Per_Page (List : in List_Holder) return Positive is abstract;

   --  Get the current page.
   function Get_Current_Page (List : in List_Holder) return Positive is abstract;

   --  Set the current page number.
   procedure Set_Current_Page (List : in out List_Holder;
                               Page : in Positive) is abstract;

end ASF.Components.Holders;

Add a Release parameter to the Set_Converter procedure


-----------------------------------------------------------------------
--  EL.Expressions -- Expression Language
--  Copyright (C) 2009, 2010, 2011, 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.
-----------------------------------------------------------------------

--
--  First, create the expression object:
--
--    E : constant Expression := EL.Expressions.Create_Expression ("obj.count + 3");
--
--  The expression must be evaluated against an expression context.
--  The expression context will resolve variables whose values can change depending
--  on the evaluation context.  In the example, ''obj'' is the variable name
--  and ''count'' is the property associated with that variable.
--
--    Value : constant Object := E.Get_Value (Context);
--
--  The ''Value'' holds the result which can be a boolean, an integer, a date,
--  a float number or a string.  The value can be converted as follows:
--
--    N : Integer := To_Integer (Value);
--

with EL.Objects;
with Ada.Finalization;
with Ada.Strings.Unbounded;

limited private with EL.Expressions.Nodes;
with EL.Contexts;
with Util.Beans.Methods;
with Util.Beans.Basic;
package EL.Expressions is

   pragma Preelaborate;

   use EL.Objects;
   use EL.Contexts;

   --  Exception raised when parsing an invalid expression.
   Invalid_Expression : exception;

   --  Exception raised when a variable cannot be resolved.
   Invalid_Variable : exception;

   --  Exception raised when a method cannot be found.
   Invalid_Method : exception;

   --  A parameter is missing in a function call.
   Missing_Argument : exception;

   --  ------------------------------
   --  Expression
   --  ------------------------------
   type Expression is new Ada.Finalization.Controlled with private;
   type Expression_Access is access all Expression'Class;

   --  Check whether the expression is a holds a constant value.
   function Is_Constant (Expr : Expression'Class) return Boolean;

   --  Returns True if the expression is empty (no constant value and no expression).
   function Is_Null (Expr : in Expression'Class) return Boolean;

   --  Get the value of the expression using the given expression context.
   --  Returns an object that holds a typed result.
   function Get_Value (Expr    : Expression;
                       Context : ELContext'Class) return Object;

   --  Get the expression string that was parsed.
   function Get_Expression (Expr : in Expression) return String;

   --  Parse an expression and return its representation ready for evaluation.
   --  The context is used to resolve the functions.  Variables will be
   --  resolved during evaluation of the expression.
   --  Raises Invalid_Expression if the expression is invalid.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Expression;

   --  Reduce the expression by eliminating known variables and computing
   --  constant expressions.  The result expression is either another
   --  expression or a computed constant value.
   function Reduce_Expression (Expr    : Expression;
                               Context : ELContext'Class)
                               return Expression;

   --  Create an EL expression from an object.
   function Create_Expression (Bean : in EL.Objects.Object)
                               return Expression;

   --  ------------------------------
   --  ValueExpression
   --  ------------------------------   --
   type Value_Expression is new Expression with private;
   type Value_Expression_Access is access all Value_Expression'Class;

   --  Set the value of the expression to the given object value.
   procedure Set_Value (Expr    : in Value_Expression;
                        Context : in ELContext'Class;
                        Value   : in Object);

   --  Returns true if the expression is read-only.
   function Is_Readonly (Expr    : in Value_Expression;
                         Context : in ELContext'Class) return Boolean;

   overriding
   function Reduce_Expression (Expr    : Value_Expression;
                               Context : ELContext'Class)
                               return Value_Expression;

   --  Parse an expression and return its representation ready for evaluation.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Value_Expression;

   function Create_ValueExpression (Bean : EL.Objects.Object)
                                    return Value_Expression;

   --  Create a Value_Expression from an expression.
   --  Raises Invalid_Expression if the expression in not an lvalue.
   function Create_Expression (Expr    : Expression'Class)
                               return Value_Expression;

   --  ------------------------------
   --  Method Expression
   --  ------------------------------
   --  A Method_Expression is an expression that refers to a method.
   --  Information about the object and method is retrieved by using
   --  the Get_Method_Info operation.
   type Method_Expression is new EL.Expressions.Expression with private;

   type Method_Info is record
      Object  : access Util.Beans.Basic.Readonly_Bean'Class;
      Binding : Util.Beans.Methods.Method_Binding_Access;
   end record;

   --  Evaluate the method expression and return the object and method
   --  binding to execute the method.  The result contains a pointer
   --  to the bean object and a method binding.  The method binding
   --  contains the information to invoke the method
   --  (such as an access to the function or procedure).
   --  Raises the Invalid_Method exception if the method
   --  cannot be resolved.
   function Get_Method_Info (Expr    : Method_Expression;
                             Context : ELContext'Class)
                         return Method_Info;

   --  Parse an expression and return its representation ready for evaluation.
   --  The context is used to resolve the functions.  Variables will be
   --  resolved during evaluation of the expression.
   --  Raises Invalid_Expression if the expression is invalid.
   overriding
   function Create_Expression (Expr    : String;
                               Context : EL.Contexts.ELContext'Class)
                               return Method_Expression;

   --  Reduce the expression by eliminating known variables and computing
   --  constant expressions.  The result expression is either another
   --  expression or a computed constant value.
   overriding
   function Reduce_Expression (Expr    : Method_Expression;
                               Context : EL.Contexts.ELContext'Class)
                               return Method_Expression;

   --  Create a Method_Expression from an expression.
   --  Raises Invalid_Expression if the expression in not an lvalue.
   function Create_Expression (Expr    : Expression'Class)
                               return Method_Expression;

private

   overriding
   procedure Adjust   (Object : in out Expression);

   overriding
   procedure Finalize (Object : in out Expression);

   type Expression is new Ada.Finalization.Controlled with record
      Node  : access EL.Expressions.Nodes.ELNode'Class := null;
      Value : EL.Objects.Object := EL.Objects.Null_Object;
      Expr  : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Value_Expression is new Expression with null record;

   type Method_Expression is new EL.Expressions.Expression with null record;

end EL.Expressions;

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

--
--  First, create the expression object:
--
--    E : constant Expression := EL.Expressions.Create_Expression ("obj.count + 3");
--
--  The expression must be evaluated against an expression context.
--  The expression context will resolve variables whose values can change depending
--  on the evaluation context.  In the example, ''obj'' is the variable name
--  and ''count'' is the property associated with that variable.
--
--    Value : constant Object := E.Get_Value (Context);
--
--  The ''Value'' holds the result which can be a boolean, an integer, a date,
--  a float number or a string.  The value can be converted as follows:
--
--    N : Integer := To_Integer (Value);
--

with EL.Objects;
with Ada.Finalization;
with Ada.Strings.Unbounded;

limited private with EL.Expressions.Nodes;
with EL.Contexts;
with Util.Beans.Methods;
package EL.Expressions is

   pragma Preelaborate;

   use EL.Objects;
   use EL.Contexts;

   --  Exception raised when parsing an invalid expression.
   Invalid_Expression : exception;

   --  Exception raised when a variable cannot be resolved.
   Invalid_Variable : exception;

   --  Exception raised when a method cannot be found.
   Invalid_Method : exception;

   --  A parameter is missing in a function call.
   Missing_Argument : exception;

   --  ------------------------------
   --  Expression
   --  ------------------------------
   type Expression is new Ada.Finalization.Controlled with private;
   type Expression_Access is access all Expression'Class;

   --  Check whether the expression is a holds a constant value.
   function Is_Constant (Expr : Expression'Class) return Boolean;

   --  Returns True if the expression is empty (no constant value and no expression).
   function Is_Null (Expr : in Expression'Class) return Boolean;

   --  Get the value of the expression using the given expression context.
   --  Returns an object that holds a typed result.
   function Get_Value (Expr    : Expression;
                       Context : ELContext'Class) return Object;

   --  Get the expression string that was parsed.
   function Get_Expression (Expr : in Expression) return String;

   --  Parse an expression and return its representation ready for evaluation.
   --  The context is used to resolve the functions.  Variables will be
   --  resolved during evaluation of the expression.
   --  Raises Invalid_Expression if the expression is invalid.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Expression;

   --  Reduce the expression by eliminating known variables and computing
   --  constant expressions.  The result expression is either another
   --  expression or a computed constant value.
   function Reduce_Expression (Expr    : Expression;
                               Context : ELContext'Class)
                               return Expression;

   --  Create an EL expression from an object.
   function Create_Expression (Bean : in EL.Objects.Object)
                               return Expression;

   --  ------------------------------
   --  ValueExpression
   --  ------------------------------   --
   type Value_Expression is new Expression with private;
   type Value_Expression_Access is access all Value_Expression'Class;

   --  Set the value of the expression to the given object value.
   procedure Set_Value (Expr    : in Value_Expression;
                        Context : in ELContext'Class;
                        Value   : in Object);

   --  Returns true if the expression is read-only.
   function Is_Readonly (Expr    : in Value_Expression;
                         Context : in ELContext'Class) return Boolean;

   overriding
   function Reduce_Expression (Expr    : Value_Expression;
                               Context : ELContext'Class)
                               return Value_Expression;

   --  Parse an expression and return its representation ready for evaluation.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Value_Expression;

   function Create_ValueExpression (Bean : EL.Objects.Object)
                                    return Value_Expression;

   --  Create a Value_Expression from an expression.
   --  Raises Invalid_Expression if the expression in not an lvalue.
   function Create_Expression (Expr    : Expression'Class)
                               return Value_Expression;

   --  ------------------------------
   --  Method Expression
   --  ------------------------------
   --  A Method_Expression is an expression that refers to a method.
   --  Information about the object and method is retrieved by using
   --  the Get_Method_Info operation.
   type Method_Expression is new EL.Expressions.Expression with private;

   type Method_Info is record
      Object  : EL.Objects.Object;
      Binding : Util.Beans.Methods.Method_Binding_Access;
   end record;

   --  Evaluate the method expression and return the object and method
   --  binding to execute the method.  The result contains a pointer
   --  to the bean object and a method binding.  The method binding
   --  contains the information to invoke the method
   --  (such as an access to the function or procedure).
   --  Raises the Invalid_Method exception if the method
   --  cannot be resolved.
   function Get_Method_Info (Expr    : Method_Expression;
                             Context : ELContext'Class)
                         return Method_Info;

   --  Parse an expression and return its representation ready for evaluation.
   --  The context is used to resolve the functions.  Variables will be
   --  resolved during evaluation of the expression.
   --  Raises Invalid_Expression if the expression is invalid.
   overriding
   function Create_Expression (Expr    : String;
                               Context : EL.Contexts.ELContext'Class)
                               return Method_Expression;

   --  Reduce the expression by eliminating known variables and computing
   --  constant expressions.  The result expression is either another
   --  expression or a computed constant value.
   overriding
   function Reduce_Expression (Expr    : Method_Expression;
                               Context : EL.Contexts.ELContext'Class)
                               return Method_Expression;

   --  Create a Method_Expression from an expression.
   --  Raises Invalid_Expression if the expression in not an lvalue.
   function Create_Expression (Expr    : Expression'Class)
                               return Method_Expression;

private

   overriding
   procedure Adjust   (Object : in out Expression);

   overriding
   procedure Finalize (Object : in out Expression);

   type Expression is new Ada.Finalization.Controlled with record
      Node  : access EL.Expressions.Nodes.ELNode'Class := null;
      Value : EL.Objects.Object := EL.Objects.Null_Object;
      Expr  : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Value_Expression is new Expression with null record;

   type Method_Expression is new EL.Expressions.Expression with null record;

end EL.Expressions;

Change Method_Info to use an Object to hold the object pointer instead of the access to the Bean instance because GNAT 2020 will generate a Program_Error exception when the object access was assigned


-----------------------------------------------------------------------
--  security-oauth -- OAuth Security
--  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 Ada.Strings.Unbounded;
with Security.Permissions;

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

   --  ------------------------------
   --  Access Token
   --  ------------------------------
   --  Access tokens are credentials used to access protected resources.
   --  The access token is represented as a Principal.  This is an opaque
   --  value for an application.
   type Access_Token (Len : Natural) is new Security.Permissions.Principal with private;
   type Access_Token_Access is access all Access_Token'Class;

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

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

   --  ------------------------------
   --  Application
   --  ------------------------------
   --  The Application holds the necessary information to let a user
   --  grant access to its protected resources on the resource server.  It contains
   --  information that allows the OAuth authorization server to identify the
   --  application (client id and secret key).
   type Application is tagged private;

   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String);

   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String);

   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String);

   --  Set the OAuth authorization server URI that the application must use
   --  to exchange the OAuth code into an access token.
   procedure Set_Provider_URI (App : in out Application;
                               URI : in String);

   --  OAuth 2.0 Section 4.1.1  Authorization Request

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

   --  Get the authenticate parameters to build the URI to redirect the user to
   --  the OAuth authorization form.
   function Get_Auth_Params (App : in Application;
                             State : in String;
                             Scope : in String := "") return String;

   --  OAuth 2.0 Section 4.1.2  Authorization Response

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

   --  OAuth 2.0 Section 4.1.3.  Access Token Request
   --            Section 4.1.4.  Access Token Response

   --  Exchange the OAuth code into an access token.
   function Request_Access_Token (App  : in Application;
                                  Code : in String) return Access_Token_Access;

   --  Create the access token
   function Create_Access_Token (App     : in Application;
                                 Token   : in String;
                                 Expires : in Natural) return Access_Token_Access;

private

   type Access_Token (Len : Natural) is new Security.Permissions.Principal with record
      Access_Id : String (1 .. Len);
   end record;

   type Application is tagged record
      Client_Id   : Ada.Strings.Unbounded.Unbounded_String;
      Secret      : Ada.Strings.Unbounded.Unbounded_String;
      Callback    : Ada.Strings.Unbounded.Unbounded_String;
      Request_URI : Ada.Strings.Unbounded.Unbounded_String;
      Protect     : Ada.Strings.Unbounded.Unbounded_String;
      Key         : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Security.OAuth.Clients;

-----------------------------------------------------------------------
--  security-oauth -- OAuth Security
--  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 Ada.Strings.Unbounded;
with Security.Permissions;

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

   --  ------------------------------
   --  Access Token
   --  ------------------------------
   --  Access tokens are credentials used to access protected resources.
   --  The access token is represented as a Principal.  This is an opaque
   --  value for an application.
   type Access_Token (Len : Natural) is new Security.Principal with private;
   type Access_Token_Access is access all Access_Token'Class;

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

   --  ------------------------------
   --  Application
   --  ------------------------------
   --  The Application holds the necessary information to let a user
   --  grant access to its protected resources on the resource server.  It contains
   --  information that allows the OAuth authorization server to identify the
   --  application (client id and secret key).
   type Application is tagged private;

   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String);

   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String);

   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String);

   --  Set the OAuth authorization server URI that the application must use
   --  to exchange the OAuth code into an access token.
   procedure Set_Provider_URI (App : in out Application;
                               URI : in String);

   --  OAuth 2.0 Section 4.1.1  Authorization Request

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

   --  Get the authenticate parameters to build the URI to redirect the user to
   --  the OAuth authorization form.
   function Get_Auth_Params (App : in Application;
                             State : in String;
                             Scope : in String := "") return String;

   --  OAuth 2.0 Section 4.1.2  Authorization Response

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

   --  OAuth 2.0 Section 4.1.3.  Access Token Request
   --            Section 4.1.4.  Access Token Response

   --  Exchange the OAuth code into an access token.
   function Request_Access_Token (App  : in Application;
                                  Code : in String) return Access_Token_Access;

   --  Create the access token
   function Create_Access_Token (App     : in Application;
                                 Token   : in String;
                                 Expires : in Natural) return Access_Token_Access;

private

   type Access_Token (Len : Natural) is new Security.Principal with record
      Access_Id : String (1 .. Len);
   end record;

   type Application is tagged record
      Client_Id   : Ada.Strings.Unbounded.Unbounded_String;
      Secret      : Ada.Strings.Unbounded.Unbounded_String;
      Callback    : Ada.Strings.Unbounded.Unbounded_String;
      Request_URI : Ada.Strings.Unbounded.Unbounded_String;
      Protect     : Ada.Strings.Unbounded.Unbounded_String;
      Key         : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Security.OAuth.Clients;

Remove the Has_Role operation

Remove the Has_Role operation


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 onox <denkpadje@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;

private package Orka.Strings is
   pragma Preelaborate;

   function Trim (Value : String) return String;
   --  Return value with whitespace removed from both the start and end

   function Strip_Line_Term (Value : String) return String;
   --  Return the value without any LF and CR characters at the end

   function Lines (Value : String) return Positive;
   --  Return the number of lines that the string contains

   package SU renames Ada.Strings.Unbounded;

   function "+" (Value : String) return SU.Unbounded_String renames SU.To_Unbounded_String;
   function "+" (Value : SU.Unbounded_String) return String renames SU.To_String;

   type String_List is array (Positive range <>) of SU.Unbounded_String;

   function Split
     (Value     : String;
      Separator : String  := " ";
      Maximum   : Natural := 0) return String_List;

   function Join (List : String_List; Separator : String) return String;

end Orka.Strings;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2017 onox <denkpadje@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;

package Orka.Strings is
   pragma Preelaborate;

   function Trim (Value : String) return String;
   --  Return value with whitespace removed from both the start and end

   function Strip_Line_Term (Value : String) return String;
   --  Return the value without any LF and CR characters at the end

   function Lines (Value : String) return Positive;
   --  Return the number of lines that the string contains

   package SU renames Ada.Strings.Unbounded;

   function "+" (Value : String) return SU.Unbounded_String renames SU.To_Unbounded_String;
   function "+" (Value : SU.Unbounded_String) return String renames SU.To_String;

   type String_List is array (Positive range <>) of SU.Unbounded_String;

   function Split
     (Value     : String;
      Separator : String  := " ";
      Maximum   : Natural := 0) return String_List;

   function Join (List : String_List; Separator : String) return String;

end Orka.Strings;

Make package Orka.Strings public

orka: Make package Orka.Strings public

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>