Delphi: TOAuth2Authenticator with client_credentials - delphi

A while ago I wrote a method in Delphi 2010 to get the OAuth2 token using the Indy components (TidHttp). See code below.
I am now doing something new in Delphi 10.4 and would like to use the REST components such as RESTClient, RESTRequest, TOAuth2Authenticator, etc.
Our grant type is Client Credentials but in none of the examples on the net could I find on how to use TOAuth2Authenticator with Client Credentials. Is it even possible?
We have a client id, client secret and token URL. We do not have authorization or redirect endpoints. In Insomnia, the setup will look like this:
Does somebody know how to get the token using TOAuth2Authenticator with grant type = client_credentials?
Here is the Delphi 2010 code:
procedure TfrmToken.btnGetTokenClick(Sender: TObject);
var
IdHTTP: TidHttp;
lsHttpError: string;
loRequest: TStringStream;
loRespJson: TMemoryStream;
liSuper: iSuperObject;
ldtExpiry: TDateTime;
begin
IdHTTP := TIdHTTP.Create();
loRespJson := TMemoryStream.Create();
try
IdHTTP.HandleRedirects := False;
loRequest := TStringStream.Create('grant_type=client_credentials&client_id=' +
edtKey.Text + '&client_secret='+edtSecret.Text);
try
IdHttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHttp);
IdHttp.Request.ContentType := 'application/x-www-form-urlencoded';
try
IdHTTP.Post(edtURL.Text, loRequest, loRespJson);
except
on E: EIdHTTPProtocolException do
begin
lsHttpError := E.ErrorMessage;
end;
on E: Exception do
begin
lsHttpError := E.Message;
end;
end;
if idHTTP.ResponseCode = 200 then
begin
liSuper := SO(StreamToString(loRespJSon));
edtToken.Text := liSuper.S['access_token'];
ldtExpiry := IncSecond(Now, liSuper.i['expires_in']);
edtExpiry.Text := 'Expires in ' + liSuper.S['expires_in'] +
' seconds. Time: ' +
FormatDateTime('yyyy/dd/mm hh:nn:ss', ldtExpiry);
end
else
begin
liSuper := SO(lsHttpError);
edtToken.Text := IdHTTP.ResponseText;
edtExpiry.Text := '';
end;
finally
FreeAndNil(loRequest);
end;
finally
FreeAndNil(IdHTTP);
FreeAndNil(loRespJson);
end;
end;

Related

Delphi + Binance Api + Limit Order Problem Invalid signatur

