+ Quick.OAuth units

+ Quick.OAuth and Quick.OAuth.Utils

Quick.OAuth.Utils.pas

@@ -0,0 +1,116 @@
+unit Quick.OAuth.Utils;
+
+interface
+
+type
+  TRequestMethod = (rmGET, rmPOST);
+
+function EncodeURL (const aURL: string): string;
+procedure OpenURL (const aURL: string);
+
+function GetDomain (const aURL: string): string;
+function GetPort (const aURL: string): integer;
+
+function GetMethodFromRequest (const aRequest: string): TRequestMethod;
+function GetCleanRequest (const aRequest: string): string;
+
+
+implementation
+
+uses
+  {$IFDEF MSWINDOWS}
+  WinApi.ShellAPI,
+  Winapi.Windows,
+  {$ENDIF}
+  System.SysUtils,
+  System.Types, System.Classes, System.StrUtils;
+
+{$I QuickLib.INC}
+
+function EncodeURL (const aURL: string): string;
+var
+  bArray: TBytes;
+  c: Char;
+  b: byte;
+begin
+  result:='';
+  bArray := TEncoding.UTF8.GetBytes(aURL);
+  for b in bArray do
+  begin
+    c := Chr(b);
+    case c of
+      'A'..'Z',
+      'a'..'z',
+      '0'..'9',
+           '-',
+           '_',
+           '.': result := result + c
+    else
+      result:= result + '%' + IntToHex(Ord(b),2);
+    end;
+  end;
+end;
+
+procedure OpenURL (const aURL: string);
+begin
+  {$IFDEF MSWINDOWS}
+  ShellExecute(0,PChar('open'),PChar(aURL),PChar(''),PChar(''), SW_NORMAL);
+  {$ELSE}
+    raise Exception.Create('OpenURL not implemented yet');
+  {$ENDIF}
+end;
+
+function GetDomain (const aURL: string): string;
+{$IFDEF DELPHIXE3_UP}
+var
+  parts: TStringDynArray;
+begin
+  result:=aURL;
+  parts:=aURL.Split([':']);
+  if Length(parts) > 1 then
+    result:=parts[1].Replace('/', '');
+{$ELSE}
+begin
+  raise Exception.Create('Not implemented yet');
+{$ENDIF}
+end;
+
+function GetPort (const aURL: string): integer;
+{$IFDEF DELPHIXE3_UP}
+var
+  parts: TStringDynArray;
+begin
+  result:=80;
+  parts:=aURL.Split([':']);
+  if Length(parts) > 1 then
+    TryStrToInt(parts[High(parts)].Replace('/', ''), result);
+{$ELSE}
+begin
+  raise Exception.Create('Not implemented yet');
+{$ENDIF}
+end;
+
+function GetMethodFromRequest (const aRequest: string): TRequestMethod;
+begin
+  result:=rmGET;
+  if aRequest.Trim = '' then
+    Exit;
+  case IndexStr(aRequest.Split([' '])[0].ToUpper, ['GET', 'POST']) of
+    0: result:=rmGET;
+    1: result:=rmPOST;
+  end;
+end;
+
+function GetCleanRequest (const aRequest: string): string;
+var
+  parts: TStringDynArray;
+begin
+  result:=aRequest;
+  if aRequest.Trim = '' then
+    Exit;
+  parts:=aRequest.Split([' ']);
+  if Length(parts) > 1 then
+    result:=parts[1];
+end;
+
+end.

Quick.OAuth.pas

