-- SHA1 - Provide an idealized interface to the US Secure Hash Algorithm 1 function.
-- Copyright (C) 2019 Prince Trippy programmer@verisimilitudes.net .

-- This program is free software: you can redistribute it and/or modify it under the terms of the
-- GNU Affero General Public License version 3 as published by the Free Software Foundation.

-- This program 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 Affero General Public License for more details.

-- You should have received a copy of the GNU Affero General Public License along with this program.
-- If not, see <http://www.gnu.org/licenses/>.

with Interfaces; -- I can always trivially define this rotation function myself were I ever needing.

package body SHA1 is
   function Rotate (Value : Word; Amount : Natural) return Word is
   begin
      return Word(Interfaces.Rotate_Left(Interfaces.Unsigned_32(Value), Amount));
   end Rotate;

   function K (T : Cycle) return Word is
   begin -- Perhaps I'll just make this an array; would it be as size efficient though, I do wonder.
      case T is
         when  0 .. 19 => return 16#5A827999#;
         when 20 .. 39 => return 16#6ED9EBA1#;
         when 40 .. 59 => return 16#8F1BBCDC#;
         when 60 .. 79 => return 16#CA62C1D6#;
      end case;
   end K;

   function F (T : Cycle; B, C, D : Word) return Word is
   begin
      case T is
         when  0 .. 19            => return (B and C) or (D and not B);
         when 40 .. 59            => return (B and C) or (B and D) or (C and D);
         when 20 .. 39 | 60 .. 79 => return B xor C xor D;
      end case;
   end F;

   procedure Pad (Primary    : in out Word_Block;
                  Auxiliary  :    out Word_Block;
                  Bit_Length : in     Natural;
                  Overflow   :    out Boolean) is
      procedure Place (Data : in out Word_Block) is
      begin -- I'm paying care here to ensure bit lengths greater than that 2**64 limit are ignored.
	 Data(15) := Word((Bit_Length / 2**16) / 2**16) and 2**32-1;
	 Data(16) := Word(Bit_Length) and 2**32-1;
      end Place;
      procedure Term (Data : in out Word_Block) is
         L : Positive := ((Bit_Length / 2**5) mod 16) + 1;
         M : Natural  := Bit_Length mod 2**5;
      begin -- This unnecessarily writes zeroes to the final two words of Primary in some instances.
         Data(L) := (Data(L) and ((2**(32-M)-1) xor (2**32-1))) or 2**(31-M);
	 Data(Positive'Succ(L) .. Data'Last) := (others => 0);
      end Term;
   begin -- I'd figure this implementation should be improved, but I can do so later, unlike design.
      if Bit_Length = 0 then -- This is a rather unfortunate edge case I noticed under a new review.
         Overflow  := False; Term(Primary); Place(Primary); return; -- Perhaps I could parameterize.
      end if; -- There must be sixty-five bits available for that ending bit and the message length.
      case Bit_Length mod 512 is -- Why use others when I can quite easily cover all possible cases?
         when 0          => Auxiliary := (1 => 2**31, 2 .. 14 => 0, 15 .. 16 => <>);
         when 448 .. 511 => Auxiliary := (1 .. 14 => 0, 15 .. 16 => <>); Term(Primary);
         when   1 .. 447 => Overflow  := False; Term(Primary); Place(Primary); return; -- Usual one.
	 when     others => null; -- This should be entirely unnecessary, so why must I list it now?
      end case;
      Overflow := True;
      Place(Auxiliary);
   end Pad;

   procedure Hash (State : in out Status; Data : in Word_Block) is
      A, B, C, D, E, Temporary : Word;
      W : array (Cycle) of Word;
      -- W : array (Cycle) of Word := (0 .. 15 => Data(1 .. 16), others => <>);
   begin
      for I in Cycle range Cycle'First .. 15 loop
	 W(I) := Data(Positive(I+1));
      end loop;
      for I in Cycle range 16 .. Cycle'Last loop
         W(I) := Rotate(Amount => 1, Value => (W(I-3) xor W(I-8) xor W(I-14) xor W(I-16)));
      end loop;
      A := State.H0;
      B := State.H1;
      C := State.H2;
      D := State.H3;
      E := State.H4;
      for I in Cycle'Range loop
         Temporary := Rotate(A, 5) + F(I, B, C, D) + E + W(I) + K(I);
         E := D; D := C;
         C := Rotate(B, 30);
         B := A; A := Temporary;
      end loop;
      State.H0 := State.H0 + A;
      State.H1 := State.H1 + B;
      State.H2 := State.H2 + C;
      State.H3 := State.H3 + D;
      State.H4 := State.H4 + E;
   end Hash;

   function Hash (State : Status; Data : Word_Block) return Status is
      S : Status := State;
   begin
      Hash(S, Data);
      return S;
   end Hash;

   function Hash (Data : Word_Array) return Digest is -- ; Bit_Length:Natural:= Word_Array'Length*32
      S : Status := Initial_Status;
      B, Two : Word_Block;
      Needed : Boolean;
   begin
      declare
         I : Positive := 1;
      begin
         loop
            exit when Data'Length < I + 16; -- Exit when all but the last block have been processed.
            B := Data(I .. I + 15);
            I := I + 16;
            Hash(S, B);
         end loop;
	 if Data'Length mod 16 = 0 then -- Surely I can write that much better once I sleep on this.
	    B(1 .. 16) := Data(I .. Data'Last);
	 else
	    B(1 .. Data'Last mod 16) := Data(I .. Data'Last);
	 end if;
      end;
      Pad(Primary => B, Auxiliary => Two, Bit_Length => Data'Length * 32, Overflow => Needed);
      Hash(S, B);      -- The bit-length for this procedure will always be a multiple of thirty-two.
      if Needed then   -- Using this two-block approach for padding results in the simplest program.
         Hash(S, Two); -- Isn't this a nice little function?
      end if;
      return To_Digest(S);
   end Hash;

   function To_Digest (State : Status) return Digest is
   begin
      return Digest(State);
   end To_Digest;

   function To_String (Datum : Digest) return String is
      S : String (1 .. 40);
      O : constant Octet_Array := To_Octets(Datum);
      H : constant array (Octet range 0 .. 15) of Character := "0123456789ABCDEF";
   begin
      for I in O'Range loop
         S(I*2-1) := H(O(I) / 16);
         S(I*2)   := H(O(I) mod 16);
      end loop;
      return S;
   end To_String;

   function To_Bits (Datum : Digest) return Bit_Array is
      B : Bit_Array (1 .. 160);
      W : constant Word_Array := To_Words(Datum);
   begin
      for I in W'Range loop
         for J in 0 .. 31 loop
            B(J+1+(32*(I-1))) := Bit((W(I) / 2**(31 - J)) mod 2);
         end loop;
      end loop;
      return B;
   end To_Bits;

   function To_Octets (Datum : Digest) return Octet_Array is
      O : Octet_Array (1 .. 20);
      W : constant Word_Array := To_Words(Datum);
   begin
      for I in W'Range loop
	 O(I*4-3) := Octet(W(I) / 2**24);
	 O(I*4-2) := Octet(W(I) / 2**16 mod 256);
	 O(I*4-1) := Octet(W(I) / 2**8  mod 256);
	 O(I*4)   := Octet(W(I) mod 256);
      end loop;
      return O;
   end To_Octets;

   function To_Words (Datum : Digest) return Word_Array is
   begin
      return (Datum.H0, Datum.H1, Datum.H2, Datum.H3, Datum.H4);
   end To_Words;
end SHA1;
.