* SHA512/SHA384 + JWT signers, refactor SHA256 to use class methods

packages/fcl-web/fpmake.pp

@@ -50,6 +50,7 @@ begin
 
     P.SourcePath.Add('src/base');
     P.SourcePath.Add('src/webdata');
+    P.SourcePath.Add('src/jwt');
     P.SourcePath.Add('src/jsonrpc');
     P.SourcePath.Add('src/hpack');
     P.SourcePath.Add('src/restbridge');
@@ -327,6 +328,12 @@ begin
     T.Dependencies.AddUnit('fpjwt');
     T:=P.Targets.AddUnit('fpoauth2ini.pp');
     T.Dependencies.AddUnit('fpoauth2');
+    T:=P.Targets.AddUnit('fpjwasha256.pp');
+    T.Dependencies.AddUnit('fpjwt');
+    T:=P.Targets.AddUnit('fpjwasha512.pp');
+    T.Dependencies.AddUnit('fpjwt');
+    T:=P.Targets.AddUnit('fpjwasha384.pp');
+    T.Dependencies.AddUnit('fpjwt');
     T:=P.Targets.AddUnit('fphttpwebclient.pp');
     T.Dependencies.AddUnit('fpwebclient');
     T:=P.Targets.AddUnit('restbase.pp');

packages/fcl-web/src/jwt/fpjwasha256.pp

@@ -0,0 +1,73 @@
+unit fpjwasha256;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  sysutils, fpjwt;
+
+Type
+
+  { TJWTSignerHS256 }
+
+  TJWTSignerHS256 = Class(TJWTSigner)
+  Public
+    Class function AlgorithmName : String; override;
+    Function CreateSignature(aJWT : TJWT; aKey : TJWTKey) : String; override;
+    Function Verify(const aJWT : String; aKey : TJWTKey) : Boolean; override;
+  end;
+
+implementation
+
+uses sha256, basenenc;
+
+Const
+  SErrHMACFailed = 'HMAC SHA256 of JWT Failed';
+
+
+
+{ TJWTSignerHS256 }
+
+class function TJWTSignerHS256.AlgorithmName: String;
+begin
+  Result:='HS256';
+end;
+
+function TJWTSignerHS256.CreateSignature(aJWT: TJWT; aKey: TJWTKey): String;
+
+Var
+  B : TBytes;
+  aDigest : TSHA256Digest;
+
+begin
+  B:=GetSignInput(aJWT);
+  aDigest:=Default(TSHA256Digest);
+  if Not TSHA256.HMAC(aKey.AsPointer,aKey.Length,PByte(B),Length(B),aDigest) then
+    Raise EJWT.Create(SErrHMACFailed);
+  Result:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+end;
+
+function TJWTSignerHS256.Verify(const aJWT: String; aKey: TJWTKey): Boolean;
+
+Var
+  J,C,S,S2 : String;
+  B : TBytes;
+  aDigest : TSHA256Digest;
+
+begin
+  Result:=GetParts(aJWT,J,C,S);
+  if Not Result then
+    exit;
+  aDigest:=Default(TSHA256Digest);
+  B:=TEncoding.UTF8.GetAnsiBytes(J+'.'+C);
+  if Not TSHA256.HMAC(aKey.AsPointer,aKey.Length,PByte(B),Length(B),aDigest) then
+    exit;
+  S2:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+  Result:=(S2=S);
+end;
+
+initialization
+  TJWTSignerHS256.Register;
+end.
+

packages/fcl-web/src/jwt/fpjwasha384.pp

@@ -0,0 +1,73 @@
+unit fpjwasha384;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  sysutils, fpjwt;
+
+Type
+
+  { TJWTSignerHS384 }
+
+  TJWTSignerHS384 = Class(TJWTSigner)
+  Public
+    Class function AlgorithmName : String; override;
+    Function CreateSignature(aJWT : TJWT; aKey : TJWTKey) : String; override;
+    Function Verify(const aJWT : String; aKey : TJWTKey) : Boolean; override;
+  end;
+
+implementation
+
+uses sha512, basenenc;
+
+Const
+  SErrHMACFailed = 'HMAC SHA384 of JWT Failed';
+
+
+
+{ TJWTSignerHS384 }
+
+class function TJWTSignerHS384.AlgorithmName: String;
+begin
+  Result:='HS384';
+end;
+
+function TJWTSignerHS384.CreateSignature(aJWT: TJWT; aKey: TJWTKey): String;
+
+Var
+  B : TBytes;
+  aDigest : TSHA384Digest;
+
+begin
+  B:=GetSignInput(aJWT);
+  aDigest:=Default(TSHA384Digest);
+  if Not TSHA384.HMAC(aKey.AsPointer,aKey.Length,PByte(B),Length(B),aDigest) then
+    Raise EJWT.Create(SErrHMACFailed);
+  Result:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+end;
+
+function TJWTSignerHS384.Verify(const aJWT: String; aKey: TJWTKey): Boolean;
+
+Var
+  J,C,S,S2 : String;
+  B : TBytes;
+  aDigest : TSHA384Digest;
+
+begin
+  Result:=GetParts(aJWT,J,C,S);
+  if Not Result then
+    exit;
+  aDigest:=Default(TSHA384Digest);
+  B:=TEncoding.UTF8.GetAnsiBytes(J+'.'+C);
+  if Not TSHA384.HMAC(aKey.AsPointer,aKey.Length,PByte(B),Length(B),aDigest) then
+    exit;
+  S2:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+  Result:=(S2=S);
+end;
+
+initialization
+  TJWTSignerHS384.Register;
+end.
+

packages/fcl-web/src/jwt/fpjwasha512.pp

@@ -0,0 +1,73 @@
+unit fpjwasha512;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  sysutils, fpjwt;
+
+Type
+
+  { TJWTSignerHS512 }
+
+  TJWTSignerHS512 = Class(TJWTSigner)
+  Public
+    Class function AlgorithmName : String; override;
+    Function CreateSignature(aJWT : TJWT; aKey : TJWTKey) : String; override;
+    Function Verify(const aJWT : String; aKey : TJWTKey) : Boolean; override;
+  end;
+
+implementation
+
+uses sha512, basenenc;
+
+Const
+  SErrHMACFailed = 'HMAC SHA512 of JWT Failed';
+
+
+
+{ TJWTSignerHS512 }
+
+class function TJWTSignerHS512.AlgorithmName: String;
+begin
+  Result:='HS512';
+end;
+
+function TJWTSignerHS512.CreateSignature(aJWT: TJWT; aKey: TJWTKey): String;
+
+Var
+  B : TBytes;
+  aDigest : TSHA512Digest;
+
+begin
+  B:=GetSignInput(aJWT);
+  aDigest:=Default(TSHA512Digest);
+  if Not TSHA512.HMAC(aKey.AsPointer,aKey.Length,PByte(B),Length(B),aDigest) then
+    Raise EJWT.Create(SErrHMACFailed);
+  Result:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+end;
+
+function TJWTSignerHS512.Verify(const aJWT: String; aKey: TJWTKey): Boolean;
+
+Var
+  J,C,S,S2 : String;
+  B : TBytes;
+  aDigest : TSHA512Digest;
+
+begin
+  Result:=GetParts(aJWT,J,C,S);
+  if Not Result then
+    exit;
+  aDigest:=Default(TSHA512Digest);
+  B:=TEncoding.UTF8.GetAnsiBytes(J+'.'+C);
+  if Not TSHA512.HMAC(aKey.AsPointer,aKey.Length,PByte(B),Length(B),aDigest) then
+    exit;
+  S2:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+  Result:=(S2=S);
+end;
+
+initialization
+  TJWTSignerHS512.Register;
+end.
+

packages/fcl-web/src/base/fpjwt.pp → packages/fcl-web/src/jwt/fpjwt.pp

