TTMSFNCCloudOAuth FetchAccessToken does not work when adding acces and refreshtoken from a database

FNC TMS FNC Cloud Pack
1

I'm trying to use the TTMSFNCCloudOAuth component with the Exact Online rest API.

This is working for the authentication, and getting the acces-token, refresh-token and Accesstoken expire datetime.

I'm loading the accesstoken, refreshtoken and the expiredatetime from a database.

When I check if the accesstoken is valid (TMSFNCCloudSample.Authentication.IsAccessTokenValid) it works fine.

But when the accesstoken datetime is expired nothings happening when I expected to get a new accesstaken when I call

 procedure TfPoging2Form.Button2Click(Sender: TObject);
begin
  TMSFNCCloudSample.FetchAccessToken.ThenBy(procedure (const AValue: string)
  begin
    If fPoging2Form.TMSFNCCloudSample.Authentication.IsAccessTokenValid Then begin
      ShowMessage('Valid');
    end
    Else
    Begin
      ShowMessage('Not Valid');
    end;
  end);
  end);

How to solve this?

3

Hi,

Looking at the code snippet, it's mostly OK. ShowMessage should be synced to the Main thread (see here), but that alone will not cause this to fail. Can you provide a minimal sample application so we can investigate?

4

Hereby the code i'm using to load the tokens, and trying to get a new Accesstoken using the FetchAccessToken option.

I did look at:

https://www.tmssoftware.com/site/blog.asp?post=2400&srsltid=AfmBOopHgx8vI-YSugFEExznFTyLrQQXs45u-F7xb6txHlof0CpAvvWV

But I can't get it working. What am I missing?


type
  TTMSFNCCloudSample = class(TTMSFNCCloudOAuth)
  protected

  public
   function GetAuthenticationURL: string; override;
   procedure RetrieveAccessToken; override;
   procedure TestTokens(const ATestTokensRequestResultEvent: TTMSFNCCloudBaseRequestResultEvent = nil); override;
   function GetTestTokensResult(const ARequestResult: TTMSFNCCloudBaseRequestResult): Boolean; override;
  end;
  
  
