program OAuth2AuthCodeFlowTest;
{$mode objfpc}{$H+}
uses
Classes, SysUtils,
// fcl-net units
fphttpclient,
// fcl-web units
fphttpserver, httpdefs, httpprotocol,
// fcl-base units
fpjson, jsonparser;
const
// --- CONFIGURATION ---
AuthEndpoint = 'https://your-identity-provider.com/oauth2/authorize';
TokenEndpoint = 'https://your-identity-provider.com/oauth2/token';
ClientId = 'your_client_id';
ClientSecret = 'your_client_secret';
RedirectUri = 'http://127.0.0.1:8080/callback';
ListenPort = 8080;
Scope = 'openid profile email';
// 1. TYPE DECLARATIONS MUST COME BEFORE VARIABLES THAT USE THEM
type
TCallbackHandler = class
public
procedure HandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);
end;
var
ReceivedCode: string = '';
ReceivedState: string = '';
ExpectedState: string;
AccessToken: string = '';
AuthURL: string;
Server: TFPHTTPServer;
Handler: TCallbackHandler; // Now the compiler knows what TCallbackHandler is
// Generates a random string for the 'state' parameter to prevent CSRF
function GenerateRandomString(ALength: Integer): string;
const
Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789';
var
I: Integer;
begin
Result := '';
for I := 1 to ALength do
Result := Result + Chars[Random(Length(Chars)) + 1];
end;
// HTTP Request Handler for the local callback server
procedure TCallbackHandler.HandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);
begin
if ARequest.URL = '/callback' then
begin
ReceivedCode := ARequest.QueryFields.Values['code'];
ReceivedState := ARequest.QueryFields.Values['state'];
AResponse.Code := 200;
AResponse.ContentType := 'text/html';
if (ReceivedCode <> '') and (ReceivedState = ExpectedState) then
begin
AResponse.Content := '<html><body><h2 style="color:green;">Authentication Successful!</h2>' +
'<p>You can close this window and return to the console.</p></body></html>';
end
else
begin
AResponse.Content := '<html><body><h2 style="color:red;">Authentication Failed!</h2>' +
'<p>State mismatch or missing code.</p></body></html>';
ReceivedCode := ''; // Invalidate code if state fails
end;
// Stop the server to unblock the main thread
TFPHTTPServer(Sender).Active := False;
end
else
begin
AResponse.Code := 404;
AResponse.Content := 'Not Found';
end;
end;
// Exchanges the Authorization Code for an Access Token using fcl-net
procedure ExchangeCodeForToken;
var
Client: TFPHTTPClient;
PostData: TStringList;
Response: string;
JSONData: TJSONData;
JSONObject: TJSONObject;
begin
Client := TFPHTTPClient.Create(nil);
PostData := TStringList.Create;
try
Client.AddHeader('Accept', 'application/json');
PostData.Add('grant_type=authorization_code');
PostData.Add('code=' + ReceivedCode);
PostData.Add('redirect_uri=' + RedirectUri);
PostData.Add('client_id=' + ClientId);
PostData.Add('client_secret=' + ClientSecret);
WriteLn('Exchanging code for token at: ', TokenEndpoint);
Response := Client.FormPost(TokenEndpoint, PostData);
WriteLn('Token Response: ', Response);
// Parse the JSON response safely
JSONData := GetJSON(Response);
try
if JSONData is TJSONObject then
begin
JSONObject := TJSONObject(JSONData);
if JSONObject.IndexOfName('access_token') <> -1 then
begin
AccessToken := JSONObject.Get('access_token');
WriteLn(#10 + 'SUCCESS! Access Token: ', AccessToken);
end
else
WriteLn(#10 + 'ERROR: "access_token" not found in JSON response.');
end;
finally
JSONData.Free;
end;
except
on E: Exception do
WriteLn('HTTP Error during token exchange: ', E.Message);
end;
PostData.Free;
Client.Free;
end;
procedure OpenBrowser(const URL: string);
begin
WriteLn('Opening browser for authentication...');
{$IFDEF MSWINDOWS}
SysUtils.ExecuteProcess('cmd.exe', ['/c', 'start', URL], []);
{$ELSE}
{$IFDEF DARWIN}
SysUtils.ExecuteProcess('/usr/bin/open', [URL], []);
{$ELSE}
SysUtils.ExecuteProcess('/usr/bin/xdg-open', [URL], []);
{$ENDIF}
{$ENDIF}
end;
begin
Randomize;
ExpectedState := GenerateRandomString(32);
// 1. Build the Authorization URL
AuthURL := AuthEndpoint +
'?response_type=code' +
'&client_id=' + EncodeURLElement(ClientId) +
'&redirect_uri=' + EncodeURLElement(RedirectUri) +
'&scope=' + EncodeURLElement(Scope) +
'&state=' + EncodeURLElement(ExpectedState);
WriteLn('--- OAuth2 Authorization Code Flow Test ---');
// 2. Open the browser FIRST
OpenBrowser(AuthURL);
// 3. Setup and start the local HTTP server
Handler := TCallbackHandler.Create;
Server := TFPHTTPServer.Create(nil);
try
Server.Port := ListenPort;
Server.OnRequest := @Handler.HandleRequest;
WriteLn('Listening for callback on port ', ListenPort, '...');
WriteLn('Waiting for authentication...');
// This call blocks the main thread until Server.Active is set to False
// inside the HandleRequest method.
Server.Active := True;
finally
Server.Free;
Handler.Free;
end;
WriteLn('Callback received. Processing...');
// 4. Exchange the code for a token
if ReceivedCode <> '' then
ExchangeCodeForToken
else
WriteLn('Authentication was cancelled or failed.');
WriteLn(#10 + 'Press Enter to exit...');
ReadLn;
end.
