// ***************************************************************************
//
// 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.Commons;
{$I dmvcframework.inc}
interface
uses
System.NetEncoding,
System.SysUtils,
System.Classes,
MVCFramework.Commons,
System.Net.HttpClient;
type
{$SCOPEDENUMS ON}
TMVCRESTParamType = (Header, Path, Query, FormURLEncoded, Cookie);
TMVCRESTParam = record
/// Parameter type
&Type: TMVCRESTParamType;
/// Parameter name
Name: string;
/// Parameter value
Value: string;
/// Initializes a TMVCRESTParam
constructor Create(const aType: TMVCRESTParamType; const aName, aValue: string);
end;
TMVCRESTClientHelper = class sealed
private
class function DecompressWithZlib(aContentStream, aOutStream: TStream; const aContentEncoding: string): Boolean;
class function DecompressWithIndyZlib(aContentStream, aOutStream: TStream; const aContentEncoding: string): Boolean;
public
class function URIEncode(const aURI: string): string;
///
/// Convert response content to byte array. If the response is compressed, it is decompressed in the process.
///
class function GetResponseContentAsRawBytes(aContentStream: TStream; const aContentEncoding: string): TArray;
///
/// Get the response string, if it is of any type of text.
///
class function GetResponseContentAsString(aContentRawBytes: TArray; const aContentType: string): string;
end;
EMVCRESTClientException = class(Exception);
TMVCRESTClientConsts = record
public const
DEFAULT_ACCEPT_ENCODING = 'gzip,deflate';
DEFAULT_ACCEPT = TMVCMediaType.APPLICATION_JSON + ', ' + TMVCMediaType.TEXT_PLAIN + ', ' + TMVCMediaType.TEXT_HTML;
DEFAULT_USER_AGENT = 'DelphiMVCFramework RESTClient/' + DMVCFRAMEWORK_VERSION;
DEFAULT_FILE_NAME = 'file';
AUTHORIZATION_HEADER = 'Authorization';
BASIC_AUTH_PREFIX = 'Basic ';
BEARER_AUTH_PREFIX = 'Bearer ';
SERVER_HEADER = 'server';
DEFAULT_MAX_REDIRECTS = 5;
{$IF defined(BERLINORBETTER)}
REST_UNSAFE_CHARS: TURLEncoding.TUnsafeChars = [Ord('"'), Ord(''''), Ord(':'), Ord(';'), Ord('<'), Ord('='),
Ord('>'), Ord('@'), Ord('['), Ord(']'), Ord('^'), Ord('`'), Ord('{'), Ord('}'), Ord('|'), Ord('/'), Ord('\'),
Ord('?'), Ord('#'), Ord('&'), Ord('!'), Ord('$'), Ord('('), Ord(')'), Ord(','), Ord('~'), Ord(' '), Ord('*'),
Ord('+')];
PATH_UNSAFE_CHARS: TURLEncoding.TUnsafeChars = [Ord('"'), Ord('<'), Ord('>'), Ord('^'), Ord('`'), Ord('{'),
Ord('}'), Ord('|'), Ord('/'), Ord('\'), Ord('?'), Ord('#'), Ord('+'), Ord('.')];
{$ENDIF}
end;
implementation
uses
IdCompressorZLib,
System.ZLib,
System.Net.Mime,
System.Rtti;
{ TMVCRESTParam }
constructor TMVCRESTParam.Create(const aType: TMVCRESTParamType; const aName, aValue: string);
begin
&Type := aType;
Name := aName;
Value := aValue;
end;
{ TMVCRESTClientHelper }
class function TMVCRESTClientHelper.DecompressWithIndyZlib(aContentStream, aOutStream: TStream;
const aContentEncoding: string): Boolean;
var
lDecompressor: TIdCompressorZLib;
begin
try
aContentStream.Position := 0;
lDecompressor := TIdCompressorZLib.Create(nil);
try
if SameText(aContentEncoding, 'gzip') then
begin
lDecompressor.DecompressGZipStream(aContentStream, aOutStream);
end
else if SameText(aContentEncoding, 'deflate') then
begin
lDecompressor.DecompressHTTPDeflate(aContentStream, aOutStream);
end;
Result := True;
finally
FreeAndNil(lDecompressor);
end;
except
Result := False;
end;
end;
class function TMVCRESTClientHelper.DecompressWithZlib(aContentStream, aOutStream: TStream;
const aContentEncoding: string): Boolean;
var
lCompressionType: TMVCCompressionType;
lDecompressor: TZDecompressionStream;
begin
if aContentEncoding = 'deflate' then
begin
lCompressionType := TMVCCompressionType.ctDeflate;
end
else
begin
lCompressionType := TMVCCompressionType.ctGZIP;
end;
aContentStream.Position := 0;
try
{$IF defined(BERLINORBETTER)}
lDecompressor := TZDecompressionStream.Create(aContentStream,
MVC_COMPRESSION_ZLIB_WINDOW_BITS[lCompressionType], False);
{$ELSE}
lDecompressor := TZDecompressionStream.Create(aContentStream, MVC_COMPRESSION_ZLIB_WINDOW_BITS[lCompressionType]);
{$ENDIF}
try
aOutStream.CopyFrom(lDecompressor, 0);
Result := True;
finally
FreeAndNil(lDecompressor);
end;
except
Result := False;
end;
end;
class function TMVCRESTClientHelper.GetResponseContentAsRawBytes(aContentStream: TStream;
const aContentEncoding: string): TArray;
var
lDecompressed: TMemoryStream;
begin
lDecompressed := TMemoryStream.Create;
try
if SameText(aContentEncoding, 'gzip') or SameText(aContentEncoding, 'deflate') then
begin
/// Certain types of deflate compression cannot be decompressed by the standard Zlib,
/// but are decompressed by Indy's Zlib.
/// Examples:
/// The deflate compression of the DMVC server is not decompressed by the Indy Zlib decompressor,
/// only by the standard Zlib.
/// The deflate compression of the server of the Embarcadero website (https://www.embarcadero.com/)
/// is only decompressed with the Indy Zlib decompressor.
/// Note: I think we can improve this later
if not (DecompressWithZlib(aContentStream, lDecompressed, aContentEncoding) or
DecompressWithIndyZlib(aContentStream, lDecompressed, aContentEncoding)) then
raise EMVCRESTClientException.Create('Could not decompress response content');
end
else if aContentEncoding.IsEmpty or SameText(aContentEncoding, 'identity') then // No encoding
begin
lDecompressed.CopyFrom(aContentStream, 0);
end
else
begin
raise EMVCRESTClientException.CreateFmt('Content-Encoding not supported [%s]', [aContentEncoding]);
end;
SetLength(Result, lDecompressed.Size);
lDecompressed.Position := 0;
lDecompressed.Read(Result, lDecompressed.Size);
finally
FreeAndNil(lDecompressed);
end;
end;
class function TMVCRESTClientHelper.GetResponseContentAsString(aContentRawBytes: TArray;
const aContentType: string): string;
var
lContentIsString: Boolean;
lEncoding: TEncoding;
lContentType: string;
lCharset: string;
{$IF defined(RIOORBETTER)}
lExt: string;
lMimeKind: TMimeTypes.TKind;
{$ENDIF}
lReader: TStringStream;
begin
Result := '';
lContentIsString := False;
SplitContentMediaTypeAndCharset(aContentType, lContentType, lCharset);
if not lCharset.IsEmpty then
begin
lContentIsString := True
end
else
begin
{$IF defined(RIOORBETTER)}
TMimeTypes.Default.GetTypeInfo(lContentType.ToLower, lExt, lMimeKind);
if lMimeKind = TMimeTypes.TKind.Text then
lContentIsString := True;
{$ELSE}
if not (lContentType.StartsWith('image', True) or
lContentType.StartsWith('video', True) or
lContentType.StartsWith('audio', True) or
lContentType.ToLower.Equals('application/octet-stream') or
lContentType.ToLower.Equals('application/pdf')) then
lContentIsString := True;
{$ENDIF}
end;
if lContentIsString then
begin
if lCharset.isEmpty then
begin
lCharset := TMVCCharSet.UTF_8;
end;
lEncoding := TEncoding.GetEncoding(lCharset);
lReader := TStringStream.Create('', lEncoding);
try
lReader.Write(aContentRawBytes, Length(aContentRawBytes));
Result := lReader.DataString;
finally
FreeAndNil(lReader);
end;
end;
end;
class function TMVCRESTClientHelper.URIEncode(const aURI: string): string;
begin
Result := TNetEncoding.URL.Encode(aURI
{$IF defined(BERLINORBETTER)}
,TMVCRESTClientConsts.REST_UNSAFE_CHARS, [TURLEncoding.TEncodeOption.EncodePercent]
{$ENDIF}
);
end;
end.