// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// Collaborators on this file:
// João Antônio Duarte (https://github.com/joaoduarte19)
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit MVCFramework.RESTClient;
{$I dmvcframework.inc}
interface
uses
System.Classes,
System.SysUtils,
System.Net.HttpClient,
System.Net.Mime,
System.Net.URLClient,
System.Generics.Collections,
System.Rtti,
System.TypInfo,
MVCFramework.Commons,
MVCFramework.RESTClient.Indy,
MVCFramework.RESTClient.Intf,
MVCFramework.RESTClient.Commons,
MVCFramework.Serializer.Intf,
MVCFramework.Serializer.Commons,
Data.DB,
JsonDataObjects;
type
///
/// Alias for the Indy-based TRESTClient. The implementation of TRESTClient has been discontinued, it remains for
/// compatibility only.
///
TRESTClient = MVCFramework.RESTClient.Indy.TRESTClient deprecated
'Moved to the MVCFramework.RESTClient.Indy unit. It is highly recommended to migrate to the TMVCRESTClient implementation.';
IRESTResponse = MVCFramework.RESTClient.Indy.IRESTResponse deprecated
'Moved to the MVCFramework.RESTClient.Indy unit. It is highly recommended to migrate to the TMVCRESTClient implementation.';
IMVCRESTClient = MVCFramework.RESTClient.Intf.IMVCRESTClient;
IMVCRESTResponse = MVCFramework.RESTClient.Intf.IMVCRESTResponse;
TCookie = System.Net.HttpClient.TCookie;
TCookies = System.Net.HttpClient.TCookies;
TURLRequest = System.Net.URLClient.TURLRequest;
TCertificate = System.Net.URLClient.TCertificate;
TCertificateList = System.Net.URLClient.TCertificateList;
TNameValuePair = System.Net.URLClient.TNameValuePair;
TNameValueArray = System.Net.URLClient.TNameValueArray;
IHTTPRequest = System.Net.HttpClient.IHTTPRequest;
IHTTPResponse = System.Net.HttpClient.IHTTPResponse;
{$IF defined(TOKYOORBETTER)}
THTTPSecureProtocol = System.Net.HttpClient.THTTPSecureProtocol;
THTTPSecureProtocols = System.Net.HttpClient.THTTPSecureProtocols;
{$ENDIF}
TMVCRESTClient = class(TInterfacedObject, IMVCRESTClient)
private
fLock: TObject;
fHTTPClient: THTTPClient;
fBaseURL: string;
fResource: string;
fProxySettings: TProxySettings;
fParameters: TList;
fRawBody: TMemoryStream;
fBodyFormData: TMultipartFormData;
fSerializer: IMVCSerializer;
fRttiContext: TRttiContext;
fNextRequestIsAsync: Boolean;
fAsyncCompletionHandler: TProc;
fAsyncCompletionHandlerWithError: TProc;
fAsyncSynchronized: Boolean;
fNeedClientCertificate: TNeedClientCertificateProc;
fValidateServerCertificate: TValidateServerCertificateProc;
fBeforeRequestProc: TBeforeRequestProc;
fRequestCompletedProc: TRequestCompletedProc;
fResponseCompletedProc: TResponseCompletedProc;
[Weak] fClientCertificate: TStream;
fClientCertPassword: string;
fClientCertPath: string;
procedure DoNeedClientCertificate(const aSender: TObject; const aRequest: TURLRequest;
const aCertificateList: TCertificateList; var aIndex: Integer);
procedure DoValidateServerCertificate(const aSender: TObject; const aRequest: TURLRequest;
const aCertificate: TCertificate; var aAccepted: Boolean);
procedure DoBeforeRequest(aRequest: IHTTPRequest);
procedure DoRequestCompleted(aResponse: IHTTPResponse; var aHandled: Boolean);
procedure DoResponseCompleted(aMVCRESTResponse: IMVCRESTResponse);
function GetBodyFormData: TMultipartFormData;
function ObjectIsList(aObject: TObject): Boolean;
function SerializeObject(aObject: TObject): string;
procedure SetContentType(const aContentType: string);
procedure SetParameter(const aParamType: TMVCRESTParamType; const aName, aValue: string);
procedure ClearParameters(const aParamType: TMVCRESTParamType);
function InsertHTTPSchema(const aURL: string): string;
function GetFullURL: string;
function HTTPMethodName(const aHTTPMethod: TMVCHTTPMethodType): string;
///
/// Convert path parameters of type ($xxx) to {xxx}
///
procedure DoConvertMVCPathParamsToRESTParams(var aURL: string);
procedure DoApplyPathParams(var aURL: string);
procedure DoApplyQueryParams(var aURL: string);
procedure DoApplyCookies(const aURL: string);
procedure DoApplyHeaders;
procedure DoEncodeURL(var aURL: string);
procedure DoPrepareBodyRequest(var aBodyStream: TStream);
procedure ExecuteAsyncRequest(const aMethod: TMVCHTTPMethodType);
function InternalExecuteRequest(const aMethod: TMVCHTTPMethodType): IMVCRESTResponse;
function ExecuteRequest(const aMethod: TMVCHTTPMethodType): IMVCRESTResponse;
public
constructor Create;
destructor Destroy; override;
class function New: IMVCRESTClient;
{ IMVCRESTClient }
function BaseURL(const aBaseURL: string): IMVCRESTClient; overload;
function BaseURL(const aHost: string; const aPort: Integer): IMVCRESTClient; overload;
function BaseURL: string; overload;
function ProxyServer(const aProxyServer: string): IMVCRESTClient; overload;
function ProxyServer: string; overload;
function ProxyPort(const aProxyPort: Integer): IMVCRESTClient; overload;
function ProxyPort: Integer; overload;
function ProxyUsername(const aProxyUsername: string): IMVCRESTClient; overload;
function ProxyUsername: string; overload;
function ProxyPassword(const aProxyPassword: string): IMVCRESTClient; overload;
function ProxyPassword: string; overload;
function ProxyScheme(const aProxyScheme: string): IMVCRESTClient; overload;
function ProxyScheme: string; overload;
{$IF defined(TOKYOORBETTER)}
function SecureProtocols(const aSecureProtocols: THTTPSecureProtocols): IMVCRESTClient; overload;
function SecureProtocols: THTTPSecureProtocols; overload;
{$ENDIF}
///
/// Method called when a ClientCertificate is needed.
///
function SetNeedClientCertificateProc(aNeedClientCertificateProc: TNeedClientCertificateProc): IMVCRESTClient;
///
/// Add a custom SSL certificate validation. By default all certificates are accepted.
///
function SetValidateServerCertificateProc(aValidateCertificateProc: TValidateServerCertificateProc): IMVCRESTClient;
///
/// Executes before send the request
///
function SetBeforeRequestProc(aBeforeRequestProc: TBeforeRequestProc): IMVCRESTClient;
///
/// Executes after send the request
///
function SetRequestCompletedProc(aRequestCompletedProc: TRequestCompletedProc): IMVCRESTClient;
///
/// Executes after the response is processed.
///
function SetResponseCompletedProc(aResponseCompletedProc: TResponseCompletedProc): IMVCRESTClient;
///
/// Set the client certificate for the request
///
function SetClientCertificate(const aCertStream: TStream; const aPassword: string): IMVCRESTClient; overload;
{$IF defined(TOKYOORBETTER)}
///
/// Set the path containing a client certificate for the request (iOS, Linux, Windows, Android).
/// Note, on Android the Path is certificate fingerprint or imported name, not a file path.
/// Password is not used.
///
function SetClientCertificate(const aCertPath, aPassword: string): IMVCRESTClient; overload;
{$ENDIF}
///
/// Clears all parameters (headers, body, path params and query params). This method is executed after each
/// request is completed.
///
///
/// Cookies and authorization set in SetBasicAuthorization or SetBearerAuthorization is not removed
///
function ClearAllParams: IMVCRESTClient;
{$IF defined(BERLINORBETTER)}
///
/// Connection timeout in milliseconds to be used for the requests.
///
function ConnectTimeout(const aConnectTimeout: Integer): IMVCRESTClient; overload;
function ConnectTimeout: Integer; overload;
///
/// Response reading timeout in milliseconds to be used for the requests.
///
function ReadTimeout(const aReadTimeout: Integer): IMVCRESTClient; overload;
function ReadTimeout: Integer; overload;
{$ENDIF}
///
/// Add basic authorization header. Authorization = Basic <Username:Password> (encoded in Base64)
///
function SetBasicAuthorization(const aUsername, aPassword: string): IMVCRESTClient;
///
/// Add bearer authorization header. Authorization = Bearer <Token>
///
function SetBearerAuthorization(const aAccessToken: string): IMVCRESTClient;
///
/// Returns the stored authorization. Includes Basic or Bearer prefix
///
function Authorization: string;
///
/// Removes the authorization header defined in
/// SetBasicAuthorization or
/// SetBearerAuthorization
///
function ClearAuthorization: IMVCRESTClient;
///
/// Add a header.
///
///
/// Header name
///
///
/// Header value
///
///
/// Indicates whether the value of this header should be used as is (True), or encoded by the component (False)
///
function AddHeader(const aName, aValue: string): IMVCRESTClient; overload;
function HeaderValue(const aName: string): string;
function Headers: TNameValueArray;
///
/// Clears all headers.
///
function ClearHeaders: IMVCRESTClient;
function AllowCookies(const aAllowCookies: Boolean): IMVCRESTClient; overload;
function AllowCookies: Boolean; overload;
///
/// Add DMVC session cookie
///
function SessionId(const aSessionId: string): IMVCRESTClient; overload;
function SessionId: string; overload;
///
/// Add a cookie header.
///
function AddCookie(const aName, aValue: string): IMVCRESTClient;
///
/// Clear all cookie headers.
///
function ClearCookies: IMVCRESTClient;
///
/// Add a URL segment parameter. The parameters of your url path may be enclosed in braces or in
/// parentheses starting with a money sign. /api/{param1}/($param2)
///
///
/// Parameter name
///
///
/// Parameter value
///
function AddPathParam(const aName, aValue: string): IMVCRESTClient; overload;
function AddPathParam(const aName: string; aValue: Integer): IMVCRESTClient; overload;
function AddPathParam(const aName: string; aValue: Int64): IMVCRESTClient; overload;
function AddPathParam(const aName: string; aValue: TGUID): IMVCRESTClient; overload;
function AddPathParam(const aName: string; aValue: TDateTime): IMVCRESTClient; overload;
function AddPathParam(const aName: string; aValue: TDate): IMVCRESTClient; overload;
function AddPathParam(const aName: string; aValue: TTime): IMVCRESTClient; overload;
function AddPathParam(const aName: string; aValue: Double): IMVCRESTClient; overload;
function ClearPathParams: IMVCRESTClient;
///
/// Add a QueryString parameter. /api/person?para1=value¶m2=value
///
function AddQueryStringParam(const aName, aValue: string): IMVCRESTClient; overload;
function AddQueryStringParam(const aName: string; aValue: Integer): IMVCRESTClient; overload;
function AddQueryStringParam(const aName: string; aValue: Int64): IMVCRESTClient; overload;
function AddQueryStringParam(const aName: string; aValue: TGUID): IMVCRESTClient; overload;
function AddQueryStringParam(const aName: string; aValue: TDateTime): IMVCRESTClient; overload;
function AddQueryStringParam(const aName: string; aValue: TDate): IMVCRESTClient; overload;
function AddQueryStringParam(const aName: string; aValue: TTime): IMVCRESTClient; overload;
function AddQueryStringParam(const aName: string; aValue: Double): IMVCRESTClient; overload;
function ClearQueryParams: IMVCRESTClient;
function Accept(const aAccept: string): IMVCRESTClient; overload;
function Accept: string; overload;
function AcceptCharset(const aAcceptCharset: string): IMVCRESTClient; overload;
function AcceptCharset: string; overload;
function AcceptEncoding(const aAcceptEncoding: string): IMVCRESTClient; overload;
function AcceptEncoding: string; overload;
function HandleRedirects(const aHandleRedirects: Boolean): IMVCRESTClient; overload;
function HandleRedirects: Boolean; overload;
function MaxRedirects(const aMaxRedirects: Integer): IMVCRESTClient; overload;
function MaxRedirects: Integer; overload;
function UserAgent(const aUserAgent: string): IMVCRESTClient; overload;
function UserAgent: string; overload;
function Resource(const aResource: string): IMVCRESTClient; overload;
function Resource: string; overload;
///
/// Add a body to the requisition.
///
///
/// Body in string format.
///
///
/// Body content type.
///
function AddBody(const aBody: string; const aContentType: string = ''): IMVCRESTClient; overload;
///
/// Add a body to the requisition
///
///
/// Body in Stream format
///
///
/// Body content type
///
///
/// If OwnsStream is true, Stream will be destroyed by IMVCRESTClient.
///
function AddBody(aBodyStream: TStream; const aOwnsStream: Boolean = True;
const aContentType: string = ''): IMVCRESTClient; overload;
///
/// Add a body to the requisition
///
///
/// Body in Object format. The object will be serialized to a JSON string.
///
///
/// If OwnsObject is true, BodyObject will be destroyed by IMVCRESTClient.
///
function AddBody(aBodyObject: TObject; const aOwnsObject: Boolean = True): IMVCRESTClient; overload;
///
/// Adds a file as the request body. Several files can be added in the same request. In this case the request
/// will be of the multipart/form-data type
///
///
/// Field name
///
///
/// File path
///
///
/// File content type
///
function AddFile(const aName, aFileName: string; const aContentType: string = ''): IMVCRESTClient; overload;
function AddFile(const aFileName: string; const aContentType: string = ''): IMVCRESTClient; overload;
{$IF defined(RIOORBETTER)}
function AddFile(const aName: string; aFileStreamValue: TStream; const aFileName: string = '';
const aContentType: string = ''): IMVCRESTClient; overload;
{$ENDIF}
function AddBodyFieldFormData(const aName, aValue: string): IMVCRESTClient; overload;
{$IF defined(RIOORBETTER)}
function AddBodyFieldFormData(const aName: string; aStreamValue: TStream;
const aContentType: string = ''): IMVCRESTClient; overload;
{$ENDIF}
///
/// Add a field to the x-www-form-urlencoded body. You must set ContentType to application/x-www-form-urlencoded
///
function AddBodyFieldURLEncoded(const aName, aValue: string): IMVCRESTClient;
function ClearBody: IMVCRESTClient;
///
/// Executes the next request asynchronously.
///
///
/// An anonymous method that will be run after the execution completed.
///
///
/// Specifies if aCompletioHandler will be run in the main thread's (True) or execution thread's (False) context.
///
///
/// An anonymous method that will be run if an exception is raised during execution.
///
function Async(aCompletionHandler: TProc; aCompletionHandlerWithError: TProc = nil;
const aSynchronized: Boolean = False): IMVCRESTClient;
///
/// Execute a Get request.
///
function Get(const aResource: string): IMVCRESTResponse; overload;
function Get: IMVCRESTResponse; overload;
///
/// Execute a Head request.
///
function Head(const aResource: string): IMVCRESTResponse; overload;
function Head: IMVCRESTResponse; overload;
///
/// Execute a Options request.
///
function Options(const aResource: string): IMVCRESTResponse; overload;
function Options: IMVCRESTResponse; overload;
///
/// Execute a Post request.
///
///
/// Resource path
///
///
/// Object to be serialized. It can be a simple object or a list of objects (TObjectList <T>)
///
///
/// If OwnsBody is true, Body will be destroyed by IMVCRESTClient.
///
function Post(const aResource: string; aBody: TObject; const aOwnsBody: Boolean = True): IMVCRESTResponse; overload;
function Post(const aResource: string; const aBody: string = '';
const aContentType: string = TMVCMediaType.APPLICATION_JSON): IMVCRESTResponse; overload;
function Post: IMVCRESTResponse; overload;
///
/// Execute a Patch request.
///
function Patch(const aResource: string; aBody: TObject;
const aOwnsBody: Boolean = True): IMVCRESTResponse; overload;
function Patch(const aResource: string; const aBody: string = '';
const aContentType: string = TMVCMediaType.APPLICATION_JSON): IMVCRESTResponse; overload;
function Patch: IMVCRESTResponse; overload;
///
/// Execute a Put request.
///
function Put(const aResource: string; aBody: TObject; const aOwnsBody: Boolean = True): IMVCRESTResponse; overload;
function Put(const aResource: string; const aBody: string = '';
const aContentType: string = TMVCMediaType.APPLICATION_JSON): IMVCRESTResponse; overload;
function Put: IMVCRESTResponse; overload;
///
/// Execute a Delete request.
///
function Delete(const aResource: string): IMVCRESTResponse; overload;
function Delete: IMVCRESTResponse; overload;
///
/// Executes any type of HTTP request
///
function Execute(const aMethod: TMVCHTTPMethodType; const aResource: string): IMVCRESTResponse; overload;
function Execute(const aMethod: TMVCHTTPMethodType): IMVCRESTResponse; overload;
///
/// Serialize the current dataset record and execute a POST request.
///
function DataSetInsert(const aResource: string; aDataSet: TDataSet; const aIgnoredFields: TMVCIgnoredList = [];
const aNameCase: TMVCNameCase = ncAsIs): IMVCRESTResponse;
///
/// Serialize the current dataset record and execute a PUT request.
///
function DataSetUpdate(const aResource, aKeyValue: string; aDataSet: TDataSet;
const aIgnoredFields: TMVCIgnoredList = []; const aNameCase: TMVCNameCase = ncAsIs): IMVCRESTResponse;
///
/// Delete the current dataset record by executing a delete request.
///
function DataSetDelete(const aResource, aKeyValue: string): IMVCRESTResponse;
///
/// Access the RESTClient serializer
///
function Serializer: IMVCSerializer; overload;
///
/// Add a serializer to the RESTClient
///
function Serializer(const aSerializer: IMVCSerializer): IMVCRESTClient; overload;
///
/// Register a custom serializer to the RESTClient serializer.
///
function RegisterTypeSerializer(const aTypeInfo: PTypeInfo; aInstance: IMVCTypeSerializer): IMVCRESTClient;
end;
///
/// Provides access to the REST request response.
///
TMVCRESTResponse = class(TInterfacedObject, IMVCRESTResponse)
private
fRESTClient: IMVCRESTClient;
fSuccess: Boolean;
fStatusCode: Integer;
fStatusText: string;
fHeaders: TStrings;
fCookies: TCookies;
fServer: string;
fContentType: string;
fContentEncoding: string;
fContentLength: Integer;
fContent: string;
fContentRawBytes: TBytes;
procedure FillResponse(const aHTTPResponse: IHTTPResponse);
public
constructor Create(const aRESTClient: IMVCRESTClient; const aHTTPResponse: IHTTPResponse);
destructor Destroy; override;
{ IMVCRESTResponse }
function Success: Boolean;
function StatusCode: Integer;
function StatusText: string;
function Headers: TStrings;
function HeaderValue(const aName: string): string;
function Cookies: TCookies;
function CookieByName(const aName: string; const RaiseExceptionIfNotFound: Boolean = False): TCookie;
function Server: string;
function ContentType: string;
function ContentEncoding: string;
function ContentLength: Integer;
function Content: string;
function ContentRawBytes: TBytes;
procedure SaveContentToStream(aStream: TStream);
procedure SaveContentToFile(const aFileName: string);
function ToJSONObject: TJDOJsonObject;
function ToJSONArray: TJDOJsonArray;
procedure BodyFor(const aObject: TObject; const aRootNode: string = '');
procedure BodyForListOf(const aObjectList: TObject; const aObjectClass: TClass; const aRootNode: string = '');
end;
implementation
uses
System.NetConsts,
System.NetEncoding,
MVCFramework.Serializer.JsonDataObjects,
System.RegularExpressions;
{$IF not defined(RIOORBETTER)}
type
TCookieManagerHelper = class helper for TCookieManager
private
function CookieList: TCookies;
end;
{$ENDIF}
{ TMVCRESTClient }
function TMVCRESTClient.Accept: string;
begin
Result := HeaderValue(sAccept);
end;
function TMVCRESTClient.Accept(const aAccept: string): IMVCRESTClient;
begin
Result := AddHeader(sAccept, aAccept);
end;
function TMVCRESTClient.AcceptCharset: string;
begin
Result := HeaderValue(sAcceptCharset);
end;
function TMVCRESTClient.AcceptCharset(const aAcceptCharset: string): IMVCRESTClient;
begin
Result := AddHeader(sAcceptCharset, aAcceptCharset);
end;
function TMVCRESTClient.AcceptEncoding(const aAcceptEncoding: string): IMVCRESTClient;
begin
Result := AddHeader(sAcceptEncoding, aAcceptEncoding);
end;
function TMVCRESTClient.AcceptEncoding: string;
begin
Result := HeaderValue(sAcceptEncoding);
end;
function TMVCRESTClient.AddBody(const aBody: string; const aContentType: string): IMVCRESTClient;
var
lContentCharset: string;
lEncoding: TEncoding;
lBytes: TArray;
lContentType: string;
begin
Result := Self;
SplitContentMediaTypeAndCharset(aContentType, lContentType, lContentCharset);
if lContentCharset.IsEmpty then
begin
lContentCharset := TMVCCharSet.UTF_8;
end;
lEncoding := TEncoding.GetEncoding(lContentCharset);
try
fRawBody.Clear;
lBytes := lEncoding.GetBytes(aBody);
fRawBody.WriteData(lBytes, Length(lBytes));
SetContentType(BuildContentType(lContentType, lContentCharset));
finally
FreeAndNil(lEncoding);
end;
end;
function TMVCRESTClient.AddBody(aBodyStream: TStream; const aOwnsStream: Boolean;
const aContentType: string): IMVCRESTClient;
begin
Result := Self;
if aBodyStream = nil then
raise EMVCRESTClientException.Create('You need a valid body!');
SetContentType(aContentType);
fRawBody.Clear;
fRawBody.CopyFrom(aBodyStream, 0);
if aOwnsStream then
FreeAndNil(aBodyStream);
end;
function TMVCRESTClient.AddBody(aBodyObject: TObject; const aOwnsObject: Boolean): IMVCRESTClient;
begin
if aBodyObject = nil then
raise EMVCRESTClientException.Create('You need a valid body!');
Result := AddBody(SerializeObject(aBodyObject), TMVCMediaType.APPLICATION_JSON);
if aOwnsObject then
aBodyObject.Free;
end;
function TMVCRESTClient.AddBodyFieldFormData(const aName, aValue: string): IMVCRESTClient;
begin
Result := Self;
GetBodyFormData.AddField(aName, aValue);
SetContentType(TMVCMediaType.MULTIPART_FORM_DATA);
end;
{$IF defined(RIOORBETTER)}
function TMVCRESTClient.AddBodyFieldFormData(const aName: string; aStreamValue: TStream;
const aContentType: string): IMVCRESTClient;
begin
Result := Self;
GetBodyFormData.AddStream(aName, aStreamValue, '', aContentType);
SetContentType(TMVCMediaType.MULTIPART_FORM_DATA);
end;
{$ENDIF}
function TMVCRESTClient.AddBodyFieldURLEncoded(const aName, aValue: string): IMVCRESTClient;
begin
Result := Self;
fParameters.Add(TMVCRESTParam.Create(TMVCRESTParamType.FormURLEncoded, aName, aValue));
SetContentType(TMVCMediaType.APPLICATION_FORM_URLENCODED);
end;
function TMVCRESTClient.AddCookie(const aName, aValue: string): IMVCRESTClient;
begin
Result := Self;
SetParameter(TMVCRESTParamType.Cookie, aName, aValue);
end;
function TMVCRESTClient.AddFile(const aFileName, aContentType: string): IMVCRESTClient;
begin
Result := AddFile(TMVCRESTClientConsts.DEFAULT_FILE_NAME, aFileName, aContentType);
end;
function TMVCRESTClient.AddFile(const aName, aFileName, aContentType: string): IMVCRESTClient;
begin
Result := Self;
GetBodyFormData.AddFile(aName, aFileName {$IF defined(RIOORBETTER)}, aContentType{$ENDIF});
SetContentType(TMVCMediaType.MULTIPART_FORM_DATA);
end;
{$IF defined(RIOORBETTER)}
function TMVCRESTClient.AddFile(const aName: string; aFileStreamValue: TStream; const aFileName, aContentType: string): IMVCRESTClient;
begin
Result := Self;
GetBodyFormData.AddStream(aName, aFileStreamValue, aFileName, aContentType);
SetContentType(TMVCMediaType.MULTIPART_FORM_DATA);
end;
{$ENDIF}
function TMVCRESTClient.AddHeader(const aName, aValue: string): IMVCRESTClient;
begin
Result := Self;
SetParameter(TMVCRESTParamType.Header, aName, aValue);
end;
function TMVCRESTClient.AddPathParam(const aName: string; aValue: Double): IMVCRESTClient;
begin
Result := AddPathParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AddPathParam(const aName, aValue: string): IMVCRESTClient;
begin
Result := Self;
SetParameter(TMVCRESTParamType.Path, aName, aValue);
end;
function TMVCRESTClient.AddPathParam(const aName: string; aValue: TDate): IMVCRESTClient;
begin
Result := AddPathParam(aName, DateToISODate(aValue));
end;
function TMVCRESTClient.AddPathParam(const aName: string; aValue: TTime): IMVCRESTClient;
begin
Result := AddPathParam(aName, TimeToISOTime(aValue));
end;
function TMVCRESTClient.AddPathParam(const aName: string; aValue: TDateTime): IMVCRESTClient;
begin
Result := AddPathParam(aName, DateTimeToISOTimeStamp(aValue));
end;
function TMVCRESTClient.AddPathParam(const aName: string; aValue: Int64): IMVCRESTClient;
begin
Result := AddPathParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AddPathParam(const aName: string; aValue: TGUID): IMVCRESTClient;
begin
Result := AddPathParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AddPathParam(const aName: string; aValue: Integer): IMVCRESTClient;
begin
Result := AddPathParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AddQueryStringParam(const aName: string; aValue: Double): IMVCRESTClient;
begin
Result := AddQueryStringParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AddQueryStringParam(const aName: string; aValue: TTime): IMVCRESTClient;
begin
Result := AddQueryStringParam(aName, TimeToISOTime(aValue));
end;
function TMVCRESTClient.AddQueryStringParam(const aName: string; aValue: TDate): IMVCRESTClient;
begin
Result := AddQueryStringParam(aName, DateToISODate(aValue));
end;
function TMVCRESTClient.AddQueryStringParam(const aName: string; aValue: TDateTime): IMVCRESTClient;
begin
Result := AddQueryStringParam(aName, DateTimeToISOTimeStamp(aValue));
end;
function TMVCRESTClient.AddQueryStringParam(const aName: string; aValue: TGUID): IMVCRESTClient;
begin
Result := AddQueryStringParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AddQueryStringParam(const aName: string; aValue: Int64): IMVCRESTClient;
begin
Result := AddQueryStringParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AddQueryStringParam(const aName, aValue: string): IMVCRESTClient;
begin
Result := Self;
SetParameter(TMVCRESTParamType.Query, aName, aValue);
end;
function TMVCRESTClient.AddQueryStringParam(const aName: string; aValue: Integer): IMVCRESTClient;
begin
Result := AddQueryStringParam(aName, aValue.ToString);
end;
function TMVCRESTClient.AllowCookies: Boolean;
begin
Result := fHTTPClient.AllowCookies;
end;
function TMVCRESTClient.AllowCookies(const aAllowCookies: Boolean): IMVCRESTClient;
begin
Result := Self;
fHTTPClient.AllowCookies := aAllowCookies;
end;
function TMVCRESTClient.Async(aCompletionHandler: TProc;
aCompletionHandlerWithError: TProc; const aSynchronized: Boolean): IMVCRESTClient;
begin
Result := Self;
fNextRequestIsAsync := True;
fAsyncCompletionHandler := aCompletionHandler;
fAsyncCompletionHandlerWithError := aCompletionHandlerWithError;
fAsyncSynchronized := aSynchronized;
end;
function TMVCRESTClient.Authorization: string;
begin
Result := HeaderValue(TMVCRESTClientConsts.AUTHORIZATION_HEADER);
end;
function TMVCRESTClient.BaseURL(const aBaseURL: string): IMVCRESTClient;
begin
Result := Self;
fBaseURL := InsertHTTPSchema(aBaseURL);
end;
function TMVCRESTClient.BaseURL(const aHost: string; const aPort: Integer): IMVCRESTClient;
begin
Result := BaseURL(aHost + ':' + aPort.ToString);
end;
function TMVCRESTClient.BaseURL: string;
begin
Result := fBaseURL;
end;
function TMVCRESTClient.ClearAllParams: IMVCRESTClient;
var
lAuthorization: string;
begin
Result := Self;
lAuthorization := HeaderValue(TMVCRESTClientConsts.AUTHORIZATION_HEADER);
fParameters.Clear;
ClearBody;
AddHeader(sAccept, TMVCRESTClientConsts.DEFAULT_ACCEPT);
AddHeader(sAcceptEncoding, TMVCRESTClientConsts.DEFAULT_ACCEPT_ENCODING);
AddHeader(sUserAgent, TMVCRESTClientConsts.DEFAULT_USER_AGENT);
AddHeader(TMVCRESTClientConsts.AUTHORIZATION_HEADER, lAuthorization);
fNextRequestIsAsync := False;
fAsyncCompletionHandler := nil;
fAsyncCompletionHandlerWithError := nil;
fAsyncSynchronized := False;
end;
function TMVCRESTClient.ClearAuthorization: IMVCRESTClient;
begin
Result := Self;
AddHeader(TMVCRESTClientConsts.AUTHORIZATION_HEADER, '');
end;
function TMVCRESTClient.ClearBody: IMVCRESTClient;
begin
fRawBody.Clear;
if Assigned(fBodyFormData) then
FreeAndNil(fBodyFormData);
Result := Self;
ClearParameters(TMVCRESTParamType.FormURLEncoded);
AddHeader(sContentType, '');
end;
function TMVCRESTClient.ClearCookies: IMVCRESTClient;
begin
Result := Self;
ClearParameters(TMVCRESTParamType.Cookie);
{$IF defined(RIOORBETTER)}
fHTTPClient.CookieManager.Clear;
{$ELSE}
if fHTTPClient.CookieManager.CookieList <> nil then
fHTTPClient.CookieManager.CookieList.Clear;
{$ENDIF}
end;
function TMVCRESTClient.ClearHeaders: IMVCRESTClient;
begin
Result := Self;
ClearParameters(TMVCRESTParamType.Header);
end;
procedure TMVCRESTClient.ClearParameters(const aParamType: TMVCRESTParamType);
var
I: Integer;
begin
for I := Pred(fParameters.Count) downto 0 do
begin
if fParameters[I].&Type = aParamType then
fParameters.Delete(I);
end;
end;
function TMVCRESTClient.ClearPathParams: IMVCRESTClient;
begin
Result := Self;
ClearParameters(TMVCRESTParamType.Path);
end;
function TMVCRESTClient.ClearQueryParams: IMVCRESTClient;
begin
Result := Self;
ClearParameters(TMVCRESTParamType.Query);
end;
{$IF defined(BERLINORBETTER)}
function TMVCRESTClient.ConnectTimeout: Integer;
begin
Result := fHTTPClient.ConnectionTimeout;
end;
function TMVCRESTClient.ConnectTimeout(const aConnectTimeout: Integer): IMVCRESTClient;
begin
Result := Self;
fHTTPClient.ConnectionTimeout := aConnectTimeout;
end;
{$ENDIF}
constructor TMVCRESTClient.Create;
begin
inherited Create;
fHTTPClient := THTTPClient.Create;
fHTTPClient.OnNeedClientCertificate := DoNeedClientCertificate;
fHTTPClient.OnValidateServerCertificate := DoValidateServerCertificate;
fHTTPClient.HandleRedirects := True;
fHTTPClient.MaxRedirects := TMVCRESTClientConsts.DEFAULT_MAX_REDIRECTS;
{$IF defined(TOKYOORBETTER)}
fHTTPClient.SecureProtocols := CHTTPDefSecureProtocols;
{$ENDIF}
fNeedClientCertificate := nil;
fValidateServerCertificate := nil;
fBeforeRequestProc := nil;
fRequestCompletedProc := nil;
fResponseCompletedProc := nil;
fParameters := TList.Create;
fRawBody := TMemoryStream.Create;
fBodyFormData := nil;
fSerializer := nil;
fRttiContext := TRttiContext.Create;
fLock := TObject.Create;
fBaseURL := '';
fResource := '';
fClientCertificate := nil;
fClientCertPassword := '';
fClientCertPath := '';
ClearAllParams;
end;
function TMVCRESTClient.DataSetDelete(const aResource, aKeyValue: string): IMVCRESTResponse;
var
lResource: string;
begin
lResource := aResource;
if not aKeyValue.IsEmpty then
begin
lResource := aResource + '/' + aKeyValue;
end;
Result := Delete(lResource);
end;
function TMVCRESTClient.DataSetInsert(const aResource: string; aDataSet: TDataSet;
const aIgnoredFields: TMVCIgnoredList; const aNameCase: TMVCNameCase): IMVCRESTResponse;
begin
Result := Post(aResource, Serializer.SerializeDataSetRecord(aDataSet, aIgnoredFields, aNameCase));
end;
function TMVCRESTClient.DataSetUpdate(const aResource, aKeyValue: string; aDataSet: TDataSet;
const aIgnoredFields: TMVCIgnoredList; const aNameCase: TMVCNameCase): IMVCRESTResponse;
var
lResource: string;
begin
lResource := aResource;
if not aKeyValue.IsEmpty then
begin
lResource := aResource + '/' + aKeyValue;
end;
Result := Put(lResource, Serializer.SerializeDataSetRecord(aDataSet, aIgnoredFields, aNameCase));
end;
function TMVCRESTClient.Delete(const aResource: string): IMVCRESTResponse;
begin
Resource(aResource);
Result := Delete;
end;
function TMVCRESTClient.Delete: IMVCRESTResponse;
begin
Result := ExecuteRequest(TMVCHTTPMethodType.httpDELETE);
end;
destructor TMVCRESTClient.Destroy;
begin
FreeAndNil(fHTTPClient);
FreeAndNil(fParameters);
if Assigned(fBodyFormData) then
FreeAndNil(fBodyFormData);
FreeAndNil(fRawBody);
FreeAndNil(fLock);
fSerializer := nil;
fRttiContext.Free;
inherited;
end;
procedure TMVCRESTClient.DoApplyCookies(const aURL: string);
var
lParam: TMVCRESTParam;
lName: string;
lValue: string;
begin
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.Cookie then
begin
lName := TMVCRESTClientHelper.URIEncode(lParam.Name);
lValue := TMVCRESTClientHelper.URIEncode(lParam.Value);
fHTTPClient.CookieManager.AddServerCookie(lName + '=' + lValue, aURL);
end;
end;
end;
{$IF not defined(SYDNEYORBETTER)}
type
THackURLClient = class(TURLClient);
{$ENDIF}
procedure TMVCRESTClient.DoApplyHeaders;
var
lParam: TMVCRESTParam;
begin
{$IF defined(SYDNEYORBETTER)}
fHTTPClient.CustHeaders.Clear;
{$ELSE}
SetLength(THackURLClient(fHTTPClient).FCustomHeaders, 0);
{$ENDIF}
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.Header then
begin
fHTTPClient.CustomHeaders[lParam.Name] := lParam.Value;
end;
end;
end;
procedure TMVCRESTClient.DoApplyPathParams(var aURL: string);
var
lParam: TMVCRESTParam;
lReplace: string;
lEncodedParam: string;
begin
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.Path then
begin
lReplace := '{' + lParam.Name + '}';
lEncodedParam := TNetEncoding.URL.Encode(lParam.Value
{$IF defined(BERLINORBETTER)}
,TMVCRESTClientConsts.PATH_UNSAFE_CHARS, [TURLEncoding.TEncodeOption.EncodePercent]
{$ENDIF}
);
aURL := aURL.Replace(lReplace, lEncodedParam, [rfReplaceAll, rfIgnoreCase]);
end;
end;
end;
procedure TMVCRESTClient.DoApplyQueryParams(var aURL: string);
var
lParam: TMVCRESTParam;
lName: string;
lValue: string;
lConcat: string;
begin
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.Query then
begin
lName := TMVCRESTClientHelper.URIEncode(lParam.Name);
{$IF defined(BERLINORBETTER)}
lValue := TNetEncoding.URL.EncodeForm(lParam.Value);
{$ELSE}
lValue := TNetEncoding.URL.Encode(lParam.Value);
{$ENDIF}
if aURL.Contains('?') then
lConcat := '&'
else
lConcat := '?';
aURL := aURL + lConcat + lName + '=' + lValue;
end;
end;
end;
procedure TMVCRESTClient.DoBeforeRequest(aRequest: IHTTPRequest);
begin
if Assigned(fBeforeRequestProc) then
fBeforeRequestProc(aRequest);
end;
procedure TMVCRESTClient.DoConvertMVCPathParamsToRESTParams(var aURL: string);
begin
aURL := TRegEx.Replace(aURL, '(\([($])([\w_]+)([)])', '{\2}', [TRegExOption.roIgnoreCase]);
end;
procedure TMVCRESTClient.DoEncodeURL(var aURL: string);
begin
// It is necessary to encode the dots because the HTTPClient removes dotted URL segments.
// See https://tools.ietf.org/html/rfc3986#section-5.2.4
aURL := aURL.Replace('\', '/', [rfReplaceAll]);
aURL := aURL.Replace('../', '%2E%2E/', [rfReplaceAll]);
aURL := aURL.Replace('./', '%2E/', [rfReplaceAll]);
{$IF defined(RIOORBETTER)}
aURL := TURI.Create(aURL).Encode;
{$ELSE}
aURL := TURI.Create(aURL).ToString;
{$ENDIF}
end;
procedure TMVCRESTClient.DoNeedClientCertificate(const aSender: TObject; const aRequest: TURLRequest; const aCertificateList: TCertificateList; var aIndex: Integer);
begin
if Assigned(fNeedClientCertificate) then
fNeedClientCertificate(aSender, aRequest, aCertificateList, aIndex);
end;
procedure TMVCRESTClient.DoPrepareBodyRequest(var aBodyStream: TStream);
var
lCurrentContentType: string;
lContentType: string;
lContentCharset: string;
lParam: TMVCRESTParam;
lName: string;
lValue: string;
lBody: string;
begin
lCurrentContentType := HeaderValue(sContentType);
SplitContentMediaTypeAndCharset(lCurrentContentType, lContentType, lContentCharset);
if SameText(lContentType, TMVCMediaType.MULTIPART_FORM_DATA) then
begin
aBodyStream := GetBodyFormData.Stream;
SetContentType(GetBodyFormData.MimeTypeHeader);
end
else if SameText(lContentType, TMVCMediaType.APPLICATION_FORM_URLENCODED) then
begin
lBody := '';
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.FormURLEncoded then
begin
lName := TMVCRESTClientHelper.URIEncode(lParam.Name);
{$IF defined(BERLINORBETTER)}
lValue := TNetEncoding.URL.EncodeForm(lParam.Value);
{$ELSE}
lValue := TNetEncoding.URL.Encode(lParam.Value);
{$ENDIF}
if not lBody.IsEmpty then
lBody := lBody + '&';
lBody := lBody + lName + '=' + lValue;
end;
end;
AddBody(lBody, lCurrentContentType);
aBodyStream := fRawBody;
end
else
begin
aBodyStream := fRawBody;
end;
aBodyStream.Position := 0;
end;
procedure TMVCRESTClient.DoRequestCompleted(aResponse: IHTTPResponse; var aHandled: Boolean);
begin
if Assigned(fRequestCompletedProc) then
fRequestCompletedProc(aResponse, aHandled);
end;
procedure TMVCRESTClient.DoResponseCompleted(aMVCRESTResponse: IMVCRESTResponse);
begin
if Assigned(fResponseCompletedProc) then
fResponseCompletedProc(aMVCRESTResponse);
end;
function TMVCRESTClient.Execute(const aMethod: TMVCHTTPMethodType): IMVCRESTResponse;
begin
Result := ExecuteRequest(aMethod);
end;
function TMVCRESTClient.Execute(const aMethod: TMVCHTTPMethodType; const aResource: string): IMVCRESTResponse;
begin
Resource(aResource);
Result := Execute(aMethod);
end;
procedure TMVCRESTClient.ExecuteAsyncRequest(const aMethod: TMVCHTTPMethodType);
var
lThread: TThread;
lRESTClient: IMVCRESTClient;
begin
// This is necessary for the thread to be able to access the RESTClient fields
lRESTClient := Self;
lThread := TThread.CreateAnonymousThread(
procedure
var
lResponse: IMVCRESTResponse;
begin
try
lResponse := TMVCRESTClient(lRESTClient).InternalExecuteRequest(aMethod);
TMonitor.Enter(TObject(lResponse));
try
if Assigned(fAsyncCompletionHandler) then
begin
if fAsyncSynchronized then
begin
TThread.Synchronize(nil,
procedure
begin
fAsyncCompletionHandler(lResponse);
end
);
end
else
begin
fAsyncCompletionHandler(lResponse);
end;
end;
finally
TMonitor.Exit(TObject(lResponse));
end;
except
on E: Exception do
begin
if Assigned(fAsyncCompletionHandlerWithError) then
begin
if fAsyncSynchronized then
begin
TThread.Synchronize(nil,
procedure
begin
fAsyncCompletionHandlerWithError(E);
end
);
end
else
begin
fAsyncCompletionHandlerWithError(E);
end;
end;
end;
end;
ClearAllParams;
end
);
lThread.Start;
end;
function TMVCRESTClient.ExecuteRequest(const aMethod: TMVCHTTPMethodType): IMVCRESTResponse;
begin
if fNextRequestIsAsync then
begin
Result := nil;
ExecuteAsyncRequest(aMethod);
end
else
begin
Result := InternalExecuteRequest(aMethod);
ClearAllParams;
end;
end;
function TMVCRESTClient.Get: IMVCRESTResponse;
begin
Result := ExecuteRequest(TMVCHTTPMethodType.httpGET);
end;
function TMVCRESTClient.GetBodyFormData: TMultipartFormData;
begin
if not Assigned(fBodyFormData) then
begin
fBodyFormData := TMultipartFormData.Create;
end;
Result := fBodyFormData;
end;
function TMVCRESTClient.GetFullURL: string;
var
lResource: string;
begin
Result := fBaseURL;
lResource := fResource;
if not lResource.IsEmpty then
begin
if not (Result.IsEmpty or Result.EndsWith('/')) and
not CharInSet(lResource.Chars[0], ['/', '?', '#']) then
begin
Result := Result + '/';
end;
Result := Result + lResource;
end;
Result := InsertHTTPSchema(Result);
end;
function TMVCRESTClient.Get(const aResource: string): IMVCRESTResponse;
begin
Resource(aResource);
Result := ExecuteRequest(TMVCHTTPMethodType.httpGET);
end;
function TMVCRESTClient.HandleRedirects(const aHandleRedirects: Boolean): IMVCRESTClient;
begin
Result := Self;
fHTTPClient.HandleRedirects := aHandleRedirects;
end;
function TMVCRESTClient.HandleRedirects: Boolean;
begin
Result := fHTTPClient.HandleRedirects;
end;
function TMVCRESTClient.Head: IMVCRESTResponse;
begin
Result := ExecuteRequest(TMVCHTTPMethodType.httpHEAD);
end;
function TMVCRESTClient.Head(const aResource: string): IMVCRESTResponse;
begin
Resource(aResource);
Result := Head;
end;
function TMVCRESTClient.Headers: TNameValueArray;
var
lHeaders: TList;
lParam: TMVCRESTParam;
begin
lHeaders := TList.Create;
try
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.Header then
begin
lHeaders.Add(TNameValuePair.Create(lParam.Name, lParam.Value));
end;
end;
Result := lHeaders.ToArray;
finally
FreeAndNil(lHeaders);
end;
end;
function TMVCRESTClient.HeaderValue(const aName: string): string;
var
lParam: TMVCRESTParam;
begin
Result := '';
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.Header then
begin
if SameText(lParam.Name, aName) then
Exit(lParam.Value);
end;
end;
end;
function TMVCRESTClient.HTTPMethodName(const aHTTPMethod: TMVCHTTPMethodType): string;
begin
case aHTTPMethod of
httpGET:
Result := 'GET';
httpPOST:
Result := 'POST';
httpPUT:
Result := 'PUT';
httpDELETE:
Result := 'DELETE';
httpHEAD:
Result := 'HEAD';
httpOPTIONS:
Result := 'OPTIONS';
httpPATCH:
Result := 'PATCH';
httpTRACE:
Result := 'TRACE';
end;
end;
function TMVCRESTClient.InsertHTTPSchema(const aURL: string): string;
begin
Result := aURL;
if not (Result.IsEmpty or Result.Contains('://')) then
Result := 'http://' + Result;
end;
function TMVCRESTClient.InternalExecuteRequest(const aMethod: TMVCHTTPMethodType): IMVCRESTResponse;
var
lURL: string;
lResponse: IHTTPResponse;
lBodyStream: TStream;
lURI: TURI;
lRequest: IHTTPRequest;
lHandled: Boolean;
begin
fHTTPClient.ProxySettings := fProxySettings;
lURL := GetFullURL;
DoConvertMVCPathParamsToRESTParams(lURL);
DoApplyPathParams(lURL);
DoApplyQueryParams(lURL);
DoEncodeURL(lURL);
DoApplyCookies(lURL);
lURI := TURI.Create(lURL);
lBodyStream := nil;
DoPrepareBodyRequest(lBodyStream);
DoApplyHeaders;
lRequest := fHTTPClient.GetRequest(HTTPMethodName(aMethod), lURI);
lRequest.SourceStream := lBodyStream;
if Assigned(fClientCertificate) then
begin
lRequest.SetClientCertificate(fClientCertificate, fClientCertPassword);
end
{$IF defined(TOKYOORBETTER)}
else if not fClientCertPath.IsEmpty then
begin
lRequest.SetClientCertificate(fClientCertPath, fClientCertPassword);
end
{$ENDIF}
;
DoBeforeRequest(lRequest);
try
lResponse := fHTTPClient.Execute(lRequest, nil, []);
except
on E: Exception do
begin
raise EMVCRESTClientException.Create(E.Message);
end;
end;
lHandled := False;
DoRequestCompleted(lResponse, lHandled);
if not lHandled then
begin
Result := TMVCRESTResponse.Create(Self, lResponse);
DoResponseCompleted(Result);
end
else
begin
Result := nil;
end;
end;
function TMVCRESTClient.MaxRedirects(const aMaxRedirects: Integer): IMVCRESTClient;
begin
Result := Self;
fHTTPClient.MaxRedirects := aMaxRedirects;
end;
function TMVCRESTClient.MaxRedirects: Integer;
begin
Result := fHTTPClient.MaxRedirects;
end;
class function TMVCRESTClient.New: IMVCRESTClient;
begin
Result := TMVCRESTClient.Create;
end;
function TMVCRESTClient.ObjectIsList(aObject: TObject): Boolean;
begin
Result := fRttiContext.GetType(aObject.ClassType).GetMethod('GetEnumerator') <> nil;
end;
function TMVCRESTClient.Options: IMVCRESTResponse;
begin
Result := ExecuteRequest(TMVCHTTPMethodType.httpOPTIONS);
end;
function TMVCRESTClient.Options(const aResource: string): IMVCRESTResponse;
begin
Resource(aResource);
Result := Options;
end;
procedure TMVCRESTClient.DoValidateServerCertificate(const aSender: TObject; const aRequest: TURLRequest;
const aCertificate: TCertificate; var aAccepted: Boolean);
begin
if Assigned(fValidateServerCertificate) then
fValidateServerCertificate(aSender, aRequest, aCertificate, aAccepted)
else
aAccepted := True;
end;
function TMVCRESTClient.Patch(const aResource, aBody: string; const aContentType: string): IMVCRESTResponse;
begin
Resource(aResource);
if not aBody.isEmpty then
begin
ClearBody;
AddBody(aBody, aContentType);
end;
Result := Patch;
end;
function TMVCRESTClient.Patch: IMVCRESTResponse;
begin
Result := ExecuteRequest(TMVCHTTPMethodType.httpPATCH);
end;
function TMVCRESTClient.Patch(const aResource: string; aBody: TObject; const aOwnsBody: Boolean): IMVCRESTResponse;
begin
if aBody = nil then
raise EMVCRESTClientException.Create('You need a valid body!');
Result := Patch(aResource, SerializeObject(aBody));
if aOwnsBody then
aBody.Free;
end;
function TMVCRESTClient.Post(const aResource, aBody, aContentType: string): IMVCRESTResponse;
begin
Resource(aResource);
if not aBody.IsEmpty then
begin
ClearBody;
AddBody(aBody, aContentType);
end;
Result := Post;
end;
function TMVCRESTClient.Post(const aResource: string; aBody: TObject; const aOwnsBody: Boolean): IMVCRESTResponse;
begin
if aBody = nil then
raise EMVCRESTClientException.Create('You need a valid body!');
Result := Post(aResource, SerializeObject(aBody));
if aOwnsBody then
aBody.Free;
end;
function TMVCRESTClient.Post: IMVCRESTResponse;
begin
Result := ExecuteRequest(TMVCHTTPMethodType.httpPOST);
end;
function TMVCRESTClient.ProxyPassword: string;
begin
Result := fProxySettings.Password;
end;
function TMVCRESTClient.ProxyPassword(const aProxyPassword: string): IMVCRESTClient;
begin
Result := Self;
fProxySettings.Password := aProxyPassword;
end;
function TMVCRESTClient.ProxyPort: Integer;
begin
Result := fProxySettings.Port;
end;
function TMVCRESTClient.ProxyPort(const aProxyPort: Integer): IMVCRESTClient;
begin
Result := Self;
fProxySettings.Port := aProxyPort;
end;
function TMVCRESTClient.ProxyServer(const aProxyServer: string): IMVCRESTClient;
begin
Result := Self;
fProxySettings.Host := aProxyServer;
end;
function TMVCRESTClient.ProxyScheme: string;
begin
Result := fProxySettings.Scheme;
end;
function TMVCRESTClient.ProxyScheme(const aProxyScheme: string): IMVCRESTClient;
begin
fProxySettings.Scheme := aProxyScheme;
Result := Self;
end;
function TMVCRESTClient.ProxyServer: string;
begin
Result := fProxySettings.Host;
end;
function TMVCRESTClient.ProxyUsername(const aProxyUsername: string): IMVCRESTClient;
begin
Result := Self;
fProxySettings.UserName := aProxyUsername;
end;
function TMVCRESTClient.ProxyUsername: string;
begin
Result := fProxySettings.UserName;
end;
function TMVCRESTClient.Put: IMVCRESTResponse;
begin
Result := ExecuteRequest(TMVCHTTPMethodType.httpPUT);
end;
function TMVCRESTClient.Put(const aResource, aBody, aContentType: string): IMVCRESTResponse;
begin
Resource(aResource);
if not aBody.IsEmpty then
begin
ClearBody;
AddBody(aBody, aContentType);
end;
Result := Put;
end;
function TMVCRESTClient.Put(const aResource: string; aBody: TObject; const aOwnsBody: Boolean): IMVCRESTResponse;
begin
if aBody = nil then
raise EMVCRESTClientException.Create('You need a valid body!');
Result := Put(aResource, SerializeObject(aBody));
if aOwnsBody then
aBody.Free;
end;
{$IF defined(BERLINORBETTER)}
function TMVCRESTClient.ReadTimeout: Integer;
begin
Result := fHTTPClient.ResponseTimeout;
end;
function TMVCRESTClient.ReadTimeout(const aReadTimeout: Integer): IMVCRESTClient;
begin
Result := Self;
fHTTPClient.ResponseTimeout := aReadTimeout;
end;
{$ENDIF}
function TMVCRESTClient.RegisterTypeSerializer(const aTypeInfo: PTypeInfo;
aInstance: IMVCTypeSerializer): IMVCRESTClient;
begin
Result := Self;
Serializer.RegisterTypeSerializer(aTypeInfo, aInstance);
end;
function TMVCRESTClient.Resource(const aResource: string): IMVCRESTClient;
begin
Result := Self;
fResource := aResource;
end;
function TMVCRESTClient.Resource: string;
begin
Result := fResource;
end;
{$IF defined(TOKYOORBETTER)}
function TMVCRESTClient.SecureProtocols: THTTPSecureProtocols;
begin
Result := fHTTPClient.SecureProtocols;
end;
function TMVCRESTClient.SecureProtocols(const aSecureProtocols: THTTPSecureProtocols): IMVCRESTClient;
begin
Result := Self;
fHTTPClient.SecureProtocols := aSecureProtocols;
end;
{$ENDIF}
function TMVCRESTClient.SerializeObject(aObject: TObject): string;
begin
if ObjectIsList(aObject) then
Result := Serializer.SerializeCollection(aObject)
else
Result := Serializer.SerializeObject(aObject);
end;
function TMVCRESTClient.Serializer(const aSerializer: IMVCSerializer): IMVCRESTClient;
begin
Result := Self;
TMonitor.Enter(fLock);
try
fSerializer := nil;
fSerializer := aSerializer;
finally
TMonitor.Exit(fLock);
end;
end;
function TMVCRESTClient.Serializer: IMVCSerializer;
begin
if not Assigned(fSerializer) then
begin
TMonitor.Enter(fLock);
try
if not Assigned(fSerializer) then
begin
fSerializer := TMVCJsonDataObjectsSerializer.Create;
end;
finally
TMonitor.Exit(fLock);
end;
end;
Result := fSerializer;
end;
function TMVCRESTClient.SessionId: string;
var
lCookie: TCookie;
lParam: TMVCRESTParam;
begin
Result := '';
for lParam in fParameters do
begin
if lParam.&Type = TMVCRESTParamType.Cookie then
begin
if SameText(lParam.Name, TMVCConstants.SESSION_TOKEN_NAME) then
begin
Result := lParam.Value;
Break;
end;
end;
end;
if Result.IsEmpty then
begin
for lCookie in fHTTPClient.CookieManager.Cookies do
begin
if SameText(lCookie.Name, TMVCConstants.SESSION_TOKEN_NAME) then
begin
Result := lCookie.Value;
Break;
end;
end;
Result := lCookie.Value;
end;
if Result.Contains('invalid') then
Result := '';
end;
function TMVCRESTClient.SessionId(const aSessionId: string): IMVCRESTClient;
begin
Result := Self;
AddCookie(TMVCConstants.SESSION_TOKEN_NAME, aSessionId);
end;
function TMVCRESTClient.SetBasicAuthorization(const aUsername, aPassword: string): IMVCRESTClient;
var
lBase64: TNetEncoding;
begin
Result := Self;
// Do not use TNetEncoding.Base64 here, because it may break long line
lBase64 := TBase64Encoding.Create(0, '');
try
AddHeader(TMVCRESTClientConsts.AUTHORIZATION_HEADER,
TMVCRESTClientConsts.BASIC_AUTH_PREFIX + lBase64.Encode(aUsername + ':' + aPassword));
finally
FreeAndNil(lBase64);
end;
end;
function TMVCRESTClient.SetBearerAuthorization(const aAccessToken: string): IMVCRESTClient;
begin
Result := AddHeader(TMVCRESTClientConsts.AUTHORIZATION_HEADER,
TMVCRESTClientConsts.BEARER_AUTH_PREFIX + aAccessToken);
end;
function TMVCRESTClient.SetBeforeRequestProc(aBeforeRequestProc: TBeforeRequestProc): IMVCRESTClient;
begin
Result := Self;
fBeforeRequestProc := aBeforeRequestProc;
end;
{$IF defined(TOKYOORBETTER)}
function TMVCRESTClient.SetClientCertificate(const aCertPath, aPassword: string): IMVCRESTClient;
begin
Result := Self;
fClientCertPath := aCertPath;
fClientCertPassword := aPassword;
fClientCertificate := nil;
end;
{$ENDIF}
function TMVCRESTClient.SetClientCertificate(const aCertStream: TStream; const aPassword: string): IMVCRESTClient;
begin
Result := Self;
fClientCertPath := '';
fClientCertificate := aCertStream;
fClientCertPassword := aPassword;
end;
procedure TMVCRESTClient.SetContentType(const aContentType: string);
begin
AddHeader(sContentType, aContentType);
end;
function TMVCRESTClient.SetNeedClientCertificateProc(aNeedClientCertificateProc: TNeedClientCertificateProc): IMVCRESTClient;
begin
Result := Self;
fNeedClientCertificate := aNeedClientCertificateProc;
end;
procedure TMVCRESTClient.SetParameter(const aParamType: TMVCRESTParamType; const aName, aValue: string);
var
I: Integer;
begin
for I := Pred(fParameters.Count) downto 0 do
begin
if (fParameters[I].&Type = aParamType) and SameText(fParameters[I].Name, aName) then
begin
fParameters.Delete(I);
Break;
end;
end;
fParameters.Add(TMVCRESTParam.Create(aParamType, aName, aValue));
end;
function TMVCRESTClient.SetRequestCompletedProc(aRequestCompletedProc: TRequestCompletedProc): IMVCRESTClient;
begin
Result := Self;
fRequestCompletedProc := aRequestCompletedProc;
end;
function TMVCRESTClient.SetResponseCompletedProc(aResponseCompletedProc: TResponseCompletedProc): IMVCRESTClient;
begin
Result := Self;
fResponseCompletedProc := aResponseCompletedProc;
end;
function TMVCRESTClient.SetValidateServerCertificateProc(
aValidateCertificateProc: TValidateServerCertificateProc): IMVCRESTClient;
begin
Result := Self;
fValidateServerCertificate := aValidateCertificateProc;
end;
function TMVCRESTClient.UserAgent(const aUserAgent: string): IMVCRESTClient;
begin
Result := AddHeader(sUserAgent, aUserAgent);
end;
function TMVCRESTClient.UserAgent: string;
begin
Result := HeaderValue(sUserAgent);
end;
{ TMVCRESTResponse }
function TMVCRESTResponse.ToJSONArray: TJDOJsonArray;
begin
Result := StrTOJSONArray(fContent, True);
end;
function TMVCRESTResponse.ToJSONObject: TJDOJsonObject;
begin
Result := StrTOJSONObject(fContent, True);
end;
procedure TMVCRESTResponse.BodyFor(const aObject: TObject; const aRootNode: string);
begin
fRESTClient.Serializer.DeserializeObject(fContent, aObject, TMVCSerializationType.stDefault, [], aRootNode);
end;
procedure TMVCRESTResponse.BodyForListOf(const aObjectList: TObject; const aObjectClass: TClass; const aRootNode: string);
begin
fRESTClient.Serializer.DeserializeCollection(fContent, aObjectList, aObjectClass, TMVCSerializationType.stDefault, [], aRootNode);
end;
function TMVCRESTResponse.Content: string;
begin
Result := fContent;
end;
function TMVCRESTResponse.ContentEncoding: string;
begin
Result := fContentEncoding;
end;
function TMVCRESTResponse.ContentLength: Integer;
begin
Result := fContentLength;
end;
function TMVCRESTResponse.ContentType: string;
begin
Result := fContentType;
end;
function TMVCRESTResponse.CookieByName(const aName: string; const RaiseExceptionIfNotFound: Boolean): TCookie;
var
lCookie: TCookie;
begin
Result := Default (TCookie);
for lCookie in fCookies do
begin
if SameText(lCookie.Name, aName) then
Exit(lCookie);
end;
if RaiseExceptionIfNotFound then
begin
raise EMVCRESTClientException.CreateFmt('Cookie "%s" not found', [aName]);
end;
end;
function TMVCRESTResponse.Cookies: TCookies;
begin
Result := fCookies;
end;
constructor TMVCRESTResponse.Create(const aRESTClient: IMVCRESTClient; const aHTTPResponse: IHTTPResponse);
begin
fHeaders := TStringList.Create;
SetLength(fContentRawBytes, 0);
fCookies := TCookies.Create;
fRESTClient := aRESTClient;
FillResponse(aHTTPResponse);
end;
destructor TMVCRESTResponse.Destroy;
begin
SetLength(fContentRawBytes, 0);
FreeAndNil(fHeaders);
FreeAndNil(fCookies);
inherited Destroy;
end;
procedure TMVCRESTResponse.FillResponse(const aHTTPResponse: IHTTPResponse);
var
lHeader: TNetHeader;
begin
fSuccess := (aHTTPResponse.StatusCode >= 200) and (aHTTPResponse.StatusCode < 300);
fStatusCode := aHTTPResponse.StatusCode;
fStatusText := aHTTPResponse.StatusText;
for lHeader in aHTTPResponse.Headers do
begin
fHeaders.Values[lHeader.Name] := lHeader.Value;
end;
fCookies.AddRange(aHTTPResponse.Cookies.ToArray);
fServer := aHTTPResponse.HeaderValue[TMVCRESTClientConsts.SERVER_HEADER];
fContentRawBytes := TMVCRESTClientHelper.GetResponseContentAsRawBytes(aHTTPResponse.ContentStream,
aHTTPResponse.ContentEncoding);
fContent := TMVCRESTClientHelper.GetResponseContentAsString(fContentRawBytes,
aHTTPResponse.HeaderValue[sContentType]);
fContentType := aHTTPResponse.HeaderValue[sContentType];
fContentEncoding := aHTTPResponse.ContentEncoding;
fContentLength := aHTTPResponse.ContentLength;
end;
function TMVCRESTResponse.Headers: TStrings;
begin
Result := fHeaders;
end;
function TMVCRESTResponse.HeaderValue(const aName: string): string;
begin
Result := fHeaders.Values[aName];
end;
function TMVCRESTResponse.ContentRawBytes: TBytes;
begin
Result := fContentRawBytes;
end;
procedure TMVCRESTResponse.SaveContentToFile(const aFileName: string);
var
lStream: TMemoryStream;
begin
lStream := TMemoryStream.Create;
try
lStream.Write(fContentRawBytes, Length(fContentRawBytes));
lStream.Position := 0;
lStream.SaveToFile(aFileName);
finally
FreeAndNil(lStream);
end;
end;
procedure TMVCRESTResponse.SaveContentToStream(aStream: TStream);
begin
if aStream = nil then
raise EMVCRESTClientException.Create('Stream not assigned!');
aStream.Write(fContentRawBytes, Length(fContentRawBytes));
end;
function TMVCRESTResponse.Server: string;
begin
Result := fServer;
end;
function TMVCRESTResponse.StatusCode: Integer;
begin
Result := fStatusCode;
end;
function TMVCRESTResponse.StatusText: string;
begin
Result := fStatusText;
end;
function TMVCRESTResponse.Success: Boolean;
begin
Result := fSuccess;
end;
{$IF not defined(RIOORBETTER)}
{ TCookieManagerHelper }
function TCookieManagerHelper.CookieList: TCookies;
var
lRttiContext: TRttiContext;
lField: TRttiField;
begin
lRttiContext := TRttiContext.Create;
try
lField := lRttiContext.GetType(Self.ClassType).GetField('FCookies');
Result := nil;
if Assigned(lField) then
Result := lField.GetValue(Self).AsObject as TCookies;
finally
lRttiContext.Free;
end;
end;
{$ENDIF}
end.