@@ -14,13 +14,35 @@
 unit fpjwt;
 
 {$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
 
 interface
 
 uses
-  TypInfo, Classes, SysUtils, fpjson, base64;
+  TypInfo, Classes, SysUtils, fpjson, basenenc;
 
 Type
+  EJWT = Class(EJSON);
+
+  { TJWTKey }
+
+  TJWTKey = Record
+  private
+    function GetAsPByte: PByte;
+    function GetAsString: UTF8String;
+    function GetLength: Integer;
+    procedure SetAsString(AValue: UTF8String);
+    procedure SetLength(AValue: Integer);
+  public
+    Bytes : TBytes;
+    Class Function Create(aBytes : TBytes) : TJWTKey; static;
+    Class Function Create(aString : UTF8String) : TJWTKey; static;
+    Class Function Empty : TJWTKey; static;
+    Property AsPointer : PByte Read GetAsPByte;
+    Property Length : Integer Read GetLength Write SetLength;
+    Property AsBytes : TBytes Read Bytes Write Bytes;
+    Property AsString : UTF8String Read GetAsString Write SetAsString;
+  end;
 
   { TBaseJWT }
 
@@ -40,8 +62,8 @@ Type
     Procedure LoadFromJSON(JSON : TJSONObject);
     Procedure SaveToJSON(JSON : TJSONObject; All : Boolean);
     // Base64url conversion functions (RFC7515)
-    class function Base64ToBase64URL(AValue: string): string;
-    class function Base64URLToBase64(AValue: string): string;
+    class function Base64ToBase64URL(AValue: string): string; deprecated 'Use basenenc functions instead';
+    class function Base64URLToBase64(AValue: string): string; deprecated 'Use basenenc functions instead';
     // Decode Base64url string.
     Class Function DecodeString(S : String) : String;
     // Decode Base64url string and return a JSON Object.
@@ -107,6 +129,9 @@ Type
   TClaimsClass = Class of TClaims;
 
   { TJWT }
+  TJWT = Class;
+
+  TJWTClass = Class of TJWT;
 
   TJWT = Class(TBaseJWT)
   private
@@ -126,6 +151,8 @@ Type
   Public
     Constructor Create; override;
     Destructor Destroy; override;
+    Function Sign(aKey : TJWTKey) : String;
+    Class Function ValidateJWT(const aJWT : String; aKey : TJWTKey; aClass : TJWTClass = Nil) : TJWT;
     // Owned by the JWT. The JSON header.
     Property JOSE : TJOSE Read FJOSE Write SetJOSE;
     // Owned by the JWT. The set of claims. The actual class will depend on the descendant.
@@ -133,10 +160,254 @@ Type
     Property Signature : String Read FSignature Write FSignature;
   end;
 
+
+  { TJWTSigner }
+  TJWTSigner = Class;
+  TJWTSignerClass = Class of TJWTSigner;
+
+  TJWTSigner = Class
+  Private
+    class var FAlgorithms : TStringList;
+    Class Procedure RegisterAlgorithm(const aName : String; aClass : TJWTSignerClass);
+    Class Procedure UnRegisterAlgorithm(const aName : String);
+  Public
+    class Destructor done;
+    Class function AlgorithmName : String; virtual; abstract;
+    Class Function GetParts(const aJWT : String; out aJOSE,aClaims,aSign : String) : Boolean;
+    Class Function CreateSigner(aAlgorithm : String): TJWTSigner;
+    Constructor Create; virtual;
+    Function CreateSignature(aJWT : TJWT; aKey : TJWTKey) : String; virtual; abstract;
+    Function Verify(const aJWT : String; aKey : TJWTKey) : Boolean; virtual; abstract;
+    Function AppendSignature(aJWT : TJWT; aKey : TJWTKey) : String;
+    Function GetSignInputString(aJWT : TJWT) : UTF8String;
+    Function GetSignInput(aJWT : TJWT) : TBytes;
+    Class Function ParseAndVerify(const aJWT : String; aKey : TJWTKey; aClass : TJWTClass = Nil) : TJWT;
+    Class Procedure Register;
+    Class Procedure UnRegister;
+  end;
+
+  { TJWTSignerNone }
+
+  TJWTSignerNone = Class(TJWTSigner)
+  Public
+    Class function AlgorithmName : String; override;
+    Function CreateSignature(aJWT : TJWT; aKey : TJWTKey) : String; override;
+    Function Verify(const aJWT : String; aKey : TJWTKey) : Boolean; override;
+  end;
+
 implementation
 
 uses strutils;
 
+Resourcestring
+  SErrMissingAlgorithmName = 'Missing JWA algorithm name';
+  SErrUnSupportedAlgorithmName = 'Unsupported JWA algorithm: "%s"';
+
+type
+
+  { TJWTSignerReg }
+
+  TJWTSignerReg = Class
+  private
+    FName : String;
+    FClass : TJWTSignerClass;
+  Public
+    Constructor Create(Const aName: String; aClass: TJWTSignerClass);
+    Property Name : String Read FName;
+    Property SignerClass : TJWTSignerClass Read FClass;
+  end;
+
+{ TJWTKey }
+
+function TJWTKey.GetAsPByte: PByte;
+begin
+  Result:=PByte(Bytes);
+end;
+
+function TJWTKey.GetAsString: UTF8String;
+begin
+  Result:=TEncoding.UTF8.GetAnsiString(Bytes);
+end;
+
+function TJWTKey.GetLength: Integer;
+begin
+  Result:=System.Length(Bytes)
+end;
+
+procedure TJWTKey.SetAsString(AValue: UTF8String);
+begin
+  Bytes:=TEncoding.UTF8.GetAnsiBytes(aValue);
+end;
+
+procedure TJWTKey.SetLength(AValue: Integer);
+begin
+  System.SetLength(Bytes,aValue)
+end;
+
+class function TJWTKey.Create(aBytes: TBytes): TJWTKey;
+begin
+  Result.AsBytes:=aBytes;
+end;
+
+class function TJWTKey.Create(aString: UTF8String): TJWTKey;
+begin
+  Result.AsString:=aString;
+end;
+
+class function TJWTKey.Empty: TJWTKey;
+begin
+  Result:=Default(TJWTKey);
+end;
+
+{ TJWTSignerNone }
+
+class function TJWTSignerNone.AlgorithmName: String;
+begin
+  Result:='none'
+end;
+
+function TJWTSignerNone.CreateSignature(aJWT: TJWT; aKey : TJWTKey): String;
+begin
+  Result:='';
+end;
+
+function TJWTSignerNone.Verify(const aJWT: String; aKey : TJWTKey): Boolean;
+
+Var
+  J,C,S : String;
+
+begin
+  Result:=GetParts(aJWT,J,C,S) and (S='');
+end;
+
+{ TJWTSignerReg }
+
+constructor TJWTSignerReg.Create(Const aName: String; aClass: TJWTSignerClass);
+begin
+  FName:=aName;
+  FClass:=aClass;
+end;
+
+{ TJWTSigner }
+
+class procedure TJWTSigner.RegisterAlgorithm(const aName: String; aClass: TJWTSignerClass);
+
+begin
+  if (aName='') then
+    Raise EJWT.Create(SErrMissingAlgorithmName);
+  if (FAlgorithms=Nil) then
+    begin
+    FAlgorithms:=TStringList.Create;
+    FAlgorithms.OwnsObjects:=True;
+    end
+  else
+    UnregisterAlgorithm(aName);
+  FAlgorithms.AddObject(aName,TJWTSignerReg.Create(aName,aClass));
+end;
+
+class procedure TJWTSigner.UnRegisterAlgorithm(Const aName: String);
+
+Var
+  Idx : Integer;
+
+begin
+  if (aName='') then
+    Raise EJWT.Create(SErrMissingAlgorithmName);
+  Idx:=FAlgorithms.indexOf(aName);
+  if Idx<>-1 then
+    FAlgorithms.Delete(Idx);
+end;
+
+constructor TJWTSigner.Create;
+begin
+  // Do nothing
+end;
+
+class destructor TJWTSigner.done;
+begin
+  FreeAndNil(FAlgorithms);
+end;
+
+class function TJWTSigner.GetParts(const aJWT : String; out aJOSE, aClaims, aSign: String): Boolean;
+
+begin
+  aJOSE:=ExtractWord(1,AJWT,['.']);
+  aClaims:=ExtractWord(2,AJWT,['.']);
+  aSign:=ExtractWord(3,AJWT,['.']);
+  Result:=(aJOSE<>'') and (aClaims<>'');
+end;
+
+class function TJWTSigner.CreateSigner(aAlgorithm: String): TJWTSigner;
+
+Var
+  Idx : Integer;
+  aClass : TJWTSignerClass;
+
+begin
+  if (aAlgorithm='') then
+    Raise EJWT.Create(SErrMissingAlgorithmName);
+  Idx:=-1;
+  if Assigned(FAlgorithms) then
+    Idx:=FAlgorithms.IndexOf(aAlgorithm);
+  if Idx=-1 then
+    Raise EJWT.CreateFmt(SErrUnSupportedAlgorithmName,[aAlgorithm]);
+  aClass:=TJWTSignerReg(FAlgorithms.Objects[Idx]).SignerClass;
+  Result:=aClass.Create;
+end;
+
+Function TJWTSigner.AppendSignature(aJWT: TJWT;aKey : TJWTKey) : String;
+
+begin
+  aJWT.Signature:=CreateSignature(aJWT,aKey);
+  Result:=aJWT.AsEncodedString;
+end;
+
+function TJWTSigner.GetSignInputString(aJWT: TJWT): UTF8String;
+begin
+  Result:=aJWT.JOSE.AsEncodedString+'.'+aJWT.Claims.AsEncodedString
+end;
+
+function TJWTSigner.GetSignInput(aJWT: TJWT): TBytes;
+begin
+  Result:=TEncoding.UTF8.GetAnsiBytes(GetSignInputString(aJWT));
+end;
+
+Class function TJWTSigner.ParseAndVerify(const aJWT: String; aKey : TJWTKey; aClass : TJWTClass = Nil): TJWT;
+
+Var
+  S : TJWTSigner;
+  Ok : Boolean;
+
+
+begin
+  if (aClass=Nil) then
+    aClass:=TJWT;
+  Ok:=False;
+  S:=Nil;
+  Result:=aClass.Create;
+  try
+    Result.AsEncodedString:=aJWT;
+    S:=CreateSigner(Result.JOSE.alg);
+    if not S.Verify(aJWT,aKey) then
+      FreeAndNil(Result);
+    OK:=true;
+  finally
+    S.Free;
+    if not OK then
+      Result.Free;
+  end;
+end;
+
+class procedure TJWTSigner.Register;
+begin
+  RegisterAlgorithm(AlgorithmName,Self);
+end;
+
+class procedure TJWTSigner.UnRegister;
+begin
+  UnRegisterAlgorithm(AlgorithmName);
+end;
+
 { TJWT }
 
 procedure TJWT.SetClaims(AValue: TClaims);
@@ -163,8 +434,8 @@ end;
 
 function TJWT.GetAsString: TJSONStringType;
 begin
-  Result:=Base64ToBase64URL(EncodeStringBase64(JOSE.AsString));
-  Result:=Result+'.'+Base64ToBase64URL(EncodeStringBase64(Claims.AsString));
+  Result:=Base64URL.Encode(JOSE.AsString,False);
+  Result:=Result+'.'+Base64URL.Encode(Claims.AsString,False);
   // Dot must always be present, even if signature is empty.
   // https://tools.ietf.org/html/rfc7519#section-6.1
   // (See also Bug ID 37830)
@@ -196,6 +467,29 @@ begin
   Inherited;
 end;
 
+function TJWT.Sign(aKey : TJWTKey): String;
+
+Var
+  S: TJWTSigner;
+
+begin
+  S:=TJWTSigner.CreateSigner(JOSE.alg);
+  try
+    Result:=S.AppendSignature(Self,aKey);
+  finally
+    S.Free;
+  end;
+end;
+
+class function TJWT.ValidateJWT(const aJWT: String; aKey : TJWTKey; aClass: TJWTClass): TJWT;
+
+
+begin
+  if aClass=Nil then
+    aClass:=Self;
+  Result:=TJWTSigner.ParseAndVerify(aJWT,aKey,aClass);
+end;
+
 procedure TJWT.SetAsString(AValue: TJSONStringType);
 
 Var
@@ -214,7 +508,7 @@ end;
 
 function TBaseJWT.GetAsEncodedString: String;
 begin
-  Result:=Base64ToBase64URL(EncodeStringBase64(AsString));
+  Result:=Base64URL.Encode(AsString,False);
 end;
 
 procedure TBaseJWT.SetAsEncodedString(AValue: String);
@@ -412,7 +706,7 @@ end;
 
 class function TBaseJWT.DecodeString(S: String): String;
 begin
-  Result:=DecodeStringBase64(Base64URLToBase64(S), True);
+  Result:=TEncoding.UTF8.GetAnsiString(Base64URL.Decode(S));
 end;
 
 class function TBaseJWT.DecodeStringToJSON(S: String): TJSONObject;
@@ -426,5 +720,7 @@ begin
   Result:=TJSONObject(D);
 end;
 
+initialization
+  TJWTSignerNone.Register;
 end.
 

packages/fcl-web/tests/tcjwt.pp

@@ -0,0 +1,229 @@
+unit tcjwt;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjwt;
+
+type
+
+
+  { TMyClaims }
+
+  TMyClaims = Class(TClaims)
+  private
+    FAdmin: Boolean;
+    FName: string;
+  Published
+    Property Name : string Read FName Write FName;
+    Property admin : Boolean Read FAdmin Write FAdmin;
+  end;
+
+  { TMyJWT }
+
+  TMyJWT = Class(TJWT)
+    Function CreateClaims : TClaims; override;
+  end;
+
+  { TTestJWT }
+  TTestJWT= class(TTestCase)
+  private
+    FJWT: TJWT;
+    FKey : TJWTKey;
+    FVerifyResult : TJWT;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Property JWT : TJWT Read FJWT;
+    Property Key : TJWTKey Read FKey;
+  published
+    procedure TestSignNone;
+    procedure TestVerifyNone;
+    procedure TestSignSHA256;
+    procedure TestVerifySHA256;
+    procedure TestSignSHA512;
+    procedure TestVerifySHA512;
+    procedure TestSignSHA384;
+    procedure TestVerifySHA384;
+  end;
+
+implementation
+
+uses basenenc, sha256, fpjwasha256, sha512, fpjwasha512, fpjwasha384;
+
+{ TMyJWT }
+
+function TMyJWT.CreateClaims: TClaims;
+begin
+  Result:=TMyClaims.Create;
+end;
+
+procedure TTestJWT.TestSignNone;
+
+Var
+  P1,P2 : String;
+
+begin
+  P1:=FJWT.JOSE.AsEncodedString;
+  P2:=FJWT.Claims.AsEncodedString;
+  AssertEquals('Signed with none',P1+'.'+P2+'.',FJWT.Sign(TJWTKey.Empty));
+end;
+
+procedure TTestJWT.TestVerifyNone;
+
+Var
+  aJWT : String;
+
+begin
+  aJWT:=FJWT.AsEncodedString;
+  FVerifyResult:=TJWT.ValidateJWT(aJWT,TJWTKey.Empty,TMyJWT);
+  AssertNotNull('Have result',FVerifyResult);
+  AssertEquals('Correct class',TMyJWT,FVerifyResult.ClassType);
+end;
+
+procedure TTestJWT.TestSignSHA256;
+
+Var
+  Sign,P1,P2 : UTF8String;
+  aDigest : TSHA256Digest;
+  B : TBytes;
+
+begin
+  FJWT.JOSE.alg:='HS256';
+//  Writeln('JOSE: ',FJWT.JOSE.AsString);
+//  Writeln('Claims: ',FJWT.Claims.AsString);
+  P1:=FJWT.JOSE.AsEncodedString;
+  P2:=FJWT.Claims.AsEncodedString;
+  B:=TEncoding.UTF8.GetAnsiBytes(P1+'.'+P2);
+  if not TSHA256.HMAC(FKey.AsPointer,FKey.Length,PByte(B),Length(B),aDigest) then
+    Fail('Could not HMAC');
+  Sign:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+//  Writeln('Signed: ',P1+'.'+P2+'.'+Sign);
+  AssertEquals('Signed with SHA256',P1+'.'+P2+'.'+Sign,FJWT.Sign(FKey));
+end;
+
+procedure TTestJWT.TestVerifySHA256;
+
+Const
+  JWTText ='eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.'+
+           'eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiaWF0IjoxNTE2MjM5MDIyfQ.'+
+           'SflKxwRJSMeKKF2QT4fwpMeJf36POk6yJV_adQssw5c';
+
+
+begin
+  FKey:=TJWTKey.Create('your-256-bit-secret');
+  FVerifyResult:=TJWT.ValidateJWT(JWTText,FKey);
+  AssertNotNull('Have result',FVerifyResult);
+  AssertEquals('Have correct algorithm','HS256',FVerifyResult.JOSE.Alg);
+  AssertEquals('Have correct typ','JWT',FVerifyResult.JOSE.typ);
+  AssertEquals('Have correct sub','1234567890',FVerifyResult.Claims.sub);
+end;
+
+procedure TTestJWT.TestSignSHA512;
+Var
+  Sign,P1,P2 : UTF8String;
+  aDigest : TSHA512Digest;
+  B : TBytes;
+
+begin
+  FJWT.JOSE.alg:='HS512';
+//  Writeln('JOSE: ',FJWT.JOSE.AsString);
+//  Writeln('Claims: ',FJWT.Claims.AsString);
+  P1:=FJWT.JOSE.AsEncodedString;
+  P2:=FJWT.Claims.AsEncodedString;
+  B:=TEncoding.UTF8.GetAnsiBytes(P1+'.'+P2);
+  if not TSHA512.HMAC(FKey.AsPointer,FKey.Length,PByte(B),Length(B),aDigest) then
+    Fail('Could not HMAC');
+  Sign:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+//  Writeln('Signed: ',P1+'.'+P2+'.'+Sign);
+  AssertEquals('Signed with SHA512',P1+'.'+P2+'.'+Sign,FJWT.Sign(FKey));
+end;
+
+procedure TTestJWT.TestVerifySHA512;
+
+Const
+  JWTText = 'eyJhbGciOiJIUzUxMiIsInR5cCI6IkpXVCJ9.'+
+            'eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiYWRtaW4iOnRydWUsImlhdCI6MTUxNjIzOTAyMn0.'+
+            'FEBOl5fjgnPe4gcc5ElXrHDl0jWsshiJ9rS0hlehItc-PKQEzwRKbhcz69V8kwRCUM2rDtuwaXK6DJfO1VOZdw';
+
+begin
+  FKey:=TJWTKey.Create('mysecretkey');
+  FVerifyResult:=TMyJWT.ValidateJWT(JWTText,FKey);
+  AssertNotNull('Have result',FVerifyResult);
+  AssertEquals('Correct class',TMyJWT,FVerifyResult.ClassType);
+  AssertNotNull('Have result.claims',FVerifyResult.Claims);
+  AssertEquals('Correct claims class',TMyClaims,FVerifyResult.Claims.ClassType);
+  AssertEquals('Have correct algorithm','HS512',FVerifyResult.JOSE.Alg);
+  AssertEquals('Have correct typ','JWT',FVerifyResult.JOSE.typ);
+  AssertEquals('Have correct sub','1234567890',FVerifyResult.Claims.sub);
+  AssertEquals('Have correct name','John Doe',(TMyJWT(FVerifyResult).Claims as TMyClaims).Name);
+  AssertEquals('Have correct admin',true,(TMyJWT(FVerifyResult).Claims as TMyClaims).Admin);
+end;
+
+procedure TTestJWT.TestSignSHA384;
+Var
+  Sign,P1,P2 : UTF8String;
+  aDigest : TSHA384Digest;
+  B : TBytes;
+
+begin
+  FJWT.JOSE.alg:='HS384';
+//  Writeln('JOSE: ',FJWT.JOSE.AsString);
+//  Writeln('Claims: ',FJWT.Claims.AsString);
+  P1:=FJWT.JOSE.AsEncodedString;
+  P2:=FJWT.Claims.AsEncodedString;
+  B:=TEncoding.UTF8.GetAnsiBytes(P1+'.'+P2);
+  if not TSHA384.HMAC(FKey.AsPointer,FKey.Length,PByte(B),Length(B),aDigest) then
+    Fail('Could not HMAC');
+  Sign:=Base64URL.Encode(@aDigest[0],Length(aDigest),False);
+  Writeln('Signed: ',P1+'.'+P2+'.'+Sign);
+  AssertEquals('Signed with SHA384',P1+'.'+P2+'.'+Sign,FJWT.Sign(FKey));
+end;
+
+procedure TTestJWT.TestVerifySHA384;
+
+Const
+  JWTText =
+     'eyJhbGciOiJIUzM4NCIsInR5cCI6IkpXVCJ9.'+
+     'eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiYWRtaW4iOnRydWUsImlhdCI6MTUxNjIzOTAyMn0.'+
+     '8XBKpuFoIEyTxqiP7Rw32VkkxSPGrujBw2ZiKgcX5ZgjH3M8OmTWfYeRDAR6NRVB';
+
+begin
+  FKey:=TJWTKey.Create('mysecretkey');
+  FVerifyResult:=TMyJWT.ValidateJWT(JWTText,FKey);
+  AssertNotNull('Have result',FVerifyResult);
+  AssertEquals('Correct class',TMyJWT,FVerifyResult.ClassType);
+  AssertNotNull('Have result.claims',FVerifyResult.Claims);
+  AssertEquals('Correct claims class',TMyClaims,FVerifyResult.Claims.ClassType);
+  AssertEquals('Have correct algorithm','HS384',FVerifyResult.JOSE.Alg);
+  AssertEquals('Have correct typ','JWT',FVerifyResult.JOSE.typ);
+  AssertEquals('Have correct sub','1234567890',FVerifyResult.Claims.sub);
+  AssertEquals('Have correct name','John Doe',(TMyJWT(FVerifyResult).Claims as TMyClaims).Name);
+  AssertEquals('Have correct admin',true,(TMyJWT(FVerifyResult).Claims as TMyClaims).Admin);
+end;
+
+procedure TTestJWT.SetUp;
+begin
+  Inherited;
+  FKey:=TJWTKey.Create('mysecretkey');
+  FJWT:=TMyJWT.Create;
+  FJWT.JOSE.alg:='none';
+  FJWT.JOSE.typ:='JWT';
+  FJWT.Claims.sub:='1234567890';
+  FJWT.Claims.iat:=1516239022;
+  (FJWT.Claims as TMyClaims).Name:='John Doe';
+end;
+
+procedure TTestJWT.TearDown;
+begin
+  FreeAndNil(FJWT);
+  FreeAndNil(FVerifyResult);
+  Inherited;
+end;
+
+initialization
+  RegisterTest(TTestJWT);
+end.
+

packages/fcl-web/tests/testfpweb.lpi

@@ -1,17 +1,16 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="testfpweb"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
@@ -20,16 +19,23 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestHTTPRoute.TestWebModuleHandler"/>
+        <CommandLineParams Value="--suite=TTestJWT"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="--suite=TTestJWT"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="1">
       <Item1>
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="7">
       <Unit0>
         <Filename Value="testfpweb.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -42,6 +48,22 @@
         <Filename Value="../src/base/httproute.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="tcjwt.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../src/jwt/fpjwasha256.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="../src/jwt/fpjwasha512.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="../src/jwt/fpjwasha384.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -51,7 +73,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src/base"/>
+      <OtherUnitFiles Value="../src/base;../src/jwt"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
   </CompilerOptions>

packages/fcl-web/tests/testfpweb.lpr

@@ -3,7 +3,7 @@ program testfpweb;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tchttproute;
+  Classes, consoletestrunner, tchttproute, tcjwt, jsonparser, fpjwasha256, fpjwasha512, fpjwasha384;
 
 type
 

packages/hash/fpmake.pp

@@ -40,6 +40,8 @@ begin
     T.Dependencies.AddUnit('ecc');
     T:=P.Targets.AddUnit('src/sha256.pp');
     T.Dependencies.AddUnit('hashutils');
+    T:=P.Targets.AddUnit('src/sha512.pp');
+    T.Dependencies.AddUnit('hashutils');
     T:=P.Targets.AddUnit('src/onetimepass.pp');
     T:=P.Targets.AddUnit('src/crc.pas');
     T:=P.Targets.AddUnit('src/ntlm.pas');

packages/hash/src/sha256.pp

@@ -30,7 +30,7 @@ Type
     Digest: TSHA256Digest;
     HashBuffer: array[0..63] of Byte;
     Index: UInt32;
-    Length: Int64;
+    TotalLength: Int64;
     procedure Compress;
     procedure Final;
     procedure Init;
@@ -38,40 +38,34 @@ Type
     procedure OutputHexa(out Result: AnsiString);
     procedure Update(PBuf: PByte; Size: UInt32); overload;
     procedure Update(const Value: TBytes); overload;
+
+    // Calculate SHA256, return digest as bytes.
+    class procedure DigestBytes(const Value: TBytes; out Result: TBytes) ; static;
+    // Calculate  SHA256, return digest as base64(url) string
+    class procedure DigestBase64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString); static;
+    // Calculate  SHA256, return digest as HEX encoded string
+    class procedure DigestHexa(const Value: TBytes; out Result: AnsiString); static;
+    // HMAC using SHA256 as hash
+    Class function HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var aDigest: TSHA256Digest): Boolean; overload; static;
+    class function HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var aDigest: TSHA256Digest): Boolean; overload; static;
+    // Calculate HMacSHA256, return digest as hex string.
+    class function HMACHexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload; static;
+    // Calculate SHA256 from a stream, return digest.
+    class procedure Stream(aStream: TStream; out aDigest: TSHA256Digest); static; overload;
+    class function Stream(aStream: TStream): TSHA256Digest; static; overload;
+    // Digest Stream, result as HexaDecimal string.
+    class procedure StreamHexa(aStream: TStream; out Result: AnsiString); static; overload;
+    class Function StreamHexa(aStream: TStream): AnsiString; static overload;
+    // Digest Stream, result as Base64-encoded string
+    class procedure StreamBase64(aStream: TStream; isURL : Boolean; out Result: AnsiString); static; overload;
+    class Function StreamBase64(aStream: TStream; isURL : Boolean): AnsiString; static; overload;
+    // HKDF : Derive key of desired length from a salt,input key and info  (RF5869, using HMACSHA256) .
+    class function HKDF(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean; static;
   end;
 
 Const
   SHA256_DIGEST_SIZE = SizeOf(TSHA256Digest); // 32
 
-// Calculate SHA256, return digest as bytes.
-procedure SHA256(const Value: TBytes; out Result: TBytes);
-// Calculate  SHA256, return digest as base64(url) string
-procedure SHA256Base64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString);
-// Calculate  SHA256, return digest as HEX encoded string
-procedure SHA256Hexa(const Value: TBytes; out Result: AnsiString);
-
-// Calculate HMacSHA256, return digest as bytes.
-function HMACSHA256(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var Digest: TSHA256Digest): Boolean; overload;
-function HMACSHA256(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var Digest: TSHA256Digest): Boolean; overload;
-// Calculate HMacSHA256, return digest as hex string.
-function HMACSHA256Hexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload;
-
-// Calculate HMacSHA256 from a stream, return digest.
-procedure StreamSHA256(aStream: TStream; out Digest: TSHA256Digest);
-function StreamSHA256(aStream: TStream): TSHA256Digest;
-
-// Calculate HMacSHA256 from a stream, return digest as HEX-Encoded string.
-procedure StreamSHA256Hexa(aStream: TStream; out Result: AnsiString);
-Function StreamSHA256Hexa(aStream: TStream): AnsiString;
-
-// Calculate HMacSHA256 from a stream, return digest as base64-encoded string.
-procedure StreamSHA256Base64(aStream: TStream; isURL : Boolean; out Result: AnsiString);
-Function StreamSHA256Base64(aStream: TStream; isURL : Boolean): AnsiString;
-
-// HKDF : Derive key of desired length from a salt,input key and info  (RF5869, using HMACSHA256) .
-function HKDF_SHA256(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean;
-
-
 implementation
 
 uses hashutils;
@@ -83,7 +77,7 @@ uses hashutils;
 procedure TSHA256.Init;
 begin
   Self.Index := 0;
-  Self.Length := 0;
+  Self.TotalLength := 0;
   FillChar(Self.HashBuffer, Sizeof(Self.HashBuffer), 0);
   Self.Context[0] := $6a09e667;
   Self.Context[1] := $bb67ae85;
@@ -167,8 +161,8 @@ begin
   end;
   // Write 64 bit Buffer length into the last bits of the last block
   // (in big endian format) and do a final compress
-  PUInt32(@HashBuffer[56])^ := SwapEndian(TInt64Rec(Self.Length).Hi);
-  PUInt32(@HashBuffer[60])^ := SwapEndian(TInt64Rec(Self.Length).Lo);
+  PUInt32(@HashBuffer[56])^ := SwapEndian(TInt64Rec(TotalLength).Hi);
+  PUInt32(@HashBuffer[60])^ := SwapEndian(TInt64Rec(TotalLength).Lo);
   Compress;
   Context[0] := SwapEndian(Context[0]);
   Context[1] := SwapEndian(Context[1]);
@@ -189,14 +183,14 @@ var
 begin
   Left:=BytesFromVar(@ADigest, SizeOf(ADigest));
   Right:=BytesFromVar(@Self.Digest, SizeOf(Self.Digest));
-  Result:=CompareMem(Pointer(Left), Pointer(Right),System.Length(Left));
+  Result:=CompareMem(Pointer(Left), Pointer(Right),Length(Left));
 end;
 
 procedure TSHA256.Update(PBuf: PByte; Size: UInt32);
 var
   Len: UInt32;
 begin
-  Inc(Self.Length, Int64(UInt32(Size)) shl 3);
+  Inc(TotalLength, Int64(UInt32(Size)) * 8);
   while Size > 0 do
   begin
     if (Sizeof(HashBuffer)-Self.Index) <= UInt32(Size) then
@@ -216,12 +210,6 @@ begin
   end;
 end;
 
-(*
-procedure TSHA256.Update(const Buffer: TXBuffer);
-begin
-  Update(PByte(Buffer.Buf), Buffer.Size);
-end;
-*)
 
 procedure TSHA256.Update(const Value: TBytes);
 begin
@@ -237,7 +225,7 @@ begin
 end;
 
 // @Result[32]
-procedure SHA256(const Value: TBytes; out Result: TBytes);
+class procedure TSHA256.DigestBytes(const Value: TBytes; out Result: TBytes);
 var
   lSHA256: TSHA256;
 begin
@@ -247,7 +235,7 @@ begin
   BytesFromVar(Result, @lSHA256.Digest[0], SizeOf(lSHA256.Digest));
 end;
 
-procedure SHA256Base64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString);
+class procedure TSHA256.DigestBase64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString);
 var
   S : TBytes;
   lSHA256: TSHA256;