@@ -0,0 +1,277 @@
+unit Quick.OAuth;
+
+interface
+
+uses
+  Quick.HttpClient,
+  Quick.HttpServer.Request,
+  Quick.HttpServer.Response,
+  Quick.HttpServer,
+  Quick.Threads,
+  Quick.OAuth.Utils,
+  SysUtils;
+
+type
+  TOAuthToken = class
+  private
+    fAccessTokenExpiration: integer;
+    fAccessToken: string;
+    fRefreshToken: string;
+    fRetrieveDateTime: TDateTime;
+  public
+    property AccessToken: string read fAccessToken write fAccessToken;
+    property AccessTokenExpiration: integer read fAccessTokenExpiration write
+        fAccessTokenExpiration;
+    property RefreshToken: string read fRefreshToken write fRefreshToken;
+    property RetrieveDateTime: TDateTime read fRetrieveDateTime write
+        fRetrieveDateTime;
+  end;
+
+  TOnSaveToken = procedure (const aToken: TOAuthToken) of object;
+  TOnLoadToken = procedure (var aToken: TOAuthToken) of object;
+  TOnAuthorizationCompleted = reference to procedure (const aToken: TOAuthToken);
+  TOnRefreshCompleted = reference to procedure (const aToken: TOAuthToken);
+
+  {$M+}
+  TOAuthBase = class
+  private
+    fToken: TOAuthToken;
+    fOnAuthorizationCompleted: TOnAuthorizationCompleted;
+    fOnRefreshCompleted: TOnRefreshCompleted;
+
+    fAccessTokenParam: string;
+    fAuthCodeParam: string;
+    fAuthErrorParam: string;
+    fExpirationParam: string;
+    fRefreshTokenParam: string;
+
+    fCallbackURL: string;
+    fServer: THttpServer;
+    fClient: TJsonHttpClient;
+
+    fOnSaveToken: TOnSaveToken;
+    fOnLoadToken: TOnLoadToken;
+
+    procedure ExchangeAuthForAccessToken (const aAuthToken: string);
+    procedure RefreshAccessToken (const aRefreshToken: string);
+    function GetAccessToken: string;
+    function IsTokenValid: boolean;
+  protected
+    // Abstract
+    function CreateAuthorizationRequest: string; virtual; abstract;
+    function CreateAuthToAccessRequest (const aAuthToken: string): string; virtual; abstract;
+    function CreateRefreshRequest (const aRefreshToken: string): string; virtual; abstract;
+
+    // Available
+    function CreateAuthorizationHTMLPage (const aAuthorised: boolean): string; virtual;
+    procedure OnProcessRequest(aRequest: IHttpRequest; aResponse: IHttpResponse); virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    // Methods
+    procedure Authorize(const aOnAuthorizationCompleted: TOnAuthorizationCompleted = nil);
+    procedure RefreshToken (const aOnRefreshCompleted: TOnRefreshCompleted = nil);
+    // Properties
+    property AccessTokenParam: string read fAccessTokenParam write
+        fAccessTokenParam;
+    property AuthCodeParam: string read fAuthCodeParam write fAuthCodeParam;
+    property AuthErrorParam: string read fAuthErrorParam write fAuthErrorParam;
+    property ExpirationParam: string read fExpirationParam write fExpirationParam;
+    property RefreshTokenParam: string read fRefreshTokenParam write
+        fRefreshTokenParam;
+
+    property CallbackURL: string read fCallbackURL write fCallbackURL;
+    property AccessToken: string read GetAccessToken;
+  published
+    // Events
+    property OnSaveToken: TOnSaveToken read fOnSaveToken write fOnSaveToken;
+    property OnLoadToken: TOnLoadToken read fOnLoadToken write fOnLoadToken;
+  end;
+  {$M-}
+
+  EOAuthException = class (Exception);
+
+implementation
+
+uses
+ System.JSON, System.DateUtils, System.Types;
+
+{$I QuickLib.INC}
+
+constructor TOAuthBase.Create;
+begin
+  inherited Create;
+  fClient:=TJsonHttpClient.Create;
+  {$IFNDEF DELPHIRX101_UP}
+  fServer:=nil;
+  {$ENDIF}
+  fToken:=TOAuthToken.Create;
+  fToken.AccessToken:='';
+  fToken.AccessTokenExpiration:=0;
+  fToken.RefreshToken:='';
+  fToken.RetrieveDateTime:=EncodeDateTime(1900, 1, 1, 23, 59, 00, 00);
+end;
+
+function TOAuthBase.CreateAuthorizationHTMLPage(
+  const aAuthorised: boolean): string;
+begin
+  if aAuthorised then
+    result:='Access Authorised! You can now close this page and return to the application'
+  else
+    result:='Access Denied!';
+end;
+
+destructor TOAuthBase.Destroy;
+begin
+  fClient.Free;
+  fServer.Free;
+  fToken.Free;
+  inherited;
+end;
+
+procedure TOAuthBase.ExchangeAuthForAccessToken(const aAuthToken: string);
+var
+  resp: IHttpRequestResponse;
+  accToken: string;
+  refrToken: string;
+  expiry: integer;
+begin
+  fToken.AccessToken:='';
+  fToken.AccessTokenExpiration:=0;
+  try
+    case GetMethodFromRequest(CreateAuthToAccessRequest(aAuthToken)) of
+      rmGET: resp:=fClient.Get(GetCleanRequest(CreateAuthToAccessRequest(aAuthToken)));
+      rmPOST: resp:=fClient.Post(GetCleanRequest(CreateAuthToAccessRequest(aAuthToken)), '');
+    end;
+    if (assigned(resp)) and (resp.StatusCode = 200) then
+    begin
+      if Assigned(resp.Response) then
+      begin
+        if resp.Response.TryGetValue(AccessTokenParam, accToken) then
+          fToken.AccessToken:=accToken;
+        if resp.Response.TryGetValue(ExpirationParam, expiry) then
+          fToken.AccessTokenExpiration:=expiry;
+        if resp.Response.TryGetValue(RefreshTokenParam, refrToken) then
+          fToken.RefreshToken:=refrToken;
+        fToken.RetrieveDateTime:=Now;
+        if Assigned(fOnSaveToken) then
+          fOnSaveToken(fToken);
+        if Assigned(fOnAuthorizationCompleted) then
+          fOnAuthorizationCompleted(fToken);
+      end;
+    end
+    else
+      raise EOAuthException.Create('Something went wrong. Please try again');
+  except
+    raise EOAuthException.Create('Something went wrong. Please try again');
+  end;
+end;
+
+procedure TOAuthBase.OnProcessRequest(aRequest: IHttpRequest;
+  aResponse: IHttpResponse);
+begin
+  fToken.AccessToken:='';
+  fToken.AccessTokenExpiration:=0;
+  if aRequest.UnparsedParams.Contains(AuthErrorParam) then
+    aResponse.ContentText:= CreateAuthorizationHTMLPage(false)
+  else
+  if aRequest.UnparsedParams.Contains(AuthCodeParam) then
+  begin
+    ExchangeAuthForAccessToken(aRequest.Query[AuthCodeParam].AsString);
+    aResponse.ContentText:= CreateAuthorizationHTMLPage(true);
+  end;
+end;
+
+procedure TOAuthBase.RefreshAccessToken(const aRefreshToken: string);
+var
+  resp: IHttpRequestResponse;
+  accToken: string;
+  expiry: integer;
+begin
+  try
+    case GetMethodFromRequest(CreateRefreshRequest(aRefreshToken)) of
+      rmGET: resp:=fClient.Get(GetCleanRequest(CreateRefreshRequest(aRefreshToken)));
+      rmPOST: resp:=fClient.Post(GetCleanRequest(CreateRefreshRequest(aRefreshToken)), '');
+    end;
+    if (assigned(resp)) and (resp.StatusCode = 200) then
+    begin
+      if Assigned(resp.Response) then
+      begin
+        if resp.Response.TryGetValue(AccessTokenParam, accToken) then
+          fToken.AccessToken:=accToken;
+        if resp.Response.TryGetValue(ExpirationParam, expiry) then
+          fToken.AccessTokenExpiration:=expiry;
+        fToken.RetrieveDateTime:=Now;
+        if Assigned(fOnSaveToken) then
+          fOnSaveToken(fToken);
+      end;
+    end
+    else
+      raise EOAuthException.Create('Something went wrong. Please try again');
+  except
+    raise EOAuthException.Create('Something went wrong. Please try again');
+  end;
+end;
+
+procedure TOAuthBase.RefreshToken(const aOnRefreshCompleted:
+    TOnRefreshCompleted = nil);
+begin
+  fOnRefreshCompleted:=aOnRefreshCompleted;
+  if Assigned(fOnLoadToken) then
+    fOnLoadToken(fToken);
+  if fToken.AccessToken = '' then
+    Authorize(TOnAuthorizationCompleted(fOnRefreshCompleted))
+  else
+  begin
+    GetAccessToken;
+    if Assigned(fOnRefreshCompleted) then
+      fOnRefreshCompleted(fToken);
+  end;
+end;
+
+procedure TOAuthBase.Authorize(const aOnAuthorizationCompleted:
+    TOnAuthorizationCompleted = nil);
+begin
+  fOnAuthorizationCompleted:=aOnAuthorizationCompleted;
+  if Assigned(fOnLoadToken) then
+    fOnLoadToken(fToken);
+
+  if IsTokenValid then
+    Exit;
+
+  fClient:=TJsonHttpClient.Create;
+  if Assigned(fServer) then
+    fServer.Stop;
+  FreeAndNil(fServer);
+
+  fServer:=THttpServer.Create(GetDomain(fCallbackURL), GetPort(fCallbackURL), false, nil);
+  try
+    fServer.OnNewRequest:=OnProcessRequest;
+    fServer.Start;
+
+    OpenURL(GetCleanRequest(CreateAuthorizationRequest));
+  except
+    fServer.Stop;
+    FreeAndNil(fServer);
+  end;
+end;
+
+function TOAuthBase.GetAccessToken: string;
+begin
+  result:='';
+  if IsTokenValid then
+    result:=fToken.AccessToken
+  else
+    RefreshAccessToken(fToken.RefreshToken);
+end;
+
+function TOAuthBase.IsTokenValid: boolean;
+var
+  expDate: TDateTime;
+begin
+  expDate:=IncSecond(fToken.RetrieveDateTime, fToken.AccessTokenExpiration);
+  result:= CompareDateTime(expDate, Now) = GreaterThanValue;
+end;
+
+end.