-- SHA - Provide an idealized interface to the US Secure Hash Algorithm 1 and 2 family of functions.
-- Copyright (C) 2020,2023 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/>.

-- This use clause is used to bring Interfaces.Rotate_Right and Interfaces.Shift_Right for generics.
-- The use of System is purely to bring in Default_Bit_Order, High_Order_First, and Low_Order_First.
with Unchecked_Conversion, Interfaces, System; use Interfaces, System;

-- As of writing, this code wastefully repeats far too many things, but is under two thousand lines.
package body SHA is
   -- Unlike Ch and Maj, the parameterization of these functions made it better to leave them alone.
   generic
      type Unit is mod <>;
      A, B, C : Natural;
      with function Rotate_Right (Value : in Unit; Amount : in Natural) return Unit is <>;
   function Generic_Big_Sigma (Value : in Unit) return Unit;

   function Generic_Big_Sigma (Value : in Unit) return Unit is
   begin
      return Rotate_Right(Value, A) xor Rotate_Right(Value, B) xor Rotate_Right(Value, C);
   end Generic_Big_Sigma;

   generic
      type Unit is mod <>;
      A, B, C : Natural;
      with function Rotate_Right (Value : in Unit; Amount : in Natural) return Unit is <>;
      with function  Shift_Right (Value : in Unit; Amount : in Natural) return Unit is <>;
   function Generic_Small_Sigma (Value : in Unit) return Unit;

   function Generic_Small_Sigma (Value : in Unit) return Unit is
   begin
      return Rotate_Right(Value, A) xor Rotate_Right(Value, B) xor Shift_Right(Value, C);
   end Generic_Small_Sigma;

   function Big_Sigma_Zero is new Generic_Big_Sigma(Interfaces.Unsigned_32,  2, 13, 22);
   function Big_Sigma_Zero is new Generic_Big_Sigma(Interfaces.Unsigned_64, 28, 34, 39);
   function Big_Sigma_One  is new Generic_Big_Sigma(Interfaces.Unsigned_32,  6, 11, 25);
   function Big_Sigma_One  is new Generic_Big_Sigma(Interfaces.Unsigned_64, 14, 18, 41);

   function Small_Sigma_Zero is new Generic_Small_Sigma(Interfaces.Unsigned_32,  7, 18,  3);
   function Small_Sigma_Zero is new Generic_Small_Sigma(Interfaces.Unsigned_64,  1,  8,  7);
   function Small_Sigma_One  is new Generic_Small_Sigma(Interfaces.Unsigned_32, 17, 19, 10);
   function Small_Sigma_One  is new Generic_Small_Sigma(Interfaces.Unsigned_64, 19, 61,  6);

   generic
      type Unit is mod <>;
      type Unit_Block_Range is range <>;
      type Unit_Block is array (Unit_Block_Range) of Unit;
      type Cycle_Type is range <>;
      type Status_Index is range <>;
      type Status_Type is array (Status_Index) of Unit;
      type Schedule is array (Cycle_Type) of Unit;
      Schedule_Array : Schedule;
      with function Big_Sigma_Zero (Value : in Unit) return Unit is <>;
      with function Big_Sigma_One  (Value : in Unit) return Unit is <>;
      with function Small_Sigma_Zero (Value : in Unit) return Unit is <>;
      with function Small_Sigma_One  (Value : in Unit) return Unit is <>;
   procedure Generic_Hash_Block (State : in out Status_Type; Data : in Unit_Block);

   procedure Generic_Hash_Block (State : in out Status_Type; Data : in Unit_Block) is
      function Ch (A, B, C : in Unit) return Unit is
      begin
         return (A and B) or (C and not A);
      end Ch;

      function Maj (A, B, C : in Unit) return Unit is
      begin
         return (A and B) or (A and C) or (B and C);
      end Maj;

      S : Status_Type := State;
      W : array (Cycle_Type) of Unit := (Data( 1), Data( 2), Data( 3), Data( 4), Data( 5), Data( 6),
                                         Data( 7), Data( 8), Data( 9), Data(10), Data(11), Data(12),
                                         Data(13), Data(14), Data(15), Data(16), others => <>);
      T1, T2 : Unit;
      A : Unit renames S(0); B : Unit renames S(1); C : Unit renames S(2); D : Unit renames S(3);
      E : Unit renames S(4); F : Unit renames S(5); G : Unit renames S(6); H : Unit renames S(7);
   begin
      for I in 16 .. Cycle_Type'Last loop
         W(I) := W(I - 7) + W(I - 16) + Small_Sigma_One(W(I - 2)) + Small_Sigma_Zero(W(I - 15));
      end loop;

      for I in Cycle_Type'Range loop
         T1 :=  Ch(E, F, G) + Big_Sigma_One(E) + H + W(I) + Schedule_Array(I);
         T2 := Maj(A, B, C) + Big_Sigma_Zero(A);
         H  := G; G := F; F := E; E := T1 + D;
         D  := C; C := B; B := A; A := T1 + T2;
      end loop;

      for I in Status_Type'Range loop
         State(I) := State(I) + S(I);
      end loop;
   end Generic_Hash_Block;

   generic
      type Unit is mod <>;
      type Unit_Block_Range is range <>;
      type Unit_Block is array (Unit_Block_Range) of Unit;
      type Status_Type is private;
      with procedure Hash (State : in out Status_Type; Data : in Unit_Block) is <>;
   function Generic_Hash_Block_Function (State : in Status_Type; Data : in Unit_Block)
                                        return Status_Type;

   function Generic_Hash_Block_Function (State : in Status_Type; Data : in Unit_Block)
                                        return Status_Type is
      S : Status_Type := State;
   begin
      Hash(S, Data);
      return S;
   end Generic_Hash_Block_Function;

   -- I realized that a Generic_Pad could be implemented easily, alongside this Unit_Length concept.
   -- The bodies are identical and as simple as the bit case, by restricting lengths to their units.
   -- The only insignificant issue is the same constraint, which shouldn't be even noticed in usage.
   generic
      type Unit is mod <>;
      type Unit_Block_Range is range <>;
      type Unit_Block is array (Unit_Block_Range) of Unit;
      Terminator : Unit;
   procedure Generic_Pad (Primary      : in out Unit_Block;
                          Auxiliary    :    out Unit_Block;
                          Unit_Length  : in     Natural;
                          Overflow     :    out Boolean);

   procedure Generic_Pad (Primary      : in out Unit_Block;
                          Auxiliary    :    out Unit_Block;
                          Unit_Length  : in     Natural;
                          Overflow     :    out Boolean) is
      Remains : constant Natural := Unit_Length mod Unit_Block'Length;
      -- Terminator : constant Unit := 2**(Unit'Size - 1);
      procedure Place_Length (Data : in out Unit_Block) is
         Truncated : Interfaces.Unsigned_64 := Interfaces.Unsigned_64'Mod(Unit_Length) * Unit'Size;
      begin
         for I in reverse Unit_Block_Range range Data'Last - (Data'Last / 8) .. Data'Last loop
            Data(I)   := Unit'Mod(Truncated);
            Truncated := Interfaces.Shift_Right(Truncated, Unit'Size);
         end loop;
      end Place_Length;

      procedure Place_One (Data : in out Unit_Block) is
      begin
         Data(Unit_Block_Range(1 + Remains)) := Terminator;
      end Place_One;

      procedure Place_Zeroes (Data : in out Unit_Block) is
      begin
         Data(Unit_Block_Range(2 + Remains) .. Data'Last) := (others => 0);
      end Place_Zeroes;
   begin -- This body is complicated only by that need to determine which bits go into which blocks.
      if Unit_Length = 0 then -- If Remains = 0 then Overflow := True; in each but this single case.
         Overflow := False; Primary := (Terminator, others => 0);
      else
         Auxiliary := (others => 0); -- It's easiest to fill Auxiliary with zeroes, unconditionally.
         if Remains = 0 then
            Overflow := True; Place_One(Auxiliary); Place_Length(Auxiliary);
         elsif Unit_Block_Range(Remains)
           in Unit_Block'Length - (Unit_Block'Length / 8) .. Unit_Block'Length - 1 then
            Overflow := True; Place_One(Primary); Place_Zeroes(Primary); Place_Length(Auxiliary);
         else
            Overflow := False; Place_One(Primary); Place_Zeroes(Primary); Place_Length(Primary);
         end if;
      end if;
   end Generic_Pad;

   -- I originally wanted for this to have Generic_Hash_Explicit_Length's body, but it wasn't to be.
   generic
      type Unit is mod <>;
      type Unit_Block_Range is range <>;
      type Unit_Array is array (Positive range <>) of Unit;
      type Unit_Block is array (Unit_Block_Range) of Unit;
      type Status_Type is private;
      type Digest_Type is private;
      Initial_Status : Status_Type;
      with function To_Digest (State : in Status_Type) return Digest_Type is <>;
      with procedure Hash (State : in out Status_Type; Data : in Unit_Block) is <>;
      with procedure Pad (Primary     : in out Unit_Block;
                          Auxiliary   :    out Unit_Block;
                          Unit_Length : in     Natural;
                          Overflow    :    out Boolean) is <>;
   function Generic_Hash (Data : in Unit_Array) return Digest_Type;

   function Generic_Hash (Data : in Unit_Array) return Digest_Type is
      S : Status_Type := Initial_Status;
      P : Positive'Base := Data'First;
      Needed : Boolean;
      Always, Maybe : Unit_Block;
   begin
      -- When I first wrote this code, in 2019, the position could overflow with a very large array.
      -- When I rewrote it, in the following year, it could underflow with certain bad empty arrays.
      -- Therefore, explicitly checking for an empty array is required to properly handle all cases.
      if Data'Length /= 0 then
         while Data'Last - Unit_Block'Length >= P loop
            Hash(S, Unit_Block(Data(P .. P + Integer'Pred(Unit_Block'Length))));
            P := P + Unit_Block'Length;
         end loop;
         -- I wanted this damned loop to be declarative assignment, but generic concerns stopped it.
         for I in Unit_Block_Range range
           Unit_Block'First .. Unit_Block_Range(Data'Last - P + Positive(Unit_Block'First)) loop
            Always(I) := Data(Positive(I) + P - Positive(Unit_Block'First));
         end loop;
      end if;
      Pad(Primary => Always, Auxiliary => Maybe, Unit_Length => Data'Length, Overflow => Needed);
      Hash(S, Unit_Block(Always));
      if Needed then Hash(S, Maybe); end if;
      return To_Digest(S);
   end Generic_Hash;

   -- This design was selected, since it permits the normal Hash functions to be implemented easily.
   -- However, I underestimated a part of the design, and so an otherwise unnecessary if is present.
   -- I rejected a candidate design on the basis of an unnecessary addition, and so this is damning.
   -- I've found myself copying this generic code and modifying it, for those normal Hash functions.
   generic
      type Unit is mod <>;
      type Unit_Block_Range is range <>;
      type Unit_Array is array (Positive range <>) of Unit;
      type Unit_Block is array (Unit_Block_Range) of Unit;
      type Status_Type is private;
      type Digest_Type is private;
      with function To_Digest (State : in Status_Type) return Digest_Type is <>;
      with procedure Hash (State : in out Status_Type; Data : in Unit_Block) is <>;
      with procedure Pad (Primary     : in out Unit_Block;
                          Auxiliary   :    out Unit_Block;
                          Unit_Length : in     Natural;
                          Overflow    :    out Boolean) is <>;
   function Generic_Hash_Explicit_Length (State        : in Status_Type;
                                          Data         : in Unit_Array;
                                          Unit_Length  : in Natural) return Digest_Type;

   function Generic_Hash_Explicit_Length (State        : in Status_Type;
                                          Data         : in Unit_Array;
                                          Unit_Length  : in Natural) return Digest_Type is
      S : Status_Type := State;
      P : Positive := Data'First;
      Needed : Boolean;
      Always, Maybe : Unit_Block;
      procedure Place_Length (Data : in out Unit_Block) is -- This is from that body of Generic_Pad.
         Truncated : Interfaces.Unsigned_64
           := Interfaces.Shift_Left(Interfaces.Unsigned_64'Mod(Unit_Length), Unit'Size);
      begin
         for I in reverse Unit_Block_Range range Data'Last - (Data'Last / 8) .. Data'Last loop
            Data(I)   := Unit'Mod(Truncated);
            Truncated := Interfaces.Shift_Right(Truncated, Unit'Size);
         end loop;
      end Place_Length;
   begin
      if Data'Length /= 0 then
         while Data'Last - Unit_Block'Length >= P loop
            Hash(S, Unit_Block(Data(P .. P + Integer'Pred(Unit_Block'Length))));
            P := P + Unit_Block'Length;
         end loop;
         for I in Unit_Block_Range range
           Unit_Block'First .. Unit_Block_Range(Data'Last - P + Positive(Unit_Block'First)) loop
            Always(I) := Data(Positive(I) + P - Positive(Unit_Block'First));
         end loop;
      end if;
      -- I realized while writing this that Pad must be fed the true data length, even in this case.
      Pad(Primary => Always, Auxiliary => Maybe, Unit_Length => Data'Length, Overflow => Needed);
      -- Rather than make three variants of a specialized Pad for this, that needed code is inlined.
      -- Since this is now a separate procedure, it will simply assume a change to be always needed.
      if Needed then Place_Length(Maybe); else Place_Length(Always); end if;
      Hash(S, Always);
      if Needed then Hash(S, Maybe); end if;
      return To_Digest(S);
   end Generic_Hash_Explicit_Length;

   package body SHA1 is
      procedure Convolute (W : in out Word_Array) is
         type Word_Octet_Array is new Octet_Array (1 .. 4);
         for Word_Octet_Array'Alignment use Word'Alignment;
         function Word_To_Octets is new Unchecked_Conversion(Word, Word_Octet_Array);
         function Octets_To_Word is new Unchecked_Conversion(Word_Octet_Array, Word);
      begin -- This will be inefficient, unless the Unchecked_Conversion can reuse the storage here.
         for I in W'Range loop
            declare
               O : Word_Octet_Array := Word_To_Octets(W(I));
            begin
               W(I) := Octets_To_Word((O(4), O(3), O(2), O(1)));
            end;
         end loop;
      end Convolute;

      function I_Hash is new Generic_Hash
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash_Block_Function
        (  Bit,   Bit_Block_Range,   Bit_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        (Octet, Octet_Block_Range, Octet_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        ( Word,  Word_Block_Range,  Word_Block, Status);
      function I_Hash is new Generic_Hash_Explicit_Length
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest);
      procedure I_Pad is new Generic_Pad(  Bit,   Bit_Block_Range,   Bit_Block,     1);
      procedure I_Pad is new Generic_Pad(Octet, Octet_Block_Range, Octet_Block,   128);
      procedure I_Pad is new Generic_Pad( Word,  Word_Block_Range,  Word_Block, 2**31);

      function Hash (Data : in   Bit_Array) return Digest renames I_Hash;
      function Hash (Data : in Octet_Array) return Digest renames I_Hash;
      function Hash (Data : in  Word_Array) return Digest renames I_Hash;

      function  Hash (State : in Status; Data : in   Bit_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in Octet_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in  Word_Block) return Status renames I_Hash;

      function Bits_To_Octets (From : in Bit_Block) return Octet_Block is
         Octets : Octet_Block;
         N : Octet := 0;
      begin
         for O in Octet_Block'Range loop
            for B in Positive range (O * 8) - 7 .. (O * 8) loop
               N := (2 * N) + Octet(From(B));
            end loop;
            Octets(O) := N; N := 0;
         end loop;
         return Octets;
      end Bits_To_Octets;

      procedure Hash (State : in out Status; Data : in Bit_Block) is
      begin
         Hash(State, Bits_To_Octets(Data));
      end Hash;

      procedure Hash (State : in out Status; Data : in Octet_Block) is
         function Octets_To_Words is new Unchecked_Conversion(Octet_Block, Word_Block);
      begin -- I see no way around this requirement to alter the Octet_Block, in certain situations.
         case Default_Bit_Order is
            when High_Order_First => Hash(State, Octets_To_Words(Data));
            when  Low_Order_First =>
               declare
                  D : Word_Block := Octets_To_Words(Data);
               begin
                  Convolute(D);
                  Hash(State, D);
               end;
         end case;
      end Hash;

      procedure Hash (State : in out Status; Data : in  Word_Block) is
         S : Status := State;
         T : Word;
         W : array (Cycle) of Word
           := (Data(1), Data( 2), Data( 3), Data( 4), Data( 5), Data( 6), Data( 7), Data(8),
               Data(9), Data(10), Data(11), Data(12), Data(13), Data(14), Data(15), others => <>);
         K : constant array (Cycle) of Word
           := ( 0 .. 19 => 16#5A82_7999#, 20 .. 39 => 16#6ED9_EBA1#,
               40 .. 59 => 16#8F1B_BCDC#, 60 .. 79 => 16#CA62_C1D6#);
         A : Word renames S(0); B : Word renames S(1); C : Word renames S(2); D : Word renames S(3);
         E : Word renames S(4);
         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;
      begin
         for I in Cycle range 16 .. Cycle'Last loop
            W(I) := Interfaces.Rotate_Left
              (Amount => 1, Value => W(I - 3) xor W(I - 8) xor W(I - 14) xor W(I - 16));
         end loop;

         for I in Cycle'Range loop
            T := Interfaces.Rotate_Left(A, 5) + F(I, B, C, D) + E + W(I) + K(I);
            E := D; D := C; C := Interfaces.Rotate_Left(B, 30); B := A; A := T;
         end loop;

         for I in State'Range loop
            State(I) := State(I) + S(I);
         end loop;
      end Hash;

      function Hash (State        : in Status;
                     Data         : in Bit_Array;
                     Bit_Length   : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Octet_Array;
                     Octet_Length : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Word_Array;
                     Word_Length  : in Natural) return Digest renames I_Hash;

      procedure Pad (Primary      : in out Bit_Block;
                     Auxiliary    :    out Bit_Block;
                     Bit_Length   : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Octet_Block;
                     Auxiliary    :    out Octet_Block;
                     Octet_Length : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Word_Block;
                     Auxiliary    :    out Word_Block;
                     Word_Length  : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;

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

      -- These subtypes aren't public, because I dislike their names, and I need no greater reasons.
      subtype Digest_Bits   is   Bit_array (1 .. 160);
      subtype Digest_Octets is Octet_array (1 ..  20);
      subtype Digest_Words  is  Word_array (1 ..   5);

      function To_String (Datum : in Digest) return String is
         S : String (1 .. Digest_Octets'Length * 2);
         O : Digest_Octets := 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 : in Digest) return Bit_Array is
         B : Digest_Bits;
         O : constant Digest_Octets := To_Octets(Datum);
      begin
         for I in O'Range loop
            B(I * 8 - 7) := Bit'Mod(O(I) / 2**7);
            B(I * 8 - 6) := Bit'Mod(O(I) / 2**6);
            B(I * 8 - 5) := Bit'Mod(O(I) / 2**5);
            B(I * 8 - 4) := Bit'Mod(O(I) / 2**4);
            B(I * 8 - 3) := Bit'Mod(O(I) / 2**3);
            B(I * 8 - 2) := Bit'Mod(O(I) / 2**2);
            B(I * 8 - 1) := Bit'Mod(O(I) / 2**1);
            B(I * 8)     := Bit'Mod(O(I));
         end loop;
         return B;
      end To_Bits;

      function To_Octets (Datum : in Digest) return Octet_Array is
         function Words_To_Octets is new Unchecked_Conversion(Digest_Words, Digest_Octets);
         W : Digest_Words := To_Words(Datum);
      begin
         case Default_Bit_Order is
            when High_Order_First => null;
            when  Low_Order_First => Convolute(W);
         end case;
         return Words_To_Octets(W);
      end To_Octets;

      function To_Words (Datum : in Digest) return Word_Array is
      begin
         return Digest_Words(Datum);
      end To_Words;
   end SHA1;

   package body SHA256 is
      procedure Convolute (W : in out Word_Array) is
         type Word_Octet_Array is new Octet_Array (1 .. 4);
         for Word_Octet_Array'Alignment use Word'Alignment;
         function Word_To_Octets is new Unchecked_Conversion(Word, Word_Octet_Array);
         function Octets_To_Word is new Unchecked_Conversion(Word_Octet_Array, Word);
      begin
         for I in W'Range loop
            declare
               O : Word_Octet_Array := Word_To_Octets(W(I));
            begin
               W(I) := Octets_To_Word((O(4), O(3), O(2), O(1)));
            end;
         end loop;
      end Convolute;

      function I_Hash is new Generic_Hash
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash_Block_Function
        (  Bit,   Bit_Block_Range,   Bit_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        (Octet, Octet_Block_Range, Octet_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        ( Word,  Word_Block_Range,  Word_Block, Status);
      function I_Hash is new Generic_Hash_Explicit_Length
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest);
      procedure I_Pad is new Generic_Pad(  Bit,   Bit_Block_Range,   Bit_Block,     1);
      procedure I_Pad is new Generic_Pad(Octet, Octet_Block_Range, Octet_Block,   128);
      procedure I_Pad is new Generic_Pad( Word,  Word_Block_Range,  Word_Block, 2**31);

      function Hash (Data : in   Bit_Array) return Digest renames I_Hash;
      function Hash (Data : in Octet_Array) return Digest renames I_Hash;
      function Hash (Data : in  Word_Array) return Digest renames I_Hash;

      function  Hash (State : in Status; Data : in   Bit_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in Octet_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in  Word_Block) return Status renames I_Hash;

      function Bits_To_Octets (From : in Bit_Block) return Octet_Block is
         Octets : Octet_Block;
         N : Octet := 0;
      begin
         for O in Octet_Block'Range loop
            for B in Positive range (O * 8) - 7 .. (O * 8) loop
               N := (2 * N) + Octet(From(B));
            end loop;
            Octets(O) := N; N := 0;
         end loop;
         return Octets;
      end Bits_To_Octets;

      procedure Hash (State : in out Status; Data : in Bit_Block) is
      begin
         Hash(State, Bits_To_Octets(Data));
      end Hash;

      procedure Hash (State : in out Status; Data : in Octet_Block) is
         function Octets_To_Words is new Unchecked_Conversion(Octet_Block, Word_Block);
      begin
         case Default_Bit_Order is
            when High_Order_First => Hash(State, Octets_To_Words(Data));
            when  Low_Order_First =>
               declare
                  D : Word_Block := Octets_To_Words(Data);
               begin
                  Convolute(D);
                  Hash(State, D);
               end;
         end case;
      end Hash;

      procedure I_Hash is new Generic_Hash_Block
        (Word, Word_Block_Range, Word_Block, Cycle, Status_Index, Status, Lesser_Array, KK);

      procedure Hash (State : in out Status; Data : in  Word_Block) renames I_Hash;

      function Hash (State        : in Status;
                     Data         : in Bit_Array;
                     Bit_Length   : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Octet_Array;
                     Octet_Length : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Word_Array;
                     Word_Length  : in Natural) return Digest renames I_Hash;

      procedure Pad (Primary      : in out Bit_Block;
                     Auxiliary    :    out Bit_Block;
                     Bit_Length   : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Octet_Block;
                     Auxiliary    :    out Octet_Block;
                     Octet_Length : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Word_Block;
                     Auxiliary    :    out Word_Block;
                     Word_Length  : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;

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

      subtype Digest_Bits   is   Bit_array (1 .. 256);
      subtype Digest_Octets is Octet_array (1 ..  32);
      subtype Digest_Words  is  Word_array (1 ..   8);

      function To_String (Datum : in Digest) return String is
         S : String (1 .. Digest_Octets'Length * 2);
         O : Digest_Octets := 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 : in Digest) return Bit_Array is
         B : Digest_Bits;
         O : constant Digest_Octets := To_Octets(Datum);
      begin
         for I in O'Range loop
            B(I * 8 - 7) := Bit'Mod(O(I) / 2**7);
            B(I * 8 - 6) := Bit'Mod(O(I) / 2**6);
            B(I * 8 - 5) := Bit'Mod(O(I) / 2**5);
            B(I * 8 - 4) := Bit'Mod(O(I) / 2**4);
            B(I * 8 - 3) := Bit'Mod(O(I) / 2**3);
            B(I * 8 - 2) := Bit'Mod(O(I) / 2**2);
            B(I * 8 - 1) := Bit'Mod(O(I) / 2**1);
            B(I * 8)     := Bit'Mod(O(I));
         end loop;
         return B;
      end To_Bits;

      function To_Octets (Datum : in Digest) return Octet_Array is
         function Words_To_Octets is new Unchecked_Conversion(Digest_Words, Digest_Octets);
         W : Digest_Words := To_Words(Datum);
      begin
         case Default_Bit_Order is
            when High_Order_First => null;
            when  Low_Order_First => Convolute(W);
         end case;
         return Words_To_Octets(W);
      end To_Octets;

      function To_Words (Datum : in Digest) return Word_Array is
      begin
         return Digest_Words(Datum);
      end To_Words;
   end SHA256;

   package body SHA224 is
      procedure Convolute (W : in out Word_Array) is
         type Word_Octet_Array is new Octet_Array (1 .. 4);
         for Word_Octet_Array'Alignment use Word'Alignment;
         function Word_To_Octets is new Unchecked_Conversion(Word, Word_Octet_Array);
         function Octets_To_Word is new Unchecked_Conversion(Word_Octet_Array, Word);
      begin
         for I in W'Range loop
            declare
               O : Word_Octet_Array := Word_To_Octets(W(I));
            begin
               W(I) := Octets_To_Word((O(4), O(3), O(2), O(1)));
            end;
         end loop;
      end Convolute;

      function I_Hash is new Generic_Hash
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash_Block_Function
        (  Bit,   Bit_Block_Range,   Bit_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        (Octet, Octet_Block_Range, Octet_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        ( Word,  Word_Block_Range,  Word_Block, Status);
      function I_Hash is new Generic_Hash_Explicit_Length
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest);
      procedure I_Pad is new Generic_Pad(  Bit,   Bit_Block_Range,   Bit_Block,     1);
      procedure I_Pad is new Generic_Pad(Octet, Octet_Block_Range, Octet_Block,   128);
      procedure I_Pad is new Generic_Pad( Word,  Word_Block_Range,  Word_Block, 2**31);

      function Hash (Data : in   Bit_Array) return Digest renames I_Hash;
      function Hash (Data : in Octet_Array) return Digest renames I_Hash;
      function Hash (Data : in  Word_Array) return Digest renames I_Hash;

      function  Hash (State : in Status; Data : in   Bit_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in Octet_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in  Word_Block) return Status renames I_Hash;

      function Bits_To_Octets (From : in Bit_Block) return Octet_Block is
         Octets : Octet_Block;
         N : Octet := 0;
      begin
         for O in Octet_Block'Range loop
            for B in Positive range (O * 8) - 7 .. (O * 8) loop
               N := (2 * N) + Octet(From(B));
            end loop;
            Octets(O) := N; N := 0;
         end loop;
         return Octets;
      end Bits_To_Octets;

      procedure Hash (State : in out Status; Data : in Bit_Block) is
      begin
         Hash(State, Bits_To_Octets(Data));
      end Hash;

      procedure Hash (State : in out Status; Data : in Octet_Block) is
         function Octets_To_Words is new Unchecked_Conversion(Octet_Block, Word_Block);
      begin
         case Default_Bit_Order is
            when High_Order_First => Hash(State, Octets_To_Words(Data));
            when  Low_Order_First =>
               declare
                  D : Word_Block := Octets_To_Words(Data);
               begin
                  Convolute(D);
                  Hash(State, D);
               end;
         end case;
      end Hash;

      procedure I_Hash is new Generic_Hash_Block
        (Word, Word_Block_Range, Word_Block, Cycle, Status_Index, Status, Lesser_Array, KK);

      procedure Hash (State : in out Status; Data : in  Word_Block) renames I_Hash;

      function Hash (State        : in Status;
                     Data         : in Bit_Array;
                     Bit_Length   : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Octet_Array;
                     Octet_Length : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Word_Array;
                     Word_Length  : in Natural) return Digest renames I_Hash;

      procedure Pad (Primary      : in out Bit_Block;
                     Auxiliary    :    out Bit_Block;
                     Bit_Length   : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Octet_Block;
                     Auxiliary    :    out Octet_Block;
                     Octet_Length : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Word_Block;
                     Auxiliary    :    out Word_Block;
                     Word_Length  : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;

      function To_Digest (State : in Status) return Digest is
      begin
         return Digest(State(0 .. 6));
      end To_Digest;

      subtype Digest_Bits   is   Bit_array (1 .. 224);
      subtype Digest_Octets is Octet_array (1 ..  28);
      subtype Digest_Words  is  Word_array (1 ..   7);

      function To_String (Datum : in Digest) return String is
         S : String (1 .. Digest_Octets'Length * 2);
         O : Digest_Octets := 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 : in Digest) return Bit_Array is
         B : Digest_Bits;
         O : constant Digest_Octets := To_Octets(Datum);
      begin
         for I in O'Range loop
            B(I * 8 - 7) := Bit'Mod(O(I) / 2**7);
            B(I * 8 - 6) := Bit'Mod(O(I) / 2**6);
            B(I * 8 - 5) := Bit'Mod(O(I) / 2**5);
            B(I * 8 - 4) := Bit'Mod(O(I) / 2**4);
            B(I * 8 - 3) := Bit'Mod(O(I) / 2**3);
            B(I * 8 - 2) := Bit'Mod(O(I) / 2**2);
            B(I * 8 - 1) := Bit'Mod(O(I) / 2**1);
            B(I * 8)     := Bit'Mod(O(I));
         end loop;
         return B;
      end To_Bits;

      function To_Octets (Datum : in Digest) return Octet_Array is
         function Words_To_Octets is new Unchecked_Conversion(Digest_Words, Digest_Octets);
         W : Digest_Words := To_Words(Datum);
      begin
         case Default_Bit_Order is
            when High_Order_First => null;
            when  Low_Order_First => Convolute(W);
         end case;
         return Words_To_Octets(W);
      end To_Octets;

      function To_Words (Datum : in Digest) return Word_Array is
      begin
         return Digest_Words(Datum);
      end To_Words;
   end SHA224;

   package body SHA512 is
      procedure Convolute (W : in out Word_Array) is
         type Word_Octet_Array is new Octet_Array (1 .. 8);
         for Word_Octet_Array'Alignment use Word'Alignment;
         function Word_To_Octets is new Unchecked_Conversion(Word, Word_Octet_Array);
         function Octets_To_Word is new Unchecked_Conversion(Word_Octet_Array, Word);
      begin
         for I in W'Range loop
            declare
               O : Word_Octet_Array := Word_To_Octets(W(I));
            begin
               W(I) := Octets_To_Word((O(8), O(7), O(6), O(5), O(4), O(3), O(2), O(1)));
            end;
         end loop;
      end Convolute;

      function I_Hash is new Generic_Hash
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash_Block_Function
        (  Bit,   Bit_Block_Range,   Bit_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        (Octet, Octet_Block_Range, Octet_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        ( Word,  Word_Block_Range,  Word_Block, Status);
      function I_Hash is new Generic_Hash_Explicit_Length
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest);
      procedure I_Pad is new Generic_Pad(  Bit,   Bit_Block_Range,   Bit_Block,     1);
      procedure I_Pad is new Generic_Pad(Octet, Octet_Block_Range, Octet_Block,   128);
      procedure I_Pad is new Generic_Pad( Word,  Word_Block_Range,  Word_Block, 2**31);

      function Hash (Data : in   Bit_Array) return Digest renames I_Hash;
      function Hash (Data : in Octet_Array) return Digest renames I_Hash;
      function Hash (Data : in  Word_Array) return Digest renames I_Hash;

      function  Hash (State : in Status; Data : in   Bit_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in Octet_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in  Word_Block) return Status renames I_Hash;

      function Bits_To_Octets (From : in Bit_Block) return Octet_Block is
         Octets : Octet_Block;
         N : Octet := 0;
      begin
         for O in Octet_Block'Range loop
            for B in Positive range (O * 8) - 7 .. (O * 8) loop
               N := (2 * N) + Octet(From(B));
            end loop;
            Octets(O) := N; N := 0;
         end loop;
         return Octets;
      end Bits_To_Octets;

      procedure Hash (State : in out Status; Data : in Bit_Block) is
      begin
         Hash(State, Bits_To_Octets(Data));
      end Hash;

      procedure Hash (State : in out Status; Data : in Octet_Block) is
         function Octets_To_Words is new Unchecked_Conversion(Octet_Block, Word_Block);
      begin
         case Default_Bit_Order is
            when High_Order_First => Hash(State, Octets_To_Words(Data));
            when  Low_Order_First =>
               declare
                  D : Word_Block := Octets_To_Words(Data);
               begin
                  Convolute(D);
                  Hash(State, D);
               end;
         end case;
      end Hash;

      procedure I_Hash is new Generic_Hash_Block
        (Word, Word_Block_Range, Word_Block, Cycle, Status_Index, Status, Larger_Array, KKK);

      procedure Hash (State : in out Status; Data : in  Word_Block) renames I_Hash;

      function Hash (State        : in Status;
                     Data         : in Bit_Array;
                     Bit_Length   : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Octet_Array;
                     Octet_Length : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Word_Array;
                     Word_Length  : in Natural) return Digest renames I_Hash;

      procedure Pad (Primary      : in out Bit_Block;
                     Auxiliary    :    out Bit_Block;
                     Bit_Length   : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Octet_Block;
                     Auxiliary    :    out Octet_Block;
                     Octet_Length : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Word_Block;
                     Auxiliary    :    out Word_Block;
                     Word_Length  : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;

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

      subtype Digest_Bits   is   Bit_array (1 .. 512);
      subtype Digest_Octets is Octet_array (1 ..  64);
      subtype Digest_Words  is  Word_array (1 ..   8);

      function To_String (Datum : in Digest) return String is
         S : String (1 .. Digest_Octets'Length * 2);
         O : Digest_Octets := 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 : in Digest) return Bit_Array is
         B : Digest_Bits;
         O : constant Digest_Octets := To_Octets(Datum);
      begin
         for I in O'Range loop
            B(I * 8 - 7) := Bit'Mod(O(I) / 2**7);
            B(I * 8 - 6) := Bit'Mod(O(I) / 2**6);
            B(I * 8 - 5) := Bit'Mod(O(I) / 2**5);
            B(I * 8 - 4) := Bit'Mod(O(I) / 2**4);
            B(I * 8 - 3) := Bit'Mod(O(I) / 2**3);
            B(I * 8 - 2) := Bit'Mod(O(I) / 2**2);
            B(I * 8 - 1) := Bit'Mod(O(I) / 2**1);
            B(I * 8)     := Bit'Mod(O(I));
         end loop;
         return B;
      end To_Bits;

      function To_Octets (Datum : in Digest) return Octet_Array is
         function Words_To_Octets is new Unchecked_Conversion(Digest_Words, Digest_Octets);
         W : Digest_Words := To_Words(Datum);
      begin
         case Default_Bit_Order is
            when High_Order_First => null;
            when  Low_Order_First => Convolute(W);
         end case;
         return Words_To_Octets(W);
      end To_Octets;

      function To_Words (Datum : in Digest) return Word_Array is
      begin
         return Digest_Words(Datum);
      end To_Words;
   end SHA512;

   package body SHA384 is
      procedure Convolute (W : in out Word_Array) is
         type Word_Octet_Array is new Octet_Array (1 .. 8);
         for Word_Octet_Array'Alignment use Word'Alignment;
         function Word_To_Octets is new Unchecked_Conversion(Word, Word_Octet_Array);
         function Octets_To_Word is new Unchecked_Conversion(Word_Octet_Array, Word);
      begin
         for I in W'Range loop
            declare
               O : Word_Octet_Array := Word_To_Octets(W(I));
            begin
               W(I) := Octets_To_Word((O(8), O(7), O(6), O(5), O(4), O(3), O(2), O(1)));
            end;
         end loop;
      end Convolute;

      function I_Hash is new Generic_Hash
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest, Initial_Status);
      function I_Hash is new Generic_Hash_Block_Function
        (  Bit,   Bit_Block_Range,   Bit_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        (Octet, Octet_Block_Range, Octet_Block, Status);
      function I_Hash is new Generic_Hash_Block_Function
        ( Word,  Word_Block_Range,  Word_Block, Status);
      function I_Hash is new Generic_Hash_Explicit_Length
        (  Bit,   Bit_Block_Range,   Bit_Array,   Bit_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        (Octet, Octet_Block_Range, Octet_Array, Octet_Block, Status, Digest);
      function I_Hash is new Generic_Hash_Explicit_Length
        ( Word,  Word_Block_Range,  Word_Array,  Word_Block, Status, Digest);
      procedure I_Pad is new Generic_Pad(  Bit,   Bit_Block_Range,   Bit_Block,     1);
      procedure I_Pad is new Generic_Pad(Octet, Octet_Block_Range, Octet_Block,   128);
      procedure I_Pad is new Generic_Pad( Word,  Word_Block_Range,  Word_Block, 2**31);

      function Hash (Data : in   Bit_Array) return Digest renames I_Hash;
      function Hash (Data : in Octet_Array) return Digest renames I_Hash;
      function Hash (Data : in  Word_Array) return Digest renames I_Hash;

      function  Hash (State : in Status; Data : in   Bit_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in Octet_Block) return Status renames I_Hash;
      function  Hash (State : in Status; Data : in  Word_Block) return Status renames I_Hash;

      function Bits_To_Octets (From : in Bit_Block) return Octet_Block is
         Octets : Octet_Block;
         N : Octet := 0;
      begin
         for O in Octet_Block'Range loop
            for B in Positive range (O * 8) - 7 .. (O * 8) loop
               N := (2 * N) + Octet(From(B));
            end loop;
            Octets(O) := N; N := 0;
         end loop;
         return Octets;
      end Bits_To_Octets;

      procedure Hash (State : in out Status; Data : in Bit_Block) is
      begin
         Hash(State, Bits_To_Octets(Data));
      end Hash;

      procedure Hash (State : in out Status; Data : in Octet_Block) is
         function Octets_To_Words is new Unchecked_Conversion(Octet_Block, Word_Block);
      begin
         case Default_Bit_Order is
            when High_Order_First => Hash(State, Octets_To_Words(Data));
            when  Low_Order_First =>
               declare
                  D : Word_Block := Octets_To_Words(Data);
               begin
                  Convolute(D);
                  Hash(State, D);
               end;
         end case;
      end Hash;

      procedure I_Hash is new Generic_Hash_Block
        (Word, Word_Block_Range, Word_Block, Cycle, Status_Index, Status, Larger_Array, KKK);

      procedure Hash (State : in out Status; Data : in  Word_Block) renames I_Hash;

      function Hash (State        : in Status;
                     Data         : in Bit_Array;
                     Bit_Length   : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Octet_Array;
                     Octet_Length : in Natural) return Digest renames I_Hash;
      function Hash (State        : in Status;
                     Data         : in Word_Array;
                     Word_Length  : in Natural) return Digest renames I_Hash;

      procedure Pad (Primary      : in out Bit_Block;
                     Auxiliary    :    out Bit_Block;
                     Bit_Length   : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Octet_Block;
                     Auxiliary    :    out Octet_Block;
                     Octet_Length : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;
      procedure Pad (Primary      : in out Word_Block;
                     Auxiliary    :    out Word_Block;
                     Word_Length  : in     Natural;
                     Overflow     :    out Boolean) renames I_Pad;

      function To_Digest (State : in Status) return Digest is
      begin
         return Digest(State(0 .. 5));
      end To_Digest;

      subtype Digest_Bits   is   Bit_array (1 .. 384);
      subtype Digest_Octets is Octet_array (1 ..  48);
      subtype Digest_Words  is  Word_array (1 ..   6);

      function To_String (Datum : in Digest) return String is
         S : String (1 .. Digest_Octets'Length * 2);
         O : Digest_Octets := 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 : in Digest) return Bit_Array is
         B : Digest_Bits;
         O : constant Digest_Octets := To_Octets(Datum);
      begin
         for I in O'Range loop
            B(I * 8 - 7) := Bit'Mod(O(I) / 2**7);
            B(I * 8 - 6) := Bit'Mod(O(I) / 2**6);
            B(I * 8 - 5) := Bit'Mod(O(I) / 2**5);
            B(I * 8 - 4) := Bit'Mod(O(I) / 2**4);
            B(I * 8 - 3) := Bit'Mod(O(I) / 2**3);
            B(I * 8 - 2) := Bit'Mod(O(I) / 2**2);
            B(I * 8 - 1) := Bit'Mod(O(I) / 2**1);
            B(I * 8)     := Bit'Mod(O(I));
         end loop;
         return B;
      end To_Bits;

      function To_Octets (Datum : in Digest) return Octet_Array is
         function Words_To_Octets is new Unchecked_Conversion(Digest_Words, Digest_Octets);
         W : Digest_Words := To_Words(Datum);
      begin
         case Default_Bit_Order is
            when High_Order_First => null;
            when  Low_Order_First => Convolute(W);
         end case;
         return Words_To_Octets(W);
      end To_Octets;

      function To_Words (Datum : in Digest) return Word_Array is
      begin
         return Digest_Words(Datum);
      end To_Words;
   end SHA384;
end SHA;
.