@@ -260,7 +248,7 @@ begin
 end;
 
 // @Result[64]
-procedure SHA256Hexa(const Value: TBytes; out Result: AnsiString);
+Class procedure TSHA256.DigestHexa(const Value: TBytes; out Result: AnsiString);
 var
   SHA256: TSHA256;
 begin
@@ -270,9 +258,9 @@ begin
   SHA256.OutputHexa(Result);
 end;
 
-function HMACSHA256(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var Digest: TSHA256Digest): Boolean;
+class function TSHA256.HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var aDigest: TSHA256Digest): Boolean;
 begin
-  Result := HMACSHA256(Key, KeySize, Data, DataSize, nil, 0, nil, 0, Digest);
+  Result := HMAC(Key, KeySize, Data, DataSize, nil, 0, nil, 0, aDigest);
 end;
 
 {Generate a SHA256 HMAC (Hashed Message Authentication Code) using the Key and Data
@@ -282,7 +270,7 @@ The SHA256 HMAC algorithm is:
        oPad is the byte $5c repeated 64 times
  If Key is more than 64 bytes it will be hashed to Key = SHA256(Key) instead
  If Key is less than 64 bytes it will be padded with zeros }
-function HMACSHA256(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var Digest: TSHA256Digest): Boolean;
+ class function TSHA256.HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var aDigest: TSHA256Digest): Boolean;
 
 Type
   TBuf64 = array[0..63] of Byte;
