unit Sparkle.Middleware.Cors;

interface

uses
  Sparkle.HttpServer.Module,
  Sparkle.HttpServer.Context;

type
  TCorsMiddleware = class(THttpServerMiddleware, IHttpServerMiddleware)
  private
    FOrigin: string;
    FMethods: string;
    FMaxAge: Integer;
    FIncludeMaxAge: Boolean;
    procedure ProcessAllowOrigin(Context: THttpServerContext);
    procedure ProcessAllowMethods(Context: THttpServerContext);
    procedure ProcessAllowHeaders(Context: THttpServerContext);
    procedure ProcessMaxAge(Context: THttpServerContext);
  protected
    procedure ProcessRequest(Context: THttpServerContext; Next: THttpServerProc); override;
  public
    constructor Create(const AOrigin: string = ''; const AMethods: string = ''); overload;
    constructor Create(const AOrigin, AMethods: string; AMaxAge: Integer); overload;
    property Origin: string read FOrigin write FOrigin;
    property Methods: string read FMethods write FMethods;
    property MaxAge: Integer read FMaxAge write FMaxAge;
    property IncludeMaxAge: Boolean read FIncludeMaxAge write FIncludeMaxAge;
  end;

implementation

uses
  System.SysUtils;

{ TCorsMiddleware }

constructor TCorsMiddleware.Create(const AOrigin, AMethods: string;
  AMaxAge: Integer);
begin
  Create(AOrigin, AMethods);
  IncludeMaxAge := True;
  MaxAge := AMaxAge;
end;

constructor TCorsMiddleware.Create(const AOrigin, AMethods: string);
begin
  FOrigin := AOrigin;
  FMethods := AMethods;
end;

procedure TCorsMiddleware.ProcessAllowHeaders(Context: THttpServerContext);
var
  CorsRequestHeaders: string;
begin
  CorsRequestHeaders := Context.Request.Headers.Get('Access-Control-Request-Headers');
  if (CorsRequestHeaders <> '') then
  begin
    Context.Response.Headers.SetValue('Access-Control-Allow-Headers', CorsRequestHeaders);
    Context.Response.Headers.AddValue('Vary', 'Access-Control-Request-Headers');
  end;
end;

procedure TCorsMiddleware.ProcessAllowMethods(Context: THttpServerContext);
var
  RequestMethod: string;
begin
  if Methods <> '' then
    Context.Response.Headers.SetValue('Access-Control-Allow-Methods', Methods)
  else
  begin
    RequestMethod := Context.Request.Headers.Get('Access-Control-Request-Method');
    if RequestMethod <> '' then
      Context.Response.Headers.SetValue('Access-Control-Allow-Methods', RequestMethod);
  end;
end;

procedure TCorsMiddleware.ProcessAllowOrigin(Context: THttpServerContext);
begin
  if (Origin = '') or (Origin = '*') then
    Context.Response.Headers.SetValue('Access-Control-Allow-Origin', '*')
  else
    Context.Response.Headers.SetValue('Access-Control-Allow-Origin', Origin);
end;

procedure TCorsMiddleware.ProcessMaxAge(Context: THttpServerContext);
begin
  if FIncludeMaxAge then
    COntext.Response.Headers.SetValue('Access-Control-Max-Age', IntToStr(MaxAge));
end;

procedure TCorsMiddleware.ProcessRequest(Context: THttpServerContext; Next: THttpServerProc);
begin
  if Context.Request.MethodType = THttpMethod.Options then
  begin
    ProcessAllowOrigin(Context);
    ProcessAllowMethods(Context);
    ProcessAllowHeaders(Context);
    ProcessMaxAge(Context);
    Context.Response.StatusCode := 200;
  end
  else
  begin
    ProcessAllowOrigin(Context);
    Next(Context);
  end;
end;

end.