{"code":3702,"msg":"Invalid signature.","timestamp":1623848681308}
i use trbinance.com api. I keep getting the same error
procedure TForm1.Button1Click(Sender: TObject);
var
url, sign, queryString, nonce: string;
ST: SystemTime;
DT: TDateTime;
uTime: int64;
sHour, sMin, sSec, sMili: Word;
stream, s_url: string;
Post: TStringList;
IdHTTP10 : TIDhttp;
api_key , api_secret : String;
begin
api_key := '**';
api_secret := '**';
GetSystemTime(ST);
DT := EncodeDate(ST.wYear, ST.wMonth, ST.wDay) +
EncodeTime(ST.wHour, ST.wMinute, ST.wSecond, ST.wMilliseconds);
uTime := DateUtils.MilliSecondsBetween(DT, UnixDateDelta);
nonce:=inttostr(uTime);
url :='https://trbinance.com/open/v1/orders';
queryString := 'symbol=BTT_TRY&side=0&type=1&quantity=1&price=0.0022&recvWindow=5000&timestamp='+nonce;
sign := THashSHA2.GetHMAC(queryString, api_secret, SHA256);
IdHTTP10 := TidHTTP.Create(nil);
IdHTTP10.HandleRedirects := True;
IdHTTP10.Request.CustomHeaders.Add('X-MBX-APIKEY:'+api_key);
IdHTTP10.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
Post:=TStringList.Create;
Post.Add('quantity=1&');
Post.Add('price=0.0022&');
Post.Add('recvWindow=5000&');
Post.Add('timestamp='+nonce+'&');
Post.Add('signature='+sign);
s_url := url + '?symbol=BTT_TRY&side=0&type=1';
try
stream:=IdHTTP10.POST(s_url, Post);
Memo1.Lines.Add(stream);
except
on E: Exception do
Memo1.Lines.Add(TimeToStr(time)+' <---> [Order] error: '+E.Message);
end;
IdHTTP10.Free;
Post.Free;
end;
Always problem :
{"code":3702,"msg":"Invalid signature.","timestamp":1623848681308}
Normaly Binance Symbol : BTTTRY
Turkey Api : BTT_TRY
Normaly Binance Order Url : httpps://api.binance.com/api/v3/order
Turkey Api Order Url : https://trbinance.com/open/v1/orders
Where is the Problem ?
Thank you so much.
Thank you for your answers. I made improvements to the code.
Friends in need can use this procedure in delphi. ( for Global Binance Api )
procedure TForm1.Button1Click(Sender: TObject);
const
Publickey= '***';
Secretkey= '***';
var
IdHTTP : TIdHTTP;
RBody : TStringstream;
QueryString : String;
Signature : String;
url : String;
begin
queryString :=
'symbol=BTTTRY&side=BUY&type=LIMIT&timeInForce=GTC&quantity=1000&price=0.024400&recvWindow=5000&timestamp='
+ ABDULLAH_GetTimestamp();
Signature := THashSHA2.GetHMAC(queryString, Secretkey, SHA256);
Try
IdHTTP := TIdHTTP.Create();
RBody := TStringStream.Create(queryString + '&signature=' + Signature);
IdHTTP.Request.CustomHeaders.Add('X-MBX-APIKEY:' + Publickey);
IdHTTP.Request.CustomHeaders.UnfoldLines := True;
IdHTTP.Request.Accept := 'application/json';
IdHTTP.Request.ContentType := 'application/json';
IdHTTP.Request.ContentEncoding := 'utf-8';
IdHTTP.Request.BasicAuthentication := True;
IdHTTP.HandleRedirects := True;
IdHTTP.HTTPOptions := [hoKeepOrigProtocol, hoForceEncodeParams,
hoNoProtocolErrorException, hoWantProtocolErrorContent];
IdHTTP.iohandler := IdSSLIOHandlerSocketOpenSSL1;
url := 'https://api.binance.com/api/v3/order?';
Try
Memo1.Lines.Add(IdHTTP.Post(url, RBody));
Except
ON E: EXCEPTION DO
Memo1.Lines.Add('Error Message:' + E.Message);
End;
Finally
FreeAndNil(IdHTTP);
FreeAndNil(RBody);
End;
end;
This code works for Global Binance Api.
Change Symbol : BTTTRY -> BTT_TRY
And Post Url : https://api.binance.com/api/v3/order -> https://trbinance.com/open/v1/orders
İt's not working and Result :
{"code":3702,"msg":"Invalid signature.","timestamp":1723648673412}
This Procedure works in 'Global Binance Api' but not working 'trbinance Api'
Same procedure gives 'invalid signature' error in 'trbinance api'. :(
trbinance api example :
HMAC SHA256 signature:
[linux]$ echo -n "symbol=BTC_USDT&side=0&type=1&quantity=0.16&price=7500&timestamp=1581720670624&recvWindow=5000" | openssl dgst -sha256 -hmac "cfDC92B191b9B3Ca3D842Ae0e01108CBKI6BqEW6xr4NrPus3hoZ9Ze9YrmWwPFV"
(stdin)= 33824b5160daefc34257ab9cd3c3db7a0158a446674f896c9fc3b122ae656bfa
curl command:
(HMAC SHA256)
[linux]$ curl -H "X-MBX-APIKEY: cfDC92B191b9B3Ca3D842Ae0e01108CBKI6BqEW6xr4NrPus3hoZ9Ze9YrmWwPFV" -X POST 'https://www.trbinance.com/open/v1/orders' -d 'symbol=BTC_USDT&side=0&type=1&quantity=0.16&price=7500&timestamp=1581720670624&recvWindow=5000&signature=33824b5160daefc34257ab9cd3c3db7a0158a446674f896c9fc3b122ae656bfa'
There are a number of issues with this code, but the biggest one I see is that you should NOT be including trailing & characters in your TStringList strings, eg:
Post:=TStringList.Create;
Post.Add('quantity=1');
Post.Add('price=0.0022');
Post.Add('recvWindow=5000');
Post.Add('timestamp='+nonce);
Post.Add('signature='+sign);
TIdHTTP.Post() will insert those & characters into the request body for you, thus the data being transmitted is different than the data you signed.
According to Binance TR API docs:
Use your secretKey as the key and totalParams as the value for the HMAC operation.
totalParams is defined as the query string concatenated with the request body.
Error from API with the text "Invalid signature." could give you a clue that the problem is with your signature algo:
sign := THashSHA2.GetHMAC(queryString, api_secret, SHA256);
Your code here signs only your query string, but according to API docs you must sign query string concatenated with the request body.
So, you need to change your code like this ("Post" variable must be initialized before this line):
sign := THashSHA2.GetHMAC(queryString + Post.text, api_secret, SHA256);
I found that using the TIdHTTP component in Delphi to connect to Binance has problems. I kept getting Http/1.1 400 Bad Request.
I switched to TNetHTTPClient instead to connect with Binance.
The following is the working program that can be used for placing an order on Binance:
uses
System.Net.HttpClient, System.Hash, DateUtils;
procedure TForm1.fapiorder(oSide: String; oCoin: String; oAmt: Integer);
var
sOrderAmt: string;
ClearEntryUrl: string;
Params: string;
Signature: string;
URL: string;
ResponseStream : TStringStream;
postStream: TStringStream;
uTime: int64;
nowDateTime: string;
ST: SystemTime;
DT: TDateTime;
HttpClient: THttpClient;
HttpResponse: IHttpResponse;
BaseURLUSDM, ApiKey, ApiSecret: string;
begin
//https://binance-docs.github.io/apidocs/futures/cn/#trade-3
BaseURLUSDM := 'https://fapi.binance.com/'; //合約永續
ClearEntryUrl := 'fapi/v1/order';
ApiSecret := 'YOUR API SECRET KEY';
//timestamp 開始
GetSystemTime(ST);
DT := EncodeDate(ST.wYear, ST.wMonth, ST.wDay) + EncodeTime(ST.wHour,
ST.wMinute, ST.wSecond, ST.wMilliseconds);
uTime := DateUtils.MilliSecondsBetween(DT, UnixDateDelta);
nowDateTime := IntToStr(uTime);
Writeln('DateTime = ' + nowDateTime);
//timestamp 結束
Params := 'recvWindow=3000&timestamp=' + nowDateTime;
if (TDCoinMap.TryGetValue(oCoin, CoinMap) = True) then
begin
sOrderAmt := '0.07';
if (StrToFloat(sOrderAmt) <> 0) then
begin
Params := Params + '&symbol=' + oCoin;
Params := Params + '&side=' + oSide;
Params := Params + '&type=MARKET';
Params := Params + '&quantity=' + sOrderAmt;
Signature := THashSHA2.GetHMAC(Params, ApiSecret, SHA256);
URL := BaseURLUSDM + ClearEntryUrl + '?' + Params + '&signature=' + Signature;
postStream := TStringStream.Create('');
ResponseStream := TStringStream.Create('');
try
HttpClient := THTTPClient.Create;
HttpClient.HandleRedirects := True;
HttpClient.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:27.0) Gecko/20100101 Firefox/27.0';
HttpClient.ContentType := 'application/x-www-form-urlencoded';
HttpClient.CustomHeaders['X-MBX-APIKEY'] := 'Your Binance APIKEY';
HttpResponse := HttpClient.Post(URL, ResponseStream);
jResult := HttpResponse.ContentAsString();
Writeln('jResult = ' + jResult);
finally
HttpClient.Free;
end;
end;
end;
end;