@@ -325,27 +313,25 @@ begin
   SHA256_.Update(@PadBuffer, SizeOf(PadBuffer));
   SHA256_.Update(@SHA256.Digest, SizeOf(SHA256.Digest));
   SHA256_.Final;
-  System.Move(SHA256_.Digest, Digest, SizeOf(Digest));
-// FillChar(KeyDigest, SizeOf(TSHA1Digest),0);
-// FillChar(KeyBuffer, SizeOf(TSHA1ByteBuffer),0);
-// FillChar(PadBuffer, SizeOf(TSHA1ByteBuffer),0);
+  System.Move(SHA256_.Digest, aDigest, SizeOf(aDigest));
   Result:=True;
 end;
 
 // @Result[64]
-function HMACSHA256Hexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload;
+class function TSHA256.HMACHexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload;
+
 var
-  Digest: TSHA256Digest;
+  aDigest: TSHA256Digest;
   S: TBytes;
 begin
-  Digest:=Default(TSHA256Digest);
-  Result := HMACSHA256(PByte(Key),Length(Key), PByte(Data), Length(Data), Digest);
-  BytesFromVar(S, @Digest[0], SizeOf(Digest));
+  aDigest:=Default(TSHA256Digest);
+  Result := HMAC(PByte(Key),Length(Key), PByte(Data), Length(Data), aDigest);
+  BytesFromVar(S, @aDigest[0], SizeOf(aDigest));
   BytesToHexStr(SignatureHexa,S);
 end;
 
 
-procedure StreamSHA256(aStream: TStream; out Digest: TSHA256Digest);
+class procedure TSHA256.Stream(aStream: TStream; out aDigest: TSHA256Digest);
 
 const
   BUFFER_SIZE = 64*1024;
@@ -366,56 +352,56 @@ begin
      SHA256.Update(PByte(Buffer),aLen);
   until aLen=0;
   SHA256.Final;
-  Digest:=SHA256.Digest;
+  aDigest:=SHA256.Digest;
 end;
 
-function StreamSHA256(aStream: TStream): TSHA256Digest;
+class function TSHA256.Stream(aStream: TStream): TSHA256Digest;
 
 begin
-  StreamSHA256(aStream,Result);
+  Stream(aStream,Result);
 end;
 
 
-procedure StreamSHA256Hexa(aStream: TStream; out Result: AnsiString);
+class procedure TSHA256.StreamHexa(aStream: TStream; out Result: AnsiString);
 
 Var
   B : TBytes;
-  Digest : TSHA256Digest;
+  aDigest : TSHA256Digest;
 
 begin
-  StreamSHA256(aStream,Digest);
-  BytesFromVar(B,@Digest,SizeOf(TSHA256Digest));
+  Stream(aStream,aDigest);
+  BytesFromVar(B,@aDigest,SizeOf(TSHA256Digest));
   BytesToHexStr(Result,B);
 end;
 
-function StreamSHA256Hexa(aStream: TStream): AnsiString;
+class function TSHA256.StreamHexa(aStream: TStream): AnsiString;
 
 begin
   Result:='';
-  StreamSHA256Hexa(aStream,Result);
+  StreamHexa(aStream,Result);
 end;
 
 
-procedure StreamSHA256Base64(aStream: TStream; isURL : Boolean; out Result: AnsiString);
+class procedure TSHA256.StreamBase64(aStream: TStream; isURL : Boolean; out Result: AnsiString);
 
 Var
   B : TBytes;
-  Digest : TSHA256Digest;
+  aDigest : TSHA256Digest;
 
 begin
-  StreamSHA256(aStream,Digest);
-  BytesFromVar(B,@Digest,SizeOf(TSHA256Digest));
+  Stream(aStream,aDigest);
+  BytesFromVar(B,@aDigest,SizeOf(TSHA256Digest));
   BytesEncodeBase64(B,Result,isUrl,False,False);
 end;
 
-Function StreamSHA256Base64(aStream: TStream; isURL : Boolean): AnsiString;
+class Function TSHA256.StreamBase64(aStream: TStream; isURL : Boolean): AnsiString;
 
 begin
   Result:='';
-  StreamSHA256Base64(aStream,isURL,Result);
+  StreamBase64(aStream,isURL,Result);
 end;
 
