--                                                                    --
--  package                         Copyright (c)  Dmitry A. Kazakov  --
--     GNAT.Sockets.Connection_State_Machine.      Luebeck            --
--     ASN1.X509_Certificates                      Summer, 2019       --
--  Implementation                                                    --
--                                Last revision :  13:37 03 Aug 2019  --
--                                                                    --
--  This  library  is  free software; you can redistribute it and/or  --
--  modify it under the terms of the GNU General Public  License  as  --
--  published by the Free Software Foundation; either version  2  of  --
--  the License, or (at your option) any later version. This library  --
--  is distributed in the hope that it will be useful,  but  WITHOUT  --
--  ANY   WARRANTY;   without   even   the   implied   warranty   of  --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU  --
--  General  Public  License  for  more  details.  You  should  have  --
--  received  a  copy  of  the GNU General Public License along with  --
--  this library; if not, write to  the  Free  Software  Foundation,  --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.    --
--                                                                    --
--  As a special exception, if other files instantiate generics from  --
--  this unit, or you link this unit with other files to produce  an  --
--  executable, this unit does not by  itself  cause  the  resulting  --
--  executable to be covered by the GNU General Public License. This  --
--  exception  does not however invalidate any other reasons why the  --
--  executable file might be covered by the GNU Public License.       --
--____________________________________________________________________--

with Ada.Exceptions;     use Ada.Exceptions;
with Ada.IO_Exceptions;  use Ada.IO_Exceptions;
with Ada.Tags;           use Ada.Tags;

with GNAT.Sockets.Connection_State_Machine.ASN1.Tagged_Values;
use  GNAT.Sockets.Connection_State_Machine.ASN1.Tagged_Values;

package body GNAT.Sockets.Connection_State_Machine.ASN1.
             X509_Certificates is
   use ASN1.Choices;
   use ASN1.Dates;
   use ASN1.Sequences;
   use ASN1.Strings;

   function "<"
            (  Left, Right : Attribute_Type_And_Value
            )  return Boolean is
   begin
      return
      (  Left.OID < Right.OID
      or else
         (  Left.OID < Right.OID
         and then
            Left.Value < Right.Value
      )  );
   end "<";

   procedure Feed
             (  Item    : in out Extension_Type;
                Data    : Stream_Element_Array;
                Pointer : in out Stream_Element_Offset;
                Client  : in out State_Machine'Class;
                State   : in out Stream_Element_Offset
             )  is
   begin
      if State = 0 then
         ASN1.Booleans.Set_Value (Item.Critical, False); -- The default
      end if;
      Feed
      (  Item    => Tagged_Sequence_Data_Item (Item),
         Data    => Data,
         Pointer => Pointer,
         Client  => Client,
         State   => State
      );
   end Feed;

   function Get
            (  Data : Attribute_Type_And_Value_Data_Item
            )  return Attribute_Type_And_Value is
      OID   : constant Object_Identifier := Get_Value (Data.OID);
      Value : constant String            := Get_Value (Data.Value);
   begin
      return (OID'Length, Value'Length, OID, Value);
   end Get;

   function Get
            (  Data : Attribute_Type_And_Value_Data_Item_Set
            )  return Attribute_Type_And_Value_Sets.Set is
      use Attribute_Type_And_Value_Sets;
      Result : Attribute_Type_And_Value_Sets.Set;
   begin
      for Index in 1..Get_Length (Data) loop
         Add (Result, Get (Data, Index));
      end loop;
      return Result;
   end Get;

   function Get (Data : Extension_Type) return String is
   begin
      return Get_Value (Data.Value);
   end Get;

   procedure Initialized (Algorithm : in out Algorithm_Identifier) is
   begin
      Set_Tag (Algorithm, 1, (Universal_Tag, 0, False));
      Set_Tag
      (  Item      => Algorithm,
         Index     => 2,
         Tag       => (Universal_Tag, Null_Tag, True),
         Universal => True
      );
   end Initialized;

   procedure Initialized (Data : in out Extension_Type) is
   begin
      Set_Tag (Data, 1, (Universal_Tag, 0, False));
      Set_Tag (Data, 2, (Universal_Tag, 0, True));
      Set_Tag (Data, 3, (Universal_Tag, 0, False));
   end Initialized;

   procedure Initialized (Certificate : in out TBS_Certificate) is
   begin
      Set_Tag (Certificate,  1, (Context_Specific_Tag, 0, False));
      Set_Tag (Certificate,  2, (Universal_Tag,        0, False));
      Set_Tag (Certificate,  3, (Universal_Tag,        0, False));
      Set_Tag (Certificate,  4, (Universal_Tag,        0, False));
      Set_Tag (Certificate,  5, (Universal_Tag,        0, False));
      Set_Tag (Certificate,  6, (Universal_Tag,        0, False));
      Set_Tag (Certificate,  7, (Universal_Tag,        0, False));
      Set_Tag (Certificate,  8, (Context_Specific_Tag, 1, True));
      Set_Tag (Certificate,  9, (Context_Specific_Tag, 2, True));
      Set_Tag (Certificate, 10, (Context_Specific_Tag, 3, True));
   end Initialized;

   procedure Initialized (Key_Info : in out Subject_Public_Key_Info) is
   begin
      Set_Tag (Key_Info, 1, (Universal_Tag, 0, False));
      Set_Tag (Key_Info, 2, (Universal_Tag, 0, False));
   end Initialized;

   procedure Initialized (Stamp : in out Time_Type) is
   begin
      Set_Tag
      (  Stamp,
         1,
         (Universal_Tag, UTC_Time_Tag, True)
      );
      Set_Tag
      (  Stamp,
         2,
         (Universal_Tag, Generalized_Time_Tag, True)
      );
   end Initialized;

   procedure Initialized (Certificate : in out X509_Certificate) is
   begin
      Set_Tag (Certificate, 1, (Universal_Tag, 0, False));
      Set_Tag (Certificate, 2, (Universal_Tag, 0, False));
      Set_Tag (Certificate, 3, (Universal_Tag, 0, False));
   end Initialized;

   procedure Set
             (  Data  : in out Attribute_Type_And_Value_Data_Item;
                Value : Attribute_Type_And_Value
             )  is
   begin
      Set_Value (Data.OID,   Value.OID);
      Set_Value (Data.Value, Value.Value);
   end Set;

   procedure Set
             (  Data  : in out Attribute_Type_And_Value_Data_Item_Set;
                Value : Attribute_Type_And_Value_Sets.Set
             )  is
      use Attribute_Type_And_Value_Sets;
   begin
      for Index in 1..Get_Size (Value) loop
         Append (Data, Get (Value, Index));
      end loop;
   end Set;

   procedure Set (Data : in out Extension_Type; Value : String) is
   begin
      Set_Value (Data.Value, Value);
   end Set;

end GNAT.Sockets.Connection_State_Machine.ASN1.X509_Certificates;