DUO API Authentication with Delphi REST Client

I'm creating a Delphi REST Client to interact with the DUO API. I was able to test my authorization keys and all other parameters in Postman just fine. However, I cannot replicate the same in Delphi REST. I'm not sure if I'm doing this wrong. Below is my sample code:
//aside from the parameters below
//RESTClient1 baseurl is set to: https://api-sample123.duosecurity.com/
//RESTRequest1 Resource is set to this standard resource: admin/v1/users
procedure TfrmMain.Button1Click(Sender: TObject);
var
sAuthorization, nDate, sUsername, sPassword : string;
begin
try
nDate := formatdatetime('ddd, d mmm yyyy hh:mm:ss', now()) + ' +1000';
sAuthorization := 'Basic justasamplekeyhere123:alsoatesthmacsha1hash';
Restclient1.Params.Add();
RESTClient1.Params[0].Name := 'Date';
RESTClient1.Params[0].Value := nDate;
Restclient1.Params[0].Options := [poDoNotEncode];
Restclient1.Params.Add();
RESTClient1.Params[1].Name := 'Authorization';
RESTClient1.Params[1].Value := sAuthorization;
Restclient1.Params[1].Options := [poDoNotEncode];
Restclient1.ContentType := 'ctAPPLICATION_X_WWW_FORM_URLENCODED'; //application/x-www-form-urlencoded';
RESTRequest1.Execute;
MEMO1.Lines.Add(RestRequest1.Response.Content);
Except
On E: Exception do
begin
MessageDlg(E.Message, mtError, [mbOK], 0);
end;
end;