procedure TfPoging2Form.btnLoadClick(Sender: TObject);
begin
  // Get accesstoken/refreshtoken from Database
  cdsAudaptConfig.Close;
  cdsAudaptConfig.CommandText :=
  (
    'SELECT * FROM tbData WHERE ExtConDsc = :APIName'
  );
  cdsAudaptConfig.Params.ParamByName('APIName').AsString  := 'ExactOnline';
  Try
    cdsAudaptConfig.Open;
    //ShowMessage('records:' + IntToStr(cdsAudaptConfig.RecordCount));
  Except
    on E : Exception do begin
      Screen.Cursor := crDefault;
      Memo1.Lines.Add('Exception opgetreden bij ophalen API gegevens' +#13#10+ #13#10 + 'Foutcode: '+ E.Message + #13#10 + 'Foutclass: ' + E.ClassName);
      Exit;
    end;
    on E : EDatabaseError do begin
      Screen.Cursor := crDefault;
      Memo1.Lines.Add('DB Error opgetreden bij ophalen API gegevens' +#13#10+ #13#10 + 'Foutcode: '+ E.Message + #13#10 + 'Foutclass: ' + E.ClassName);
      Exit;
    end;
  End; // Try Except
  sAccessToken                  :=  cdsAudaptConfig.FieldByName('AcTok').AsString;
  dATVerloop                    :=  cdsAudaptConfig.FieldByName('AcTokExp').AsDateTime;
  sRefreshToken                 :=  cdsAudaptConfig.FieldByName('RfTok').AsString;
  dRTVerloop                    :=  cdsAudaptConfig.FieldByName('RfTokExp').AsDateTime;
  sDevision                     :=  cdsAudaptConfig.FieldByName('DvId').AsString;
  eAccToken.Text                :=  sAccessToken;
  eRefToken.Text                :=  sRefreshToken;
  eExpToken.Text                :=  DateTimeToStr(dATVerloop);
  TMSFNCCloudSample.onConfigureHTTPServer             :=  OnConfigureHTTPServer;
  TMSFNCCloudSample.Authentication.ClientID           :=  'tretre';
  TMSFNCCloudSample.Authentication.Secret             :=  'yrtytrytr';
  TMSFNCCloudSample.Authentication.CallBackURL        :=  'localhost';
  TMSFNCCloudSample.Authentication.ServerPort         :=  8082;
  TMSFNCCloudSample.LoadTokens;
  TMSFNCCloudSample.Authentication.AccessToken        :=  cdsAudaptConfig.FieldByName('AcTok').AsString;
  TMSFNCCloudSample.Authentication.AccessTokenExpiry  :=  cdsAudaptConfig.FieldByName('AcTokExp').AsDateTime;
  TMSFNCCloudSample.Authentication.AccessTokenRefresh :=  cdsAudaptConfig.FieldByName('RfTok').AsString; //.Copy(sRefreshToken);
  TMSFNCCloudSample.Connect;
end;

procedure TfPoging2Form.btnCheckClick(Sender: TObject);
begin
    // Check if token is valid.
    If fPoging2Form.TMSFNCCloudSample.Authentication.IsAccessTokenValid Then begin
      ShowMessage('Valid');
    end
    Else
    Begin
      ShowMessage('Not Valid');
      TMSFNCCloudSample.FetchAccessToken.ThenBy(procedure (const AValue: string)
      begin
        TMSFNCCloudSample.Refresh;
        ShowMessage('New?: ' + TMSFNCCloudSample.Authentication.AccessToken);
      end);

    end;
end;
5

Thank you, we'll investigate and get back to you as soon as we find something.

7

Part of the problem for us is that I wanted to use port 8082, which resulted in the following error in debugger mode:
error:1407609C:SSL routines:SSL23_GET_CLIENT_HELLO:http request'.

Later, I read in the documentation (HTTPS Support - TMS FNC Cloud Pack) that the SSL certificate was automatically generated for port 443, but apparently not for other ports.

I've now set the port to 443, and now I'm getting more information back in the logging, especially because test tokens are now retrieving information.

The test tokens are being executed correctly, and I'm receiving the correct information from Exact.

What's still going wrong:
• Requesting a new access token when it has expired using FetchAccesstoken isn't working. Retrieving the token data from a database (which has expired) and then requesting a new access token doesn't work either.

The refresh token is valid in the database cases.

• TMSFNCCloudSample.OnConnected doesn't work. I don't receive a connected message.
TMSFNCCloudSample.OnConnected := CloudOAuthConnected;

TMSFNCCloudSample.Connect;

procedure TfProging2Form.CloudOAuthConnected(Sender: TObject);
begin
Memo1.Lines.Add('Connected. AccessToken: ' + TMSFNCCloudSample.Authentication.AccessToken);
end;

8

Hello,

Looking at the documentation of Exact Online here, could it be you didn't implement the RetrieveRefreshToken override? It's the function that will be called when the refresh token is used to retrieve the new tokens.

If you haven't already, can you try something similar?

procedure TTMSCloudSimple.RetrieveRefreshToken;
var
  sRefreshToken: string;
  sPostData : string;
begin
  sRefreshToken := StringReplace(Authentication.AccessTokenRefresh, '%21', '!', [rfReplaceAll, rfIgnoreCase]);
  Request.Clear;
  Request.CustomHeaders := True;
  Request.AddHeader('Content-Type', 'application/x-www-form-urlencoded');
  Request.Name := '';
  Request.Host := 'host_url_of_exact';
  Request.Path := '/api/oauth2/token';
  Request.Method := rmPOST;
  sPostData := 'grant_type=refresh_token'
    + '&refresh_token=' + sRefreshToken
    + '&client_id=' + Authentication.ClientID
    + '&client_secret=' + Authentication.Secret;
  Request.PostData := sPostData;
  Request.AddHeader('Content-Length', IntToStr(Length(sPostData)));
  ExecuteRequest(DoRetrieveRefreshToken);
end;
9

That solved the problem! Many thanks!!
Now i'm getting a new Access and Refresh token.

1 Like