unit Sparkle.Security;

{$I sparkle.inc}

interface

uses
  Generics.Collections, System.SysUtils, System.Rtti,
  Bcl.Json.Classes,
  Bcl.Utils;

type
  EClaimValueInvalidCast = class(Exception);

  TUserClaim = class
  strict private
    FName: string;
    FIntData: TValue;
    procedure SetData(const AValue: TValue);
  protected
    property Data: TValue read FIntData write SetData;
  public
    constructor Create(const AName: string);
    destructor Destroy; override;
  private
    function GetAsString: string;
    procedure SetAsString(const Value: string);
    function GetAsBoolean: Boolean;
    procedure SetAsBoolean(const Value: Boolean);
    function GetAsInt64: Int64;
    procedure SetAsInt64(const Value: Int64);
    function GetAsDouble: double;
    procedure SetAsDouble(const Value: double);
    function GetAsEpoch: TDateTime;
    procedure SetAsEpoch(const Value: TDateTime);
    function GetAsJson: TJElement;
  public
    procedure SetJElement(Value: TJElement);
    property Name: string read FName;
    property AsString: string read GetAsString write SetAsString;
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
    property AsDouble: Double read GetAsDouble write SetAsDouble;
    property AsEpoch: TDateTime read GetAsEpoch write SetAsEpoch;
    property AsJson: TJElement read GetAsJson;
  end;

  TUserClaims = class
  private
    FClaims: TDictionary<string, TUserClaim>;
    function GetItem(const Name: string): TUserClaim;
  public
    constructor Create;
    destructor Destroy; override;
    function AddOrSet(Claim: TUserClaim): TUserClaim; overload;
    function AddOrSet(const Name: string): TUserClaim; overload;
    function AddOrSet(const Name, Value: string): TUserClaim; overload;
    function Exists(const Name: string): Boolean;
    function Find(const Name: string): TUserClaim;
    procedure Remove(const Name: string);
    function GetEnumerator: TEnumerator<TUserClaim>;
    property Items[const Name: string]: TUserClaim read GetItem; default;
  end;

  IUserIdentity = interface
  ['{2D715C56-B149-4327-BB03-FB0247E6E647}']
    function Claims: TUserClaims;
  end;

  TUserIdentity = class(TInterfacedObject, IUserIdentity)
  private
    FClaims: TUserClaims;
  public
    constructor Create;
    destructor Destroy; override;
    function Claims: TUserClaims;
  end;

  EEmptyClaimName = class(Exception)
  public
    constructor Create;
  end;

implementation

uses
  System.DateUtils;

{ EClaimName }

constructor EEmptyClaimName.Create;
begin
  inherited Create('Claim name cannot be empty');
end;

{ TUserClaims }

function TUserClaims.AddOrSet(Claim: TUserClaim): TUserClaim;
begin
  if Claim.Name = '' then
    raise EEmptyClaimName.Create;
  FClaims.AddOrSetValue(Claim.Name, Claim);
  Result := Claim;
end;

function TUserClaims.AddOrSet(const Name, Value: string): TUserClaim;
begin
  Result := AddOrSet(TUserClaim.Create(Name));
  Result.AsString := Value;
end;

function TUserClaims.AddOrSet(const Name: string): TUserClaim;
begin
  Result := AddOrSet(TUserClaim.Create(Name));
end;

constructor TUserClaims.Create;
begin
  FClaims := TObjectDictionary<string, TUserClaim>.Create([doOwnsValues]);
end;

destructor TUserClaims.Destroy;
begin
  FClaims.Free;
  inherited;
end;

function TUserClaims.Exists(const Name: string): Boolean;
begin
  Result := Find(Name) <> nil;
end;

function TUserClaims.Find(const Name: string): TUserClaim;
begin
  if not FClaims.TryGetValue(Name, Result) then
    Result := nil;
end;

function TUserClaims.GetEnumerator: TEnumerator<TUserClaim>;
begin
  Result := FClaims.Values.GetEnumerator;
end;

function TUserClaims.GetItem(const Name: string): TUserClaim;
begin
  Result := FClaims[Name];
end;

procedure TUserClaims.Remove(const Name: string);
begin
  FClaims.Remove(Name);
end;

{ TUserClaim }

procedure TUserClaim.SetData(const AValue: TValue);
begin
  {$IFNDEF AUTOREFCOUNT}
  if FIntData.IsInstanceOf(TJElement) and (FIntData.AsObject <> AValue.AsObject) then
    FIntData.AsObject.Free;
  {$ENDIF}
  FIntData := AValue;
end;

procedure TUserClaim.SetJElement(Value: TJElement);
begin
  if Value.IsBoolean then
    AsBoolean := Value.AsBoolean
  else
  if Value.IsInteger or Value.IsInt64 then
    AsInt64 := Value.AsInt64
  else
  if Value.IsDouble then
    AsDouble := Value.AsDouble
  else
  if Value.IsNull then
    Data := TValue.Empty
  else
  if Value.IsString then
    AsString := Value.AsString
  else
  begin
    Data := Value;
    Value := nil;
  end;
  Value.Free;
end;

constructor TUserClaim.Create(const AName: string);
begin
  if AName = '' then
    raise EEmptyClaimName.Create;
  FName := AName;
end;

destructor TUserClaim.Destroy;
begin
  Data := nil;
  inherited;
end;

function TUserClaim.GetAsBoolean: Boolean;
begin
  Result := Data.AsBoolean;
end;

function TUserClaim.GetAsDouble: double;
begin
  Result := Data.AsExtended;
end;

function TUserClaim.GetAsEpoch: TDateTime;
var
  Value: Int64;
begin
  Value := AsInt64;
  if Value = 0 then
    Result := 0
  else
    Result := TTimeZone.Local.ToLocalTime(UnixToDateTime(Value));
end;

function TUserClaim.GetAsInt64: Int64;
begin
  Result := Data.AsInt64;
end;

function TUserClaim.GetAsJson: TJElement;
begin
  Result := Data.AsType<TJElement>;
end;

function TUserClaim.GetAsString: string;
begin
  Result := Data.AsString;
end;

procedure TUserClaim.SetAsBoolean(const Value: Boolean);
begin
  Data := Value;
end;

procedure TUserClaim.SetAsDouble(const Value: double);
begin
  Data := Value;
end;

procedure TUserClaim.SetAsEpoch(const Value: TDateTime);
begin
  AsInt64 := DateTimeToUnix(TTimeZone.Local.ToUniversalTime(Value));
end;

procedure TUserClaim.SetAsInt64(const Value: Int64);
begin
  Data := Value;
end;

procedure TUserClaim.SetAsString(const Value: string);
begin
  Data := Value;
end;

{ TUserIdentity }

function TUserIdentity.Claims: TUserClaims;
begin
  Result := FClaims;
end;

constructor TUserIdentity.Create;
begin
  FClaims := TUserClaims.Create;
end;

destructor TUserIdentity.Destroy;
begin
  FClaims.Free;
  inherited;
end;

end.
