--                                                                    --
--  package                         Copyright (c)  Dmitry A. Kazakov  --
--     Strings_Edit.Symmetric_Serialization        Luebeck            --
--  Implementation                                 Winter, 2008       --
--                                                                    --
--                                Last revision :  22:45 07 Apr 2016  --
--                                                                    --
--  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.IO_Exceptions;  use Ada.IO_Exceptions;
with Interfaces;         use Interfaces;

with Ada.Numerics.Discrete_Random;
with Generic_Random_Sequence;

package body Strings_Edit.Symmetric_Serialization is

   type Octet is new Interfaces.Unsigned_8;
--
-- Random_Octet -- Pseudo-random generator of blocks
--
   package Random_Octet is
      new Ada.Numerics.Discrete_Random (Octet);
   use Random_Octet;
--
-- Octet_Sequence - A sequence of octets
--
   package Octet_Sequence is new Generic_Random_Sequence (Octet);
   use Octet_Sequence;

   Seed_Init  : constant := 71;
   Carry_Init : constant := 37;
   Bit_Mask   : constant array (0..8) of Unsigned_16 :=
                (  2#0000_0000#, 2#0000_0001#, 2#0000_0011#,
                   2#0000_0111#, 2#0000_1111#, 2#0001_1111#,
                   2#0011_1111#, 2#0111_1111#, 2#1111_1111#
                );
   Encoding   : constant array (Unsigned_16 range 0..63) of Character :=
                (  "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                &  "abcdefghijklmnopqrstuvwxyz"
                &  "0123456789_~"
                );
   Decoding   : constant array (Character) of Octet :=
                (  'A'=> 0, 'B'=> 1, 'C'=> 2, 'D'=> 3, 'E'=> 4,
                   'F'=> 5, 'G'=> 6, 'H'=> 7, 'I'=> 8, 'J'=> 9,
                   'K'=>10, 'L'=>11, 'M'=>12, 'N'=>13, 'O'=>14,
                   'P'=>15, 'Q'=>16, 'R'=>17, 'S'=>18, 'T'=>19,
                   'U'=>20, 'V'=>21, 'W'=>22, 'X'=>23, 'Y'=>24,
                   'Z'=>25, 'a'=>26, 'b'=>27, 'c'=>28, 'd'=>29,
                   'e'=>30, 'f'=>31, 'g'=>32, 'h'=>33, 'i'=>34,
                   'j'=>35, 'k'=>36, 'l'=>37, 'm'=>38, 'n'=>39,
                   'o'=>40, 'p'=>41, 'q'=>42, 'r'=>43, 's'=>44,
                   't'=>45, 'u'=>46, 'v'=>47, 'w'=>48, 'x'=>49,
                   'y'=>50, 'z'=>51, '0'=>52, '1'=>53, '2'=>54,
                   '3'=>55, '4'=>56, '5'=>57, '6'=>58, '7'=>59,
                   '8'=>60, '9'=>61, '_'=>62, '~'=>63,
                   others =>64
                );

   procedure Adjust
             (  Dice    : Generator;
                Key     : String;
                Pointer : in out Integer;
                Seed    : in out Integer
             )  is
   begin
      if Pointer > Key'First then
         Pointer := Pointer - 1;
      else
         Pointer := Key'Last;
      end if;
      Seed := Seed + Character'Pos (Key (Pointer));
      Reset (Dice, Seed);
   end Adjust;

   function Decode (Data : Encoded_String; Key : String)
      return String is
      Sequencer : Sequence;
      Dice      : Generator;
      Result    : String (1..256);
      Value     : Octet       := Carry_Init;
      Accum     : Unsigned_16 := 0;
      Bits      : Natural     := 0;
      Position  : Integer     := 0;
      Key_Index : Integer     := Key'First;
      Seed      : Integer     := Seed_Init;
   begin
      for Pointer in Data'Range loop
         declare
            Code : constant Octet := Decoding (Data (Pointer));
         begin
            if Code > 63 then
               raise Data_Error;
            end if;
            Accum := Shift_Left (Accum, 6) + Unsigned_16 (Code);
         end;
         Bits := Bits + 6;
         if Bits >= 8 then
            Adjust (Dice, Key, Key_Index, Seed);
            Next (Sequencer, Random (Dice) xor Value, Octet (Position));
            Position := Position + 1;
            Bits  := Bits - 8;
            Value := Octet (Shift_Right (Accum, Bits));
            Result (Position) := Character'Val (Value xor Random (Dice));
            Accum := Accum and Bit_Mask (Bits);
            if Length (Sequencer) = 0 then
               if Pointer /= Data'Last then
                  raise Data_Error;
               end if;
               return Result;
            end if;
         end if;
      end loop;
      raise Data_Error;
   end Decode;

   function Encode (Text : String; Key : String)
      return Encoded_String is
      Sequencer : Sequence;
      Dice      : Generator;
      Result    : Encoded_String;
      Data      : array (Octet) of Octet;
      Value     : Octet       := Carry_Init;
      Accum     : Unsigned_16 := 0;
      Bits      : Natural     := 0;
      Pointer   : Integer     := Result'First;
      Key_Index : Integer     := Key'First;
      Seed      : Integer     := Seed_Init;
   begin
      if Text'Length > 256 then
         raise Constraint_Error;
      end if;
      -- Copying text
      for Index in Text'Range loop
         Data (Octet (Index - Text'First)) :=
            Character'Pos (Text (Index));
      end loop;
      if Text'Length < Data'Length then
         -- Padding to block size with some random stuff
         for Index in Text'Length..Data'Last loop
             Data (Index) := Random (Dice);
         end loop;
      end if;
      for Index in Data'Range loop
         Adjust (Dice, Key, Key_Index, Seed);
         Value := Data (Next (Sequencer, Random (Dice) xor Value));
         Value := Value xor Random (Dice);
         Accum := Shift_Left (Accum, 8) + Unsigned_16 (Value);
         Bits  := Bits + 8;
         if Bits >= 6 then
            if Bits >= 12 then
               Bits := Bits - 6;
               Result (Pointer) := Encoding (Shift_Right (Accum, Bits));
               Pointer := Pointer + 1;
               Bits := Bits - 6;
               Result (Pointer) :=
                  Encoding (Shift_Right (Accum, Bits) and 2#11_1111#);
            else
               Bits := Bits - 6;
               Result (Pointer) := Encoding (Shift_Right (Accum, Bits));
            end if;
            Pointer := Pointer + 1;
            Accum   := Accum and Bit_Mask (Bits);
         end if;
      end loop;
      if Bits > 0 then
         Result (Pointer) := Encoding (Shift_Left (Accum, 6 - Bits));
         Pointer := Pointer + 1;
      end if;
      return Result (1..Pointer - 1);
   end Encode;

end Strings_Edit.Symmetric_Serialization;
