--  (C) Copyright 1999 by John Halleck,All rights reserved.
--  Basic Transformation functions of NSA's Secure Hash Algorithm
--  This is part of a project at http://www.cc.utah.edu/~nahaj/

package body SHA.Process_Data is

   Default_Context : Context;  --  Standard context for people that don't need
   --                          --  to hash more than one stream at a time;

   ---------------------------------------------------------------------------
   --  Totally local functions.

   --  Raw transformation of the data.
   procedure Transform (Given : in out Context);
      --  This is the basic work horse of the standard.  Everything else here
      --  is just frame around this.

   --  Align data and place in buffer.  (Arbitrary chunks.)
   procedure Graft_On   (Given           : in out Context;
                         Raw             : Unsigned_32;
                         Size            : Bit_Index;
                         Increment_Count : Boolean := True);

   ---------------------------------------------------------------------------


   --  On with the show -----------------------------------------


   --  Quick and easy routine for the most common simple case.
   function Digest_A_String (Given : String)
            return Digest is
      Temp : Context; -- Let's make this totally independent of anything
      --              -- else the user may be doing.
      Result : Digest;
   begin
      Initialize (Temp);
      for I in Given'First .. Given'Last loop
         Add (Byte (Character'Pos (Given (I))), Temp);
      end loop;
      Finalize (Result, Temp);
      return Result;
   end Digest_A_String;


   --  Start out the buffer with a good starting state.
   --    Note that there are assumptions ALL over the code that the
   --    buffer starts out with zeros.
   procedure Initialize is
   begin
      if Default_Context.Initialized then
         raise SHA_Second_Initialize;
      end if;
      Default_Context := Initial_Value;
      Default_Context.Initialized := True;
   end Initialize;

   procedure Initialize (Given : in out Context) is
   begin
      if Given.Initialized then
         raise SHA_Second_Initialize;
      end if;
      Given := Initial_Value;
      Given.Initialized := True;
   end Initialize;


      --  Procedures to add to the data being hashed.

      procedure Add (Data  : Bit) is
      begin
         if not Default_Context.Initialized then
            raise SHA_Not_Initialized;
         end if;
         Graft_On (Default_Context, Unsigned_32 (Data), 1);
      end Add;

      procedure Add (Data  : Bit; Given : in out Context) is
      begin
         if not Given.Initialized then raise SHA_Not_Initialized; end if;
         Graft_On (Given, Unsigned_32 (Data), 1);
      end Add;


      procedure Add (Data  : Byte) is
      begin
         if not Default_Context.Initialized then
            raise SHA_Not_Initialized;
         end if;
         Graft_On (Default_Context, Unsigned_32 (Data), 8);
      end Add;

      procedure Add (Data  : Byte; Given : in out Context) is
      begin
         if not Given.Initialized then raise SHA_Not_Initialized; end if;
         Graft_On (Given, Unsigned_32 (Data), 8);
      end Add;



      procedure Add (Data  : Word) is
      begin
         if not Default_Context.Initialized then
            raise SHA_Not_Initialized;
         end if;
         Graft_On (Default_Context, Unsigned_32 (Data), 16);
      end Add;

      procedure Add (Data  : Word; Given : in out Context) is
      begin
         if not Given.Initialized then raise SHA_Not_Initialized; end if;
         Graft_On (Given, Unsigned_32 (Data), 16);
      end Add;


      procedure Add (Data  : Long) is
      begin
         if not Default_Context.Initialized then
            raise SHA_Not_Initialized;
         end if;
         Graft_On (Default_Context, Unsigned_32 (Data), 32);
      end Add;

      procedure Add (Data  : Long; Given : in out Context) is
      begin
         if not Given.Initialized then raise SHA_Not_Initialized; end if;
         Graft_On (Given, Unsigned_32 (Data), 32);
      end Add;


      procedure Add (Data  : Long;  Size : Bit_Index) is
      begin
         if not Default_Context.Initialized then
            raise SHA_Not_Initialized;
         end if;
         Graft_On (Default_Context, Unsigned_32 (Data), Size);
      end Add;

      procedure Add (Data  : Long; Size  : Bit_Index;
                     Given : in out Context) is
      begin
         if not Given.Initialized then raise SHA_Not_Initialized; end if;
         Graft_On (Given, Unsigned_32 (Data), Size);
      end Add;


   --  Get the final digest.

   function Finalize return Digest is
      Result : Digest;
   begin
      Finalize (Result, Default_Context);
      return Result;
   end Finalize;

   procedure Finalize (Result : out Digest) is
   begin
      Finalize (Result, Default_Context);
   end Finalize;

   procedure Finalize (Result : out Digest; Given : in out Context) is
   begin
      if not Given.Initialized then raise SHA_Not_Initialized; end if;

      --  The standard requires the Data be padded with a single 1 bit.
      Graft_On (Given, 1, 1, False);

      --  We may have to make room for the count to be put on the last block.
      if Given.Next_Word >= Given.Data'Last - 1 then -- Room for the count?
         if not (Given.Next_Word = Given.Data'Last - 1
                 and Given.Remaining_Bits = 32) then
            Transform (Given);
         end if;
      end if;

      --  Ok, now we can just add the count on.
      Given.Data (Given.Data'Last - 1) := Given.Count_High;
      Given.Data (Given.Data'Last)     := Given.Count_Low;

      --  And now we just transform that.
      Transform (Given);

      --  Ok, we are done.
      Given.Initialized := False;   --  One aught not to reused this without
                                    --  appropriate re-initialization.
      Result := Given.Current;

   end Finalize;

   ---------------------------------------------------------------------------
   --  Actually put the bits we have into the buffer properly aligned.

   procedure Graft_On (Given           : in out Context;
                       Raw             : Unsigned_32;
                       Size            : Bit_Index;
                       Increment_Count : Boolean := True) is

      Offset    : Integer range -31 .. 32; -- How far to move to align this?
      Overflow  : Bit_Index   := 0; -- How much is into the next word?
      Remainder : Unsigned_32 := 0; -- What data has to be done in cleanup?
      Value     : Unsigned_32 := Raw; -- What value are we Really working with?

   begin
      pragma Inline (Graft_On);

      --  Huh?
      if Size = 0 then return; end if;

      --  How do we have to align the data to fit?
      Offset := Integer (Given.Remaining_Bits) --  Amount used
              - Integer (Size);                --  Minus amount we have.

      if Offset > 0 then

         Value := Shift_Left (Value, Offset);

      elsif  Offset < 0 then

         Remainder := Shift_Left  (Value, 32 + Offset);
         --                         -- Really  "- -Offset"
         Value     := Shift_Right (Value, -Offset);
         Overflow  := Bit_Index (-Offset);

      end if;

      --  Insert the actual value into the table.
      Given.Data (Given.Next_Word) := Given.Data (Given.Next_Word) or Value;

      --  Update where we are in the table.
      if Offset > 0 then -- Not on a word boundry
         Given.Remaining_Bits := Given.Remaining_Bits - Size;
      elsif Given.Next_Word < Data_Buffer'Last then
         Given.Next_Word := Given.Next_Word + 1;
         Given.Remaining_Bits  := 32;
      else
         Transform (Given); -- Also clears everything out of the buffer.
      end if;

      --  Handle anything that overflows into the next word.
      if Overflow /= 0 then
         Given.Data (Given.Next_Word) := Given.Data (Given.Next_Word)
                                      or Remainder;
         Given.Remaining_Bits := 32 - Overflow;
      end if;

      if Increment_Count then
         Given.Count_Low := Given.Count_Low + Unsigned_32 (Size);
         if Given.Count_Low < Unsigned_32 (Size) then
            Given.Count_High := Given.Count_High + 1;
            if Given.Count_High = 0 then raise SHA_Overflow; end if;
            --  The standard is only defined up to a total size of what
            --  you are hashing of 2**64 bits.
         end if;
      end if;
   end Graft_On;

   ---------------------------------------------------------------------------
   --  The actual SHA transformation of a block of data.
   --  Yes, it is cryptic...  But it is a pretty much direct transliteration
   --  of the standard, variable names and all.

   procedure Transform (Given : in out Context) is
      Temp : Unsigned_32;

      --  Buffer to work in.
      type Work_Buffer        is array (0 .. 79) of Unsigned_32;
      W :  Work_Buffer;

      --  How much is filled from the data, how much is filled by expansion.
      Fill_Start : constant := Work_Buffer'First + Data_Buffer'Length;
      Data_End   : constant := Fill_Start - 1;

      A : Unsigned_32 := Given.Current (0);
      B : Unsigned_32 := Given.Current (1);
      C : Unsigned_32 := Given.Current (2);
      D : Unsigned_32 := Given.Current (3);
      E : Unsigned_32 := Given.Current (4);

   begin

      for I in Work_Buffer'First .. Data_End loop
         W (I) := Given.Data (Word_Range (I));
      end loop;

      for I in Fill_Start .. Work_Buffer'Last loop
         W (I) := Rotate_Left (
                     W (I - 3) xor W (I - 8) xor W (I - 14) xor W (I - 16),
                     1
                  );
      end loop;

      for I in Work_Buffer'Range loop
         Temp := W (I) + Rotate_Left (A, 5) + E;
         case I is
            when  0 .. 19 => Temp := Temp
                  + 16#5A827999#  +  ((B and C) or ((not B) and D));
            when 20 .. 39 => Temp := Temp
                  + 16#6ED9EBA1#  +  (B xor C xor D);
            when 40 .. 59 => Temp := Temp
                  + 16#8F1BBCDC#  +  ((B and C) or (B and D) or (C and D));
            when 60 .. 79 => Temp := Temp
                  + 16#CA62C1D6#  +  (B xor C xor D);
         end case;
         E := D;
         D := C;
         C := Rotate_Right (B, 2); --  The standard really says rotate left 30.
         B := A;
         A := Temp;
      end loop;

      Given.Current := (Given.Current (0) + A,
                        Given.Current (1) + B,
                        Given.Current (2) + C,
                        Given.Current (3) + D,
                        Given.Current (4) + E
                       );
      Given.Remaining_Bits  := 32;
      Given.Next_Word := 0;
      Given.Data      := (others => 0);  --  *THIS MUST BE DONE*
   end Transform;

end SHA.Process_Data;