-function HKDF_SHA256(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean;
+class function TSHA256.HKDF(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean;
 
 var
   PRK, T: TSHA256Digest;
@@ -424,16 +410,16 @@ var
 begin
   PRK:=Default(TSHA256Digest);
   T:=Default(TSHA256Digest);
-  Result := HMACSHA256(PByte(Salt), Length(Salt), PByte(IKM), Length(IKM), PRK);
+  Result := HMAC(PByte(Salt), Length(Salt), PByte(IKM), Length(IKM), PRK);
   if not Result then
     Exit;
   Round := 1;
   while Length(Output) < DesiredLen do
   begin
     if Length(Output) = 0 then
-      Result := HMACSHA256(@PRK, SizeOf(PRK), PByte(Info), Length(Info), @Round, SizeOf(Round), nil, 0, T)
+      Result := HMAC(@PRK, SizeOf(PRK), PByte(Info), Length(Info), @Round, SizeOf(Round), nil, 0, T)
     else
-      Result := HMACSHA256(@PRK, SizeOf(PRK), @T, SizeOf(T), PByte(Info), Length(Info), @Round, SizeOf(Round), T);
+      Result := HMAC(@PRK, SizeOf(PRK), @T, SizeOf(T), PByte(Info), Length(Info), @Round, SizeOf(Round), T);
     if not Result then
       Exit;
     Inc(Round);

packages/hash/src/sha512.pp

@@ -0,0 +1,876 @@
+{
+  This file is part of the Free Component Library.
+  Copyright (c) 2021 by the Free Pascal team.
+
+  SHA512/SHA384 and HMACSha512/HMACSha384 routines.
+
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+
+  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.
+}
+unit sha512;
+
+{$mode ObjFPC}{$H+}
+{$modeswitch advancedrecords}
+{ $define debugsha}
+
+interface
+
+uses
+  Classes, SysUtils, hashutils;
+
+Type
+  THashBuffer = array[0..127] of Byte;
+
+  { TSHA512 }
+  TSHA512Base = record
+    Context: array[0..7] of QWord;
+    Buffer : THashBuffer;
+    Index: UInt32;
+    TotalLength: Int64;
+    procedure Compress;
+    procedure Final;
+    procedure Init(Use384 : Boolean = False);
+    procedure Update(PBuf: PByte; Size: UInt32); overload;
+    procedure Update(const Value: TBytes); overload;
+{$IFDEF DEBUGSHA}
+  private
+    procedure DumpBuffer;
+    procedure DumpHash;
+{$ENDIF DEBUGSHA}
+  end;
+  PSHA512Base = ^TSHA512Base;
+
+  TSHA512Digest = packed array[0..63] of Byte;
+  PSHA512Digest = ^TSHA512Digest;
+  PSHA512 = ^TSHA512;
+  TSHA512 = record
+    Base : TSHA512Base;
+    Digest: TSHA512Digest;
+    function IsEqual(const ADigest: TSHA512Digest): Boolean;
+    procedure OutputHexa(out Result: AnsiString);
+    procedure Compress;
+    procedure Final;
+    procedure Init;
+    procedure Update(PBuf: PByte; Size: UInt32); overload;
+    procedure Update(const Value: TBytes); overload;
+    // Calculate SHA512, return digest as bytes.
+    class procedure DigestBytes(const Value: TBytes; out Result: TBytes) ; static;
+    // Calculate  SHA512, return digest as base64(url) string
+    class procedure DigestBase64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString); static;
+    // Calculate  SHA512, return digest as HEX encoded string
+    class procedure DigestHexa(const Value: TBytes; out Result: AnsiString); static;
+    // HMAC using SHA512 as hash
+    Class function HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var aDigest: TSHA512Digest): Boolean; overload; static;
+    class function HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var aDigest: TSHA512Digest): Boolean; overload; static;
+    // Calculate HMacSHA512, return digest as hex string.
+    class function HMACHexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload; static;
+    // Calculate SHA512 from a stream, return digest.
+    class procedure Stream(aStream: TStream; out aDigest: TSHA512Digest); static; overload;
+    class function Stream(aStream: TStream): TSHA512Digest; static; overload;
+    // Digest Stream, result as HexaDecimal string.
+    class procedure StreamHexa(aStream: TStream; out Result: AnsiString); static; overload;
+    class Function StreamHexa(aStream: TStream): AnsiString; static overload;
+    // Digest Stream, result as Base64-encoded string
+    class procedure StreamBase64(aStream: TStream; isURL : Boolean; out Result: AnsiString); static; overload;
+    class Function StreamBase64(aStream: TStream; isURL : Boolean): AnsiString; static; overload;
+    // HKDF : Derive key of desired length from a salt,input key and info  (RF5869, using HMACSHA512) .
+    class function HKDF(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean; static;
+  end;
+
+  TSHA384Digest = packed array[0..47] of Byte;
+  PSHA384Digest = ^TSHA384Digest;
+  PSHA384 = ^TSHA384;
+
+  TSHA384 = record
+    Base : TSHA512Base;
+    Digest: TSHA384Digest;
+    function IsEqual(const ADigest: TSHA384Digest): Boolean;
+    procedure OutputHexa(out Result: AnsiString);
+    procedure Compress;
+    procedure Final;
+    procedure Init;
+    procedure Update(PBuf: PByte; Size: UInt32); overload;
+    procedure Update(const Value: TBytes); overload;
+    // Calculate SHA384, return digest as bytes.
+    class procedure DigestBytes(const Value: TBytes; out Result: TBytes) ; static;
+    // Calculate  SHA384, return digest as base64(url) string
+    class procedure DigestBase64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString); static;
+    // Calculate  SHA384, return digest as HEX encoded string
+    class procedure DigestHexa(const Value: TBytes; out Result: AnsiString); static;
+    // HMAC using SHA384 as hash
+    Class function HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var aDigest: TSHA384Digest): Boolean; overload; static;
+    class function HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var aDigest: TSHA384Digest): Boolean; overload; static;
+    // Calculate HMacSHA384, return digest as hex string.
+    class function HMACHexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload; static;
+    // Calculate SHA384 from a stream, return digest.
+    class procedure Stream(aStream: TStream; out aDigest: TSHA384Digest); static; overload;
+    class function Stream(aStream: TStream): TSHA384Digest; static; overload;
+    // Digest Stream, result as HexaDecimal string.
+    class procedure StreamHexa(aStream: TStream; out Result: AnsiString); static; overload;
+    class Function StreamHexa(aStream: TStream): AnsiString; static overload;
+    // Digest Stream, result as Base64-encoded string
+    class procedure StreamBase64(aStream: TStream; isURL : Boolean; out Result: AnsiString); static; overload;
+    class Function StreamBase64(aStream: TStream; isURL : Boolean): AnsiString; static; overload;
+    // HKDF : Derive key of desired length from a salt,input key and info  (RF5869, using HMACSHA384) .
+    class function HKDF(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean; static;
+  end;
+
+Const
+  SHA512_DIGEST_SIZE = SizeOf(TSHA512Digest); // 64
+  SHA384_DIGEST_SIZE = SizeOf(TSHA384Digest); // 48
+
+implementation
+
+Const
+  Seed512Hash : Array[0..7] of QWord
+              = (QWord($6A09E667F3BCC908),
+                 QWord($BB67AE8584CAA73B),
+                 QWord($3C6EF372FE94F82B),
+                 QWord($A54FF53A5F1D36F1),
+                 QWord($510E527FADE682D1),
+                 QWord($9B05688C2B3E6C1F),
+                 QWord($1F83D9ABFB41BD6B),
+                 QWord($5BE0CD19137E2179)
+                 );
+  Seed384Hash : Array[0..7] of QWord
+              = (QWord($cbbb9d5dc1059ed8),
+                 QWord($629a292a367cd507),
+                 QWord($9159015a3070dd17),
+                 QWord($152fecd8f70e5939),
+                 QWord($67332667ffc00b31),
+                 QWord($8eb44a8768581511),
+                 QWord($db0c2e0d64f98fa7),
+                 QWord($47b5481dbefa4fa4)
+                 );
+
+{ ----------------------------------------------------------------------
+  TSHA512Base
+  ----------------------------------------------------------------------}
+
+
+procedure TSHA512Base.Init(Use384 : Boolean = False);
+
+Var
+  I : Integer ;
+
+begin
+  Self.Index := 0;
+  Self.TotalLength := 0;
+  FillChar(Buffer, Sizeof(Buffer), 0);
+  if Not Use384 then
+    begin
+    For I:=0 to 7 do
+      Context[i]:=Seed512Hash[i];
+    end
+  else
+    begin
+    For I:=0 to 7 do
+      Context[i]:=Seed384Hash[i];
+    end;
+end;
+
+
+{$IFDEF DEBUGSHA}
+procedure Tsha512Base.DumpBuffer;
+
+Var
+ i : Integer;
+
+begin
+ For I:=0 to SizeOf(Buffer)-1 do
+   Write(IntToStr(Buffer[i]),',');
+  Writeln;
+end;
+
+procedure TSHA512Base.DumpHash;
+
+Var
+ i : Integer;
+
+begin
+ For I:=0 to 7 do
+   Write(IntToStr(Context[i]),' ');
+  Writeln;
+end;
+{$ENDIF}
+
+procedure TSHA512Base.Update(const Value: TBytes);
+begin
+  Update(PByte(Value), System.Length(Value));
+end;
+
+procedure TSHA512Base.Update(PBuf: PByte; Size: UInt32);
+var
+  Len: UInt32;
+begin
+  Inc(TotalLength, Int64(UInt32(Size)) * 8);
+  while Size > 0 do
+  begin
+    Len:=Sizeof(Buffer)-Index;
+    if Len <= UInt32(Size) then
+    begin
+      Move(PBuf^, Buffer[Index], Len);
+      Dec(Size, Len);
+      Inc(PBuf, Len);
+      Compress;
+      Self.Index := 0;
+    end else
+    begin
+      Move(PBuf^, Buffer[Index], Size);
+      Inc(Self.Index, Size);
+      Size := 0;
+    end;
+  end;
+end;
+
+procedure TSHA512Base.Final;
+
+Var
+  I : Integer;
+
+begin
+  Buffer[Index] := $80;
+  FillChar(Buffer[Index+1], SizeOf(Buffer)-Index-1, 0);
+  if Index >= 112 then
+    Compress;
+  PQWord(@Buffer[112])^ := 0;
+  PQWord(@Buffer[120])^ := SwapEndian(TotalLength);
+  Compress;
+  For I:=0 to 7 do
+    Context[i] := NtoBE(Context[i]);
+end;
+
+procedure TSHA512Base.Compress;
+
+const
+  K: array[0..79] of QWord = (
+     QWord($428A2F98D728AE22),QWord($7137449123EF65CD),QWord($B5C0FBCFEC4D3B2F),QWord($E9B5DBA58189DBBC),
+     QWord($3956C25BF348B538),QWord($59F111F1B605D019),QWord($923F82A4AF194F9B),QWord($AB1C5ED5DA6D8118),
+     QWord($D807AA98A3030242),QWord($12835B0145706FBE),QWord($243185BE4EE4B28C),QWord($550C7DC3D5FFB4E2),
+     QWord($72BE5D74F27B896F),QWord($80DEB1FE3B1696B1),QWord($9BDC06A725C71235),QWord($C19BF174CF692694),
+     QWord($E49B69C19EF14AD2),QWord($EFBE4786384F25E3),QWord($0FC19DC68B8CD5B5),QWord($240CA1CC77AC9C65),
+     QWord($2DE92C6F592B0275),QWord($4A7484AA6EA6E483),QWord($5CB0A9DCBD41FBD4),QWord($76F988DA831153B5),
+     QWord($983E5152EE66DFAB),QWord($A831C66D2DB43210),QWord($B00327C898FB213F),QWord($BF597FC7BEEF0EE4),
+     QWord($C6E00BF33DA88FC2),QWord($D5A79147930AA725),QWord($06CA6351E003826F),QWord($142929670A0E6E70),
+     QWord($27B70A8546D22FFC),QWord($2E1B21385C26C926),QWord($4D2C6DFC5AC42AED),QWord($53380D139D95B3DF),
+     QWord($650A73548BAF63DE),QWord($766A0ABB3C77B2A8),QWord($81C2C92E47EDAEE6),QWord($92722C851482353B),
+     QWord($A2BFE8A14CF10364),QWord($A81A664BBC423001),QWord($C24B8B70D0F89791),QWord($C76C51A30654BE30),
+     QWord($D192E819D6EF5218),QWord($D69906245565A910),QWord($F40E35855771202A),QWord($106AA07032BBD1B8),
+     QWord($19A4C116B8D2D0C8),QWord($1E376C085141AB53),QWord($2748774CDF8EEB99),QWord($34B0BCB5E19B48A8),
+     QWord($391C0CB3C5C95A63),QWord($4ED8AA4AE3418ACB),QWord($5B9CCA4F7763E373),QWord($682E6FF3D6B2B8A3),
+     QWord($748F82EE5DEFB2FC),QWord($78A5636F43172F60),QWord($84C87814A1F0AB72),QWord($8CC702081A6439EC),
+     QWord($90BEFFFA23631E28),QWord($A4506CEBDE82BDE9),QWord($BEF9A3F7B2C67915),QWord($C67178F2E372532B),
+     QWord($CA273ECEEA26619C),QWord($D186B8C721C0C207),QWord($EADA7DD6CDE0EB1E),QWord($F57D4F7FEE6ED178),
+     QWord($06F067AA72176FBA),QWord($0A637DC5A2C898A6),QWord($113F9804BEF90DAE),QWord($1B710B35131C471B),
+     QWord($28DB77F523047D84),QWord($32CAAB7B40C72493),QWord($3C9EBE0A15C9BEBC),QWord($431D67C49C100D4C),
+     QWord($4CC5D4BECB3E42B6),QWord($597F299CFC657E2A),QWord($5FCB6FAB3AD6FAEC),QWord($6C44198C4A475817)
+   );
+
+type
+  TQWordArray = Array[0..79] of QWord;
+
+var
+  A, B, C, D, E, F, G, H: QWord;
+  I: UInt32;
+  t1, t2: QWord;
+  W : TQWordArray;
+
+begin
+  {$IFDEF DEBUGSHA}  DumpHash; DumpBuffer; {$ENDIF}
+  W:=Default(TQWordArray);
+  a:= Context[0];
+  b:= Context[1];
+  c:= Context[2];
+  d:= Context[3];
+  e:= Context[4];
+  f:= Context[5];
+  g:= Context[6];
+  h:= Context[7];
+  // Fill first 16 QWords, swap endianness.
+  Move(Buffer,W,SizeOf(THashBuffer));
+  for i:= 0 to 15 do
+    W[i]:= BeTON(W[i]);
+  for i:= 0 to 79 do
+    begin
+    if I>=16 then
+      W[i]:= W[i-16]
+             // SIGMA4(x) = (ROR64(x, 19) ^ ROR64(x, 61) ^ SHR64(x, 6))
+             + (((W[i-2] shr 19) or (W[i-2] shl 45))
+               xor ((W[i-2] shr 61) or (W[i-2] shl 3))
+               xor (W[i-2] shr 6))
+             + W[i-7]
+             // Sigma3 (x) = (ROR64(x, 1) ^ ROR64(x, 8) ^ SHR64(x, 7));
+             + (((W[i-15] shr 1) or (W[i-15] shl 63))
+                xor ((W[i-15] shr 8) or (W[i-15] shl 56))
+                xor (W[i-15] shr 7));
+
+
+    t1:= h
+           // Sigma2(x) =  (ROR64(x, 14) ^ ROR64(x, 18) ^ ROR64(x, 41))
+         + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23)))
+           // CH(x, y, z) = (((x) & (y)) | (~(x) & (z)))
+         + ((e and f) or (not e and g))
+         + K[i] + W[i];
+    t2:= // SIGMA1(x) = (ROR64(x, 28) ^ ROR64(x, 34) ^ ROR64(x, 39))
+         (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) +
+         // MAJ(x,y,z) = (((x) & (y)) | ((x) & (z)) | ((y) & (z)))
+         ((a and b) or (a and c) or (b and c));
+    h:= g;
+    g:= f;
+    f:= e;
+    e:= d + t1;
+    d:= c;
+    c:= b;
+    b:= a;
+    a:= t1 + t2;
+    end;
+
+  Inc(Context[0], A);
+  Inc(Context[1], B);
+  Inc(Context[2], C);
+  Inc(Context[3], D);
+  Inc(Context[4], E);
+  Inc(Context[5], F);
+  Inc(Context[6], G);
+  Inc(Context[7], H);
+  FillChar(Buffer,Sizeof(Buffer),0);
+  {$IFDEF DEBUGSHA} DumpHash;{$ENDIF}
+end;
+
+
+{ ----------------------------------------------------------------------
+  TSHA512
+  ----------------------------------------------------------------------}
+
+
+procedure TSHA512.Init;
+
+begin
+  Base.Init(False);
+end;
+
+
+procedure TSHA512.Compress;
+
+begin
+  Base.Compress;
+end;
+
+
+procedure TSHA512.Final;
+
+begin
+  Base.Final;
+  Move(Base.Context, Digest, Sizeof(Digest));
+end;
+
+
+function TSHA512.IsEqual(const ADigest: TSHA512Digest): Boolean;
+var
+  Left, Right: TBytes;
+begin
+  Left:=BytesFromVar(@ADigest, SizeOf(ADigest));
+  Right:=BytesFromVar(@Self.Digest, SizeOf(Self.Digest));
+  Result:=CompareMem(Pointer(Left), Pointer(Right),System.Length(Left));
+end;
+
+procedure TSHA512.Update(PBuf: PByte; Size: UInt32);
+
+begin
+  Base.Update(PBuf,Size);
+end;
+
+procedure TSHA512.Update(const Value: TBytes);
+
+begin
+  Base.Update(Value);
+end;
+
+
+class procedure TSHA512.DigestBytes(const Value: TBytes; out Result: TBytes);
+
+var
+  lSHA512: TSHA512;
+
+begin
+  lSHA512.Init;
+  lSHA512.Update(Value);
+  lSHA512.Final;
+  BytesFromVar(Result, @lSHA512.Digest[0], SizeOf(lSHA512.Digest));
+end;
+
+class procedure TSHA512.DigestBase64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString);
+
+var
+  S : TBytes;
+  lSHA512: TSHA512;
+
+begin
+  lSHA512.Init;
+  lSHA512.Update(Value);
+  lSHA512.Final;
+  BytesFromVar(S, @lSHA512.Digest[0], SizeOf(lSHA512.Digest));
+  BytesEncodeBase64(S, Result, IsURL, False, False);
+end;
+
+class procedure TSHA512.DigestHexa(const Value: TBytes; out Result: AnsiString);
+var
+  SHA512: TSHA512;
+begin
+  SHA512.Init;
+  SHA512.Update(Value);
+  SHA512.Final;
+  SHA512.OutputHexa(Result);
+end;
+
+procedure TSHA512.OutputHexa(out Result: AnsiString);
+
+begin
+  BytesToHexStr(Result,PByte(@Self.Digest),SizeOf(Self.Digest));
+end;
+
+class function TSHA512.HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var aDigest: TSHA512Digest): Boolean;
+begin
+  Result := HMAC(Key, KeySize, Data, DataSize, nil, 0, nil, 0, aDigest);
+end;
+
+{Generate a SHA512 HMAC (Hashed Message Authentication Code) using the Key and Data
+The SHA512 HMAC algorithm is:
+ SHA512(Key xor oPad, SHA512(Key xor iPad, Data))
+ Where iPad is the byte $36 repeated 128 times
+       oPad is the byte $5c repeated 128 times
+ If Key is more than 128 bytes it will be hashed to Key = SHA512(Key) instead
+ If Key is less than 128 bytes it will be padded with zeros }
+class function TSHA512.HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var aDigest: TSHA512Digest): Boolean;
+
+Type
+  TBuf128 = array[0..127] of Byte;
+
+var
+  Count: UInt32;
+  KeyBuffer, PadBuffer: TBuf128;
+  SHA512, SHA512_: TSHA512;
+begin
+  Result:=False;
+  if Key = nil then
+    Exit;
+  if Data = nil then
+    Exit;
+  KeyBuffer:=Default(TBuf128);
+  SHA512.Init;
+  if KeySize > 128 then
+  begin
+    SHA512.Update(Key, KeySize);
+    SHA512.Final;
+    System.Move(SHA512.Digest[0], KeyBuffer[0], SizeOf(SHA512.Digest));
+  end else
+    System.Move(Key^, KeyBuffer[0], KeySize);
+  // XOR the key buffer with the iPad value
+  for Count := 0 to 127 do
+    PadBuffer[Count] := KeyBuffer[Count] xor $36;
+  SHA512.Init;
+  SHA512.Update(@PadBuffer, SizeOf(PadBuffer));
+  SHA512.Update(Data, DataSize);
+  if Data2 <> nil then
+    SHA512.Update(Data2, DataSize2);
+  if Data3 <> nil then
+    SHA512.Update(Data3, DataSize3);
+  SHA512.Final;
+  // XOR the key buffer with the oPad value
+  for Count := 0 to 127 do
+    PadBuffer[Count] := KeyBuffer[Count] xor $5C;
+  // SHA512 the key buffer and the result of the inner SHA512 (Outer)
+  SHA512_.Init;
+  SHA512_.Update(@PadBuffer, SizeOf(PadBuffer));
+  SHA512_.Update(@SHA512.Digest, SizeOf(SHA512.Digest));
+  SHA512_.Final;
+  System.Move(SHA512_.Digest, aDigest, SizeOf(aDigest));
+// FillChar(KeyDigest, SizeOf(TSHA1Digest),0);
+// FillChar(KeyBuffer, SizeOf(TSHA1ByteBuffer),0);
+// FillChar(PadBuffer, SizeOf(TSHA1ByteBuffer),0);
+  Result:=True;
+end;
+
+// @Result[64]
+class function TSHA512.HMACHexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload;
+var
+  aDigest: TSHA512Digest;
+  S: TBytes;
+begin
+  aDigest:=Default(TSHA512Digest);
+  Result := HMAC(PByte(Key),System.Length(Key), PByte(Data), System.Length(Data), aDigest);
+  BytesFromVar(S, @aDigest[0], SizeOf(aDigest));
+  BytesToHexStr(SignatureHexa,S);
+end;
+
+
+class procedure TSHA512.Stream(aStream: TStream; out aDigest: TSHA512Digest);
+
+const
+  BUFFER_SIZE = 64*1024;
+
+var
+  aLen : LongInt;
+  lBuffer: TBytes;
+  SHA512: TSHA512;
+
+begin
+  lBuffer:=Nil;
+  SHA512.Init;
+  SetLength(lBuffer,BUFFER_SIZE);
+  repeat
+     aLen:=aStream.Read(lBuffer, BUFFER_SIZE);
+     if aLen = 0 then
+       Break;
+     SHA512.Update(PByte(lBuffer),aLen);
+  until aLen=0;
+  SHA512.Final;
+  aDigest:=SHA512.Digest;
+end;
+
+class function TSHA512.Stream(aStream: TStream): TSHA512Digest;
+
+begin
+  Stream(aStream,Result);
+end;
+
+
+class procedure TSHA512.StreamHexa(aStream: TStream; out Result: AnsiString);
+
+Var
+  B : TBytes;
+  aDigest : TSHA512Digest;
+
+begin
+  Stream(aStream,aDigest);
+  BytesFromVar(B,@aDigest,SizeOf(TSHA512Digest));
+  BytesToHexStr(Result,B);
+end;
+
+class function TSHA512.StreamHexa(aStream: TStream): AnsiString;
+
+begin
+  Result:='';
+  StreamHexa(aStream,Result);
+end;
+
+
+class procedure TSHA512.StreamBase64(aStream: TStream; isURL : Boolean; out Result: AnsiString);
+
+Var
+  B : TBytes;
+  aDigest : TSHA512Digest;
+
+begin
+  Stream(aStream,aDigest);
+  BytesFromVar(B,@aDigest,SizeOf(TSHA512Digest));
+  BytesEncodeBase64(B,Result,isUrl,False,False);
+end;
+
+Class Function TSHA512.StreamBase64(aStream: TStream; isURL : Boolean): AnsiString;
+
+begin
+  Result:='';
+  StreamBase64(aStream,isURL,Result);
+end;
+
+class function TSHA512.HKDF(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean;
+
+var
+  PRK, T: TSHA512Digest;
+  Round: Byte;
+
+begin
+  PRK:=Default(TSHA512Digest);
+  T:=Default(TSHA512Digest);
+  Result := HMAC(PByte(Salt), System.Length(Salt), PByte(IKM), Length(IKM), PRK);
+  if not Result then
+    Exit;
+  Round := 1;
+  while System.Length(Output) < DesiredLen do
+  begin
+    if System.Length(Output) = 0 then
+      Result := HMAC(@PRK, SizeOf(PRK), PByte(Info), System.Length(Info), @Round, SizeOf(Round), nil, 0, T)
+    else
+      Result := HMAC(@PRK, SizeOf(PRK), @T, SizeOf(T), PByte(Info), System.Length(Info), @Round, SizeOf(Round), T);
+    if not Result then
+      Exit;
+    Inc(Round);
+    Output:=Concat(OutPut,BytesFromVar(@T,SizeOf(T)));
+    if Length(Output) >= DesiredLen then
+      Break;
+  end;
+  SetLength(Output,DesiredLen);
+end;
+
+{ ----------------------------------------------------------------------
+  TSHA384
+  ----------------------------------------------------------------------}
+
+procedure TSHA384.Init;
+
+begin
+  Base.Init(True);
+end;
+
+
+procedure TSHA384.Compress;
+
+begin
+  Base.Compress;
+end;
+
+
+procedure TSHA384.Final;
+
+begin
+  Base.Final;
+  Move(Base.Context, Digest, Sizeof(Digest));
+end;
+
+
+function TSHA384.IsEqual(const ADigest: TSHA384Digest): Boolean;
+var
+  Left, Right: TBytes;
+begin
+  Left:=BytesFromVar(@ADigest, SizeOf(ADigest));
+  Right:=BytesFromVar(@Self.Digest, SizeOf(Self.Digest));
+  Result:=CompareMem(Pointer(Left), Pointer(Right),System.Length(Left));
+end;
+
+procedure TSHA384.Update(PBuf: PByte; Size: UInt32);
+
+begin
+  Base.Update(PBuf,Size);
+end;
+
+procedure TSHA384.Update(const Value: TBytes);
+
+begin
+  Base.Update(Value);
+end;
+
+
+class procedure TSHA384.DigestBytes(const Value: TBytes; out Result: TBytes);
+
+var
+  lSHA384: TSHA384;
+
+begin
+  lSHA384.Init;
+  lSHA384.Update(Value);
+  lSHA384.Final;
+  BytesFromVar(Result, @lSHA384.Digest[0], SizeOf(lSHA384.Digest));
+end;
+
+class procedure TSHA384.DigestBase64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString);
+
+var
+  S : TBytes;
+  lSHA384: TSHA384;
+
+begin
+  lSHA384.Init;
+  lSHA384.Update(Value);
+  lSHA384.Final;
+  BytesFromVar(S, @lSHA384.Digest[0], SizeOf(lSHA384.Digest));
+  BytesEncodeBase64(S, Result, IsURL, False, False);
+end;
+
+class procedure TSHA384.DigestHexa(const Value: TBytes; out Result: AnsiString);
+var
+  SHA384: TSHA384;
+begin
+  SHA384.Init;
+  SHA384.Update(Value);
+  SHA384.Final;
+  SHA384.OutputHexa(Result);
+end;
+
+procedure TSHA384.OutputHexa(out Result: AnsiString);
+
+begin
+  BytesToHexStr(Result,PByte(@Self.Digest),SizeOf(Self.Digest));
+end;
+
+class function TSHA384.HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var aDigest: TSHA384Digest): Boolean;
+begin
+  Result := HMAC(Key, KeySize, Data, DataSize, nil, 0, nil, 0, aDigest);
+end;
+
+{Generate a SHA384 HMAC (Hashed Message Authentication Code) using the Key and Data
+The SHA384 HMAC algorithm is:
+ SHA384(Key xor oPad, SHA384(Key xor iPad, Data))
+ Where iPad is the byte $36 repeated 128 times
+       oPad is the byte $5c repeated 128 times
+ If Key is more than 128 bytes it will be hashed to Key = SHA384(Key) instead
+ If Key is less than 128 bytes it will be padded with zeros }
+class function TSHA384.HMAC(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var aDigest: TSHA384Digest): Boolean;
+
+Type
+  TBuf128 = array[0..127] of Byte;
+
+var
+  Count: UInt32;
+  KeyBuffer, PadBuffer: TBuf128;
+  SHA384, SHA384_: TSHA384;
+begin
+  Result:=False;
+  if Key = nil then
+    Exit;
+  if Data = nil then
+    Exit;
+  KeyBuffer:=Default(TBuf128);
+  SHA384.Init;
+  if KeySize > 128 then
+  begin
+    SHA384.Update(Key, KeySize);
+    SHA384.Final;
+    System.Move(SHA384.Digest[0], KeyBuffer[0], SizeOf(SHA384.Digest));
+  end else
+    System.Move(Key^, KeyBuffer[0], KeySize);
+  // XOR the key buffer with the iPad value
+  for Count := 0 to 127 do
+    PadBuffer[Count] := KeyBuffer[Count] xor $36;
+  SHA384.Init;
+  SHA384.Update(@PadBuffer, SizeOf(PadBuffer));
+  SHA384.Update(Data, DataSize);
+  if Data2 <> nil then
+    SHA384.Update(Data2, DataSize2);
+  if Data3 <> nil then
+    SHA384.Update(Data3, DataSize3);
+  SHA384.Final;
+  // XOR the key buffer with the oPad value
+  for Count := 0 to 127 do
+    PadBuffer[Count] := KeyBuffer[Count] xor $5C;
+  // SHA384 the key buffer and the result of the inner SHA384 (Outer)
+  SHA384_.Init;
+  SHA384_.Update(@PadBuffer, SizeOf(PadBuffer));
+  SHA384_.Update(@SHA384.Digest, SizeOf(SHA384.Digest));
+  SHA384_.Final;
+  System.Move(SHA384_.Digest, aDigest, SizeOf(aDigest));
+// FillChar(KeyDigest, SizeOf(TSHA1Digest),0);
+// FillChar(KeyBuffer, SizeOf(TSHA1ByteBuffer),0);
+// FillChar(PadBuffer, SizeOf(TSHA1ByteBuffer),0);
+  Result:=True;
+end;
+
+// @Result[64]
+class function TSHA384.HMACHexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload;
+var
+  aDigest: TSHA384Digest;
+  S: TBytes;
+begin
+  aDigest:=Default(TSHA384Digest);
+  Result := HMAC(PByte(Key),System.Length(Key), PByte(Data), System.Length(Data), aDigest);
+  BytesFromVar(S, @aDigest[0], SizeOf(aDigest));
+  BytesToHexStr(SignatureHexa,S);
+end;
+
+
+class procedure TSHA384.Stream(aStream: TStream; out aDigest: TSHA384Digest);
+
+const
+  BUFFER_SIZE = 64*1024;
+
+var
+  aLen : LongInt;
+  lBuffer: TBytes;
+  SHA384: TSHA384;
+
+begin
+  lBuffer:=Nil;
+  SHA384.Init;
+  SetLength(lBuffer,BUFFER_SIZE);
+  repeat
+     aLen:=aStream.Read(lBuffer, BUFFER_SIZE);
+     if aLen = 0 then
+       Break;
+     SHA384.Update(PByte(lBuffer),aLen);
+  until aLen=0;
+  SHA384.Final;
+  aDigest:=SHA384.Digest;
+end;
+
+class function TSHA384.Stream(aStream: TStream): TSHA384Digest;
+
+begin
+  Stream(aStream,Result);
+end;
+
+
+class procedure TSHA384.StreamHexa(aStream: TStream; out Result: AnsiString);
+
+Var
+  B : TBytes;
+  aDigest : TSHA384Digest;
+
+begin
+  Stream(aStream,aDigest);
+  BytesFromVar(B,@aDigest,SizeOf(TSHA384Digest));
+  BytesToHexStr(Result,B);
+end;
+
+class function TSHA384.StreamHexa(aStream: TStream): AnsiString;
+
+begin
+  Result:='';
+  StreamHexa(aStream,Result);
+end;
+
+
+class procedure TSHA384.StreamBase64(aStream: TStream; isURL : Boolean; out Result: AnsiString);
+
+Var
+  B : TBytes;
+  aDigest : TSHA384Digest;
+
+begin
+  Stream(aStream,aDigest);
+  BytesFromVar(B,@aDigest,SizeOf(TSHA384Digest));
+  BytesEncodeBase64(B,Result,isUrl,False,False);
+end;
+
+Class Function TSHA384.StreamBase64(aStream: TStream; isURL : Boolean): AnsiString;
+
+begin
+  Result:='';
+  StreamBase64(aStream,isURL,Result);
+end;
+
+class function TSHA384.HKDF(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean;
+
+var
+  PRK, T: TSHA384Digest;
+  Round: Byte;
+
+begin
+  PRK:=Default(TSHA384Digest);
+  T:=Default(TSHA384Digest);
+  Result := HMAC(PByte(Salt), System.Length(Salt), PByte(IKM), Length(IKM), PRK);
+  if not Result then
+    Exit;
+  Round := 1;
+  while System.Length(Output) < DesiredLen do
+  begin
+    if System.Length(Output) = 0 then
+      Result := HMAC(@PRK, SizeOf(PRK), PByte(Info), System.Length(Info), @Round, SizeOf(Round), nil, 0, T)
+    else
+      Result := HMAC(@PRK, SizeOf(PRK), @T, SizeOf(T), PByte(Info), System.Length(Info), @Round, SizeOf(Round), T);
+    if not Result then
+      Exit;
+    Inc(Round);
+    Output:=Concat(OutPut,BytesFromVar(@T,SizeOf(T)));
+    if Length(Output) >= DesiredLen then
+      Break;
+  end;
+  SetLength(Output,DesiredLen);
+end;
+
+
+end.
+

packages/hash/tests/tests.pp

@@ -5,7 +5,7 @@ program tests;
 {$mode objfpc}
 
 uses
-  consoletestrunner, TestsHMAC, testsha256, testonetimepass;
+  consoletestrunner, TestsHMAC, testsha256, testonetimepass, sha512, testsha512;
 
 var
   Application: TTestRunner;

packages/hash/tests/testsha256.pp

@@ -5,7 +5,7 @@ unit testsha256;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, sha256, hashutils;
+  Classes, SysUtils, fpcunit, testutils, testregistry, sha256, sha512, hashutils;
 
 type
 
@@ -27,6 +27,9 @@ type
 
 implementation
 
+uses
+  basenenc;
+
 Procedure TTestSHA256.TestHexString(Const aString,aDigest : String);
 
 var
@@ -37,7 +40,7 @@ begin
   S:=[];
   Digest:='';
   S:=TEncoding.UTF8.GetAnsiBytes(aString);
-  SHA256Hexa(S, Digest);
+  TSHA256.DigestHexa(S, Digest);
   AssertEquals('Correct hex digest',aDigest, Digest);
 end;
 
@@ -49,7 +52,7 @@ var
 begin
   S:=TEncoding.UTF8.GetAnsiBytes(aString);
   Digest:='';
-  SHA256Base64(S,False,Digest);
+  TSHA256.DigestBase64(S,False,Digest);
   AssertEquals('Correct base64 digest',aDigest, Digest);
 end;
 
@@ -61,8 +64,8 @@ var
 begin
   S:=TEncoding.UTF8.GetAnsiBytes(aString);
   K:=TEncoding.UTF8.GetAnsiBytes(aKey);
-  HMACSHA256Hexa(K,S,Digest);
-  AssertEquals('Correct base64 digest',aDigest, Digest);
+  TSHA256.HMACHexa(K,S,Digest);
+  AssertEquals('Correct digest',aDigest, Digest);
 end;
 
 procedure TTestSHA256.TestEmpty;
@@ -104,7 +107,7 @@ Var
 begin
   S:=TStringStream.Create('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ');
   try
-    AssertEquals('Correct hash','3964294B664613798D1A477EB8AD02118B48D0C5738C427613202F2ED123B5F1',StreamSHA256Hexa(S));
+    AssertEquals('Correct hash','3964294B664613798D1A477EB8AD02118B48D0C5738C427613202F2ED123B5F1',TSHA256.StreamHexa(S));
   finally
     S.Free;
   end;

packages/hash/tests/testsha512.pp

@@ -0,0 +1,284 @@
+unit testsha512;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, sha512, hashutils;
+
+type
+
+  { TTestSHA512 }
+
+  TTestSHA512 = class(TTestCase)
+  Public
+    Procedure TestHexString(Const aString,aDigest : String);
+    Procedure TestBase64String(Const aString,aDigest : String);
+    Procedure TestHMACString(Const aString,aKey,aDigest : String);
+  published
+    procedure TestEmpty;
+    procedure TestSmallString;
+    procedure TestLargeString;
+    procedure TestEmptyBase64;
+    procedure TestSmallBase64;
+    procedure TestSmallHMAC;
+    procedure TestHMACStream;
+  end;
+
+  { TTestSHA384 }
+
+  TTestSHA384 = class(TTestCase)
+  Public
+    Procedure TestHexString(Const aString,aDigest : String);
+    Procedure TestBase64String(Const aString,aDigest : String);
+    Procedure TestHMACString(Const aString,aKey,aDigest : String);
+  published
+    procedure TestEmpty;
+    procedure TestSmallString;
+    procedure TestLargeString;
+    procedure TestEmptyBase64;
+    procedure TestSmallBase64;
+    procedure TestSmallHMAC;
+    procedure TestHMACStream;
+  end;
+
+
+implementation
+
+uses
+  basenenc;
+
+{ TTestSHA512 }
+
+procedure TTestSHA512.TestHexString(const aString, aDigest: String);
+var
+  Digest : AnsiString;
+  S : TBytes;
+
+begin
+  S:=[];
+  Digest:='';
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  TSHA512.DigestHexa(S, Digest);
+  AssertEquals('Correct hex digest',aDigest, Digest);
+end;
+
+procedure TTestSHA512.TestBase64String(const aString, aDigest: String);
+var
+  Digest : AnsiString;
+  S : TBytes;
+
+begin
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  Digest:='';
+  TSHA512.DigestBase64(S,False,Digest);
+  AssertEquals('Correct base64 digest',aDigest, Digest);
+end;
+
+procedure TTestSHA512.TestHMACString(const aString, aKey, aDigest: String);
+var
+  Digest : AnsiString;
+  S,K : TBytes;
+
+begin
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  K:=TEncoding.UTF8.GetAnsiBytes(aKey);
+  TSHA512.HMACHexa(K,S,Digest);
+  AssertEquals('Correct base64 digest',aDigest, Digest);
+end;
+
+
+const
+  Empty512Hash = 'CF83E1357EEFB8BDF1542850D66D8007D620E4050B5715DC83F4A921D36CE9CE47D0D13C5D85F2B0FF8318D2877EEC2F63B931BD47417A81A538327AF927DA3E';
+  // Taken from DCPCrypt
+  Test1Out: array[0..63] of byte=
+    ($dd,$af,$35,$a1,$93,$61,$7a,$ba,$cc,$41,$73,$49,$ae,$20,$41,$31,
+     $12,$e6,$fa,$4e,$89,$a9,$7e,$a2,$0a,$9e,$ee,$e6,$4b,$55,$d3,$9a,
+     $21,$92,$99,$2a,$27,$4f,$c1,$a8,$36,$ba,$3c,$23,$a3,$fe,$eb,$bd,
+     $45,$4d,$44,$23,$64,$3c,$e8,$0e,$2a,$9a,$c9,$4f,$a5,$4c,$a4,$9f);
+  Test2Out: array[0..63] of byte=
+    ($8e,$95,$9b,$75,$da,$e3,$13,$da,$8c,$f4,$f7,$28,$14,$fc,$14,$3f,
+     $8f,$77,$79,$c6,$eb,$9f,$7f,$a1,$72,$99,$ae,$ad,$b6,$88,$90,$18,
+     $50,$1d,$28,$9e,$49,$00,$f7,$e4,$33,$1b,$99,$de,$c4,$b5,$43,$3a,
+     $c7,$d3,$29,$ee,$b6,$dd,$26,$54,$5e,$96,$e5,$5b,$87,$4b,$e9,$09);
+
+
+procedure TTestSHA512.TestEmpty;
+begin
+  TestHexString('',Empty512Hash);
+end;
+
+procedure TTestSHA512.TestSmallString;
+
+Var
+  S : String;
+begin
+  BytesToHexStr(S,@Test1Out,SizeOf(Test1Out));
+  TestHexString('abc',S);
+end;
+
+procedure TTestSHA512.TestLargeString;
+Var
+  S : String;
+begin
+  BytesToHexStr(S,@Test2Out,SizeOf(Test2Out));
+  TestHexString('abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu',S);
+end;
+
+procedure TTestSHA512.TestEmptyBase64;
+
+begin
+  TestBase64String('',Base64.Encode(Base16.Decode(Empty512Hash),False));
+end;
+
+procedure TTestSHA512.TestSmallBase64;
+begin
+  TestBase64String('abc',Base64.Encode(@Test1out,SizeOf(Test1Out),False));
+end;
+
+procedure TTestSHA512.TestSmallHMAC;
+
+// Consts taken from HashlibTestBase
+
+Const
+  Expected = 'DEDFCEAD40225068527D0E53B7C892226E188891D939E21A0777A40EA2E29D7233638C178C879F26088A502A887674C01DF61EAF1635D707D114097ED1D0D762';
+  DefaultData = 'HashLib4Pascal';
+
+begin
+  TestHMACString(DefaultData,'Hash' ,Expected);
+end;
+
+procedure TTestSHA512.TestHMACStream;
+
+Var
+  S : TStringStream;
+  res : String;
+
+begin
+  BytesToHexStr(Res,@Test1Out,SizeOf(Test1Out));
+  S:=TStringStream.Create('abc');
+  try
+    AssertEquals('Correct hash',Res,TSHA512.StreamHexa(S));
+  finally
+    S.Free;
+  end;
+end;
+
+
+{ TTestSHA384 }
+
+procedure TTestSHA384.TestHexString(const aString, aDigest: String);
+var
+  Digest : AnsiString;
+  S : TBytes;
+
+begin
+  S:=[];
+  Digest:='';
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  TSHA384.DigestHexa(S, Digest);
+  AssertEquals('Correct hex digest',aDigest, Digest);
+end;
+
+procedure TTestSHA384.TestBase64String(const aString, aDigest: String);
+var
+  Digest : AnsiString;
+  S : TBytes;
+
+begin
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  Digest:='';
+  TSHA384.DigestBase64(S,False,Digest);
+  AssertEquals('Correct base64 digest',aDigest, Digest);
+end;
+
+procedure TTestSHA384.TestHMACString(const aString, aKey, aDigest: String);
+var
+  Digest : AnsiString;
+  S,K : TBytes;
+
+begin
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  K:=TEncoding.UTF8.GetAnsiBytes(aKey);
+  TSHA384.HMACHexa(K,S,Digest);
+  AssertEquals('Correct base64 digest',aDigest, Digest);
+end;
+
+const
+  Empty384Hash = '38B060A751AC96384CD9327EB1B1E36A21FDB71114BE07434C0CC7BF63F6E1DA274EDEBFE76F65FBD51AD2F14898B95B';
+  Test1Out384: array[0..47] of byte=
+    ($cb,$00,$75,$3f,$45,$a3,$5e,$8b,$b5,$a0,$3d,$69,$9a,$c6,$50,$07,
+     $27,$2c,$32,$ab,$0e,$de,$d1,$63,$1a,$8b,$60,$5a,$43,$ff,$5b,$ed,
+     $80,$86,$07,$2b,$a1,$e7,$cc,$23,$58,$ba,$ec,$a1,$34,$c8,$25,$a7);
+  Test2Out384: array[0..47] of byte=
+    ($09,$33,$0c,$33,$f7,$11,$47,$e8,$3d,$19,$2f,$c7,$82,$cd,$1b,$47,
+     $53,$11,$1b,$17,$3b,$3b,$05,$d2,$2f,$a0,$80,$86,$e3,$b0,$f7,$12,
+     $fc,$c7,$c7,$1a,$55,$7e,$2d,$b9,$66,$c3,$e9,$fa,$91,$74,$60,$39);
+
+procedure TTestSHA384.TestEmpty;
+begin
+  TestHexString('',Empty384Hash);
+end;
+
+procedure TTestSHA384.TestSmallString;
+Var
+  S : String;
+begin
+  BytesToHexStr(S,@Test1Out384,SizeOf(Test1Out384));
+  TestHexString('abc',S);
+end;
+
+procedure TTestSHA384.TestLargeString;
+Var
+  S : String;
+begin
+  BytesToHexStr(S,@Test2Out384,SizeOf(Test2Out384));
+  TestHexString('abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu',S);
+end;
+
+procedure TTestSHA384.TestEmptyBase64;
+
+begin
+  TestBase64String('',Base64.Encode(Base16.Decode(Empty384Hash),False));
+end;
+
+procedure TTestSHA384.TestSmallBase64;
+begin
+  TestBase64String('abc',Base64.Encode(@Test1out384,SizeOf(Test1Out384),False));
+end;
+
+procedure TTestSHA384.TestSmallHMAC;
+
+// Consts taken from HashlibTestBase
+
+Const
+  Expected = '3D6DCED731DAF3599CC0971646C1A8B8CCC61650722F111A9EB26CE7B65189EB220EACB09152D9A09065099FE6C1FDC9';
+  DefaultData = 'HashLib4Pascal';
+
+begin
+  TestHMACString(DefaultData,'Hash' ,Expected);
+end;
+
+procedure TTestSHA384.TestHMACStream;
+
+Var
+  S : TStringStream;
+  res : String;
+
+begin
+  BytesToHexStr(Res,@Test1Out384,SizeOf(Test1Out384));
+  S:=TStringStream.Create('abc');
+  try
+    AssertEquals('Correct hash',Res,TSHA384.StreamHexa(S));
+  finally
+    S.Free;
+  end;
+end;
+
+
+
+initialization
+  RegisterTests([TTestSHA512,TTestSHA384]);
+end.
+