How to solve 'invalid address' using idSMTP

I've posted various questions trying to figure out all my issues with trying to send an email using TLS with Office365.
My last question here: How do I solve [EIdSMTPReplyError] Authentication unsuccessful?
Since I couldn't solve the latter I got credentials of one of our clients and try testing the sample with their office credentials which brought me one step closer. With my own office credentials I'm just unable to authenticate (see previous link). In PowerShell there is no issue and I can send an email with the same credentials but not programmatically.
I'm now trying to figure out why the server is returning "Invalid Address" using the client's credentials. Again, I'm able to use the exact same credentials in PowerShell and generate a sample email which works. But not with this component.
Slightly adjusted code from previous link:
procedure TForm28.SendEmail(poSMTP:TIdSMTP);
var
loSMTPMessage : TIdMessage;
begin
loSMTPMessage := TIdMessage.Create(nil);
with loSMTPMessage do
begin
Recipients.Add.Address := 'to address';
ReplyTo.Add.Text := edtUsername.Text;
From.Address := edtUsername.Text;
From.Name := 'xxx';
From.Text := 'Test';
Subject := 'Test';
end;
poSMTP.Send(loSMTPMessage);
loSMTPMessage.Free;
end;
procedure TForm28.Method2Click(Sender: TObject);
var
idSMTP1: TIdSMTP;
idSASLLogin: TIdSASLLogin;
idUserPassProvider: TIdUserPassProvider;
lp:PWideChar;
liSize:Cardinal;
begin
idSMTP1 := TIdSMTP.Create(nil);
idSMTP1.OnFailedRecipient := IdSMTP1FailedRecipient;
//have tried all these variations in trying to solve authentication issue
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameNetBIOS);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameDnsHostname);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameDnsDomain);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalNetBIOS);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalDnsHostname);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalDnsDomain);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNamePhysicalDnsFullyQualified);
// IdSMTP1.HeloName := GetComputerNameExString(ComputerNameMax);
try
idSMTP1.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(idSMTP1);
idSMTP1.UseTLS := utUseExplicitTLS;
TIdSSLIOHandlerSocketOpenSSL(idSMTP1.IOHandler).SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
idSMTP1.Host := edtSMTP.Text;
idSMTP1.Port := StrToInt(cbPort.Text);
idSASLLogin := TIdSASLLogin.Create(idSMTP1);
idUserPassProvider := TIdUserPassProvider.Create(idSASLLogin);
idSASLLogin.UserPassProvider := idUserPassProvider;
idUserPassProvider.Username := edtUsername.Text;
idUserPassProvider.Password := edtPassword.Text;
idSMTP1.AuthType := satSASL;
idSMTP1.SASLMechanisms.Add.SASL := idSASLLogin;
try
idSMTP1.Connect;
try
if idSMTP1.Authenticate then
SendEmail(idSMTP1);
finally
idSMTP1.Disconnect;
end;
ShowMessage('OK');
except
on E: Exception do
begin
ShowMessage(Format('Failed!'#13'[%s] %s', [E.ClassName, E.Message]));
raise;
end;
end;
finally
idSMTP1.Free;
end;
end;
This gives me an error: Project SMTP_SSL_Example.exe raised exception class EIdSMTPReplyError with message 'Invalid address
'.
Oh my gosh.
From.Text := 'Test';
called after
From.Address := edtUsername.Text
was changing my email address to 'test'.
Cannot believe I've wasted time with something stupid like this.

403/Forbidden using delphi application to access my Google calendar

Can anyone tell me why i'm having trouble accessing my calendar information? I'm getting 403 forbidden.
procedure TForm1.Button1Click(Sender: TObject);
var
stringStream: TStringStream;
slPost, slReply: TStringList;
sPostResult: string;
begin
slPost := TStringList.Create;
slReply := TStringList.Create;
try
slPost.LineBreak := '&';
slPost.Values['Email'] := 'me#gmail.com';
slPost.Values['Passwd'] := 'pass';
slPost.Values['service'] := 'cl';
slPost.Values['source'] := 'company-program-version';
stringStream := TStringStream.Create(slPost.Text);
try
IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
sPostResult := IdHTTP1.Post('https://www.google.com/accounts/ClientLogin', stringStream);
slReply.LineBreak:=#10;
slReply.Text:=sPostResult;
slReply.LineBreak:=#13#10;
Memo1.Lines.Add(slReply.Text);
Memo1.Lines.Add('response=' + IdHTTP1.ResponseText);
// 200 OK
sPostResult := IdHTTP1.Post('https://www.google.com/accounts/ClientLogin', stringStream);
IdHTTP1.Request.CustomHeaders.FoldLines:=false;
IdHTTP1.Request.CustomHeaders.Clear;
IdHTTP1.Request.CustomHeaders.Values['GData-Version']:='2.0';
IdHTTP1.Request.CustomHeaders.Values['Authorization']:='GoogleLogin auth=' + slReply.Values['auth'];
(* custom headers:
GData-Version: 2.0
Authorization: GoogleLogin (line continues) auth=DQwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhateverwhatever *)
IdHTTP1.Request.ContentType := 'application/atom+xml';
// 403 Forbidden
memo1.Lines.Add(IdHTTP1.Get('https://www.googleapis.com/calendar/v3/users/me/calendarList'));
finally
stringStream.Free;
end;
finally
slPost.Free;
slReply.Free;
end;
end;
thank you!
mp
After some reading, I think you need to deal with Redirect. So If response is redirect, get the new url, reattach the authorization to the new request header with the new url. Otherwise your redirection request will be missing the required authorization and give you 403 error.

HTTPS post - what I'm doing wrong?

I'm making requests to the webaddress to get XML files throught the HTTPS connection. But this connection works like 50%. In most cases it fails. Usual error is "socket error #10060". Or "Error connecting with SSL. EOF was observed that violates the protocol". What I'm doing wrong?
function SendRequest(parameters: string): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TStringStream;
xDoc: IXMLDocument;
begin
sPostData := TStringList.Create;
try
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add(parameters);
sHttpSocket := TIdHTTP.Create;
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create;
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Request.Method := 'POST';
resStream := TStringStream.Create;
sHttpSocket.Post(Self.sUrl, sPostData, resStream);
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
resStream.Free;
sHttpSocket.Free;
sshSocketHandler.Free;
sPostData.Free;
except on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end
end;
end;
Maybe I can do this in another way, that works like 100%, when internet connection is available?
Regards,
evilone
An "EOF" error suggests you are connnecting to a server that is not actually using SSL to begin with, or the SSL data may be corrupted.
Besides that, why are you including explicit '&' characters between your post data parameters? Don't do that, Indy will just encode them and send its own '&' characters. Also, consider using TMemoryStream instead of TStringStream to ensure IXMLDocumect.LoadFromStream() is loading the server's original raw XML data as-is, and not an altered version that the RTL/VCL produces due to Unicode handling (TStringStream is TEncoding-enabled).
Edit: Given the URL you provided, an example of calling verifyUser() would look like this:
const
ERPLYAccountCode = '...';
function verifyUser(const user, pass: string; const sessionLength: Integer = 3600): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TMemoryStream;
xDoc: IXMLDocument;
begin
Result := nil;
try
resStream := TMemoryStream.Create;
try
sPostData := TStringList.Create;
try
sPostData.Add('clientCode=' + ERPLYAccountCode);
sPostData.Add('request=verifyUser');
sPostData.Add('version=1.0');
sPostData.Add('responseType=XML');
sPostData.Add('responseMode=normal');
sPostData.Add('username=' + user);
sPostData.Add('password=' + pass);
sPostData.Add('sessionLength=' + IntToStr(sessionLength));
sHttpSocket := TIdHTTP.Create;
try
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create(sHttpSocket);
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Post('https://www.erply.net/api/', sPostData, resStream);
finally
sHttpSocket.Free;
end;
finally
sPostData.Free;
end;
resStream.Position := 0;
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
finally
resStream.Free;
end;
except
on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end;
end;
end;

Resources