unit Sparkle.Middleware.BasicAuth;

{$I sparkle.inc}

interface

uses
  System.Classes,
  Sparkle.HttpServer.Module,
  Sparkle.HttpServer.Context,
  Sparkle.Security;

type
  IUserIdentity = Sparkle.Security.IUserIdentity;
  TUserIdentity = Sparkle.Security.TUserIdentity;

  IBasicAuthMiddleware = interface(IHttpServerMiddleware)
  ['{84754A6B-5BE8-4C71-A40E-153F8EDD7BC1}']
  end;

  TAuthenticateBasicProc = reference to procedure(const UserName, Password: string;
    var User: IUserIdentity);

  TBasicAuthMiddleware = class(THttpServerMiddleware, IBasicAuthMiddleware)
  private
    const DefaultRealm = 'TMS Sparkle Server';
  private
    FRealm: string;
    FOnAuthenticate: TAuthenticateBasicProc;
    function GetRealm: string;
    procedure SetRealm(const Value: string);
  protected
    function RetrieveIdentity(const UserName, Password: string): IUserIdentity; virtual;
    procedure DoAuthenticate(const UserName, Password: string; var User: IUserIdentity); virtual;
    procedure ProcessRequest(Context: THttpServerContext; Next: THttpServerProc); override;
  public
    constructor Create; overload;
    constructor Create(AAuthenticateProc: TAuthenticateBasicProc); overload;
    constructor Create(AAuthenticateProc: TAuthenticateBasicProc; const ARealm: string); overload;
    property Realm: string read GetRealm write SetRealm;
    property OnAuthenticate: TAuthenticateBasicProc read FOnAuthenticate write FOnAuthenticate;
  end;

implementation

uses
  System.SysUtils,
  Sparkle.Utils;

{ TBasicAuthMiddleware }

constructor TBasicAuthMiddleware.Create;
begin
  Create(nil);
end;

constructor TBasicAuthMiddleware.Create(AAuthenticateProc: TAuthenticateBasicProc);
begin
  Create(AAuthenticateProc, DefaultRealm);
end;

constructor TBasicAuthMiddleware.Create(AAuthenticateProc: TAuthenticateBasicProc;
  const ARealm: string);
begin
  OnAuthenticate := AAuthenticateProc;
  Realm := ARealm;
end;

procedure TBasicAuthMiddleware.DoAuthenticate(const UserName, Password: string;
  var User: IUserIdentity);
begin
  if Assigned(FOnAuthenticate) then
    FOnAuthenticate(UserName, Password, User);
end;

function TBasicAuthMiddleware.GetRealm: string;
begin
  Result := FRealm;
end;

procedure TBasicAuthMiddleware.ProcessRequest(Context: THttpServerContext; Next: THttpServerProc);
var
  Auth: string;
  P: integer;
  UserName, Password: string;
begin
  if Context.Request.User = nil then
  begin
    Auth := Context.Request.Headers.Get('authorization');
    if (Auth <> '') and SameText('Basic ', Copy(Auth, 1, 6)) then
    begin
      Auth := TEncoding.UTF8.GetString(TSparkleUtils.DecodeBase64(Copy(Auth, 7, MaxInt)));
      P := Pos(':', Auth);
      if P > 0 then
      begin
        UserName := Copy(Auth, 1, P - 1);
        Password := Copy(Auth, P + 1, MaxInt);
        Context.Request.User := RetrieveIdentity(UserName, Password);
      end;
    end;
  end;

  Context.Response.OnHeaders(
    procedure(Response: THttpServerResponse)
    var
      Challenge: string;
    begin
      if Response.StatusCode <> 401 then
        Exit;
      if Response.Headers.Exists('www-authenticate') then
        Exit;

      Challenge := 'Basic';
      if Realm <> '' then
        Challenge := Challenge + ' realm="' + Realm + '"';
      Response.Headers.SetValue('www-authenticate', Challenge);
    end
  );

  Next(Context);
end;

procedure TBasicAuthMiddleware.SetRealm(const Value: string);
begin
  FRealm := Value;
end;

function TBasicAuthMiddleware.RetrieveIdentity(const UserName,
  Password: string): IUserIdentity;
begin
  Result := nil;
  DoAuthenticate(UserName, Password, Result);
end;

end.
