Some minor fixes.

All protected serializers methods are now public so that is possible to use the low level serialization as was possibile with the old ObjectsMappers.
This commit is contained in:
Daniele Teti 2017-09-07 00:10:21 +02:00
parent 0b9b8a01bf
commit fc72c8c49b
12 changed files with 161 additions and 78 deletions

View File

@ -22,6 +22,8 @@ type
[MVCHTTPMethod([httpGet])]
[MVCPath('/people/($id)')]
[MVCProduces('application/json')]
{ This action cannot be called by a browser address bar because requires the
ACCEPT header to be application/json. Use Postman or RAD Studio's RESTDebugger. }
procedure GetPerson(id: Integer);
end;

View File

@ -23,6 +23,9 @@ type
[MVCPath('/admin')]
TAdminController = class(TMVCController)
protected
procedure OnBeforeAction(AContext: TWebContext; const AActionName: string;
var AHandled: Boolean); override;
public
[MVCPath('/role1')]
[MVCProduces('text/html')]
@ -57,6 +60,15 @@ end;
{ TAdminController }
procedure TAdminController.OnBeforeAction(AContext: TWebContext;
const AActionName: string; var AHandled: Boolean);
begin
inherited;
Assert(AContext.LoggedUser.CustomData['customkey1'] = 'customvalue1', 'customkey1 not valid');
Assert(AContext.LoggedUser.CustomData['customkey2'] = 'customvalue2', 'customkey2 not valid');
AHandled := False;
end;
procedure TAdminController.OnlyRole1(ctx: TWebContext);
begin
ContentType := TMVCMediaType.TEXT_PLAIN;

View File

@ -44,6 +44,11 @@ begin
UserRoles.Add('role1');
UserRoles.Add('role2');
end;
// You can add custom data to the logged user
SessionData.AddOrSetValue('customkey1', 'customvalue1');
SessionData.AddOrSetValue('customkey2', 'customvalue2');
end
else
begin

View File

@ -113,7 +113,7 @@ type
DefaultContentType = 'default_content_type';
DefaultContentCharset = 'default_content_charset';
DefaultViewFileExtension = 'default_view_file_extension';
//ISAPIPath = 'isapi_path';
// ISAPIPath = 'isapi_path';
PathPrefix = 'pathprefix';
StompServer = 'stompserver';
StompServerPort = 'stompserverport';
@ -411,9 +411,9 @@ function B64Encode(const AValue: string): string; overload;
function B64Encode(const AValue: TBytes): string; overload;
function B64Decode(const AValue: string): string;
function URLSafeB64encode(const Value: string; IncludePadding: Boolean): String; overload;
function URLSafeB64encode(const Value: TBytes; IncludePadding: Boolean): String; overload;
function URLSafeB64Decode(const Value: string): String;
function URLSafeB64encode(const Value: string; IncludePadding: Boolean): string; overload;
function URLSafeB64encode(const Value: TBytes; IncludePadding: Boolean): string; overload;
function URLSafeB64Decode(const Value: string): string;
function ByteToHex(AInByte: Byte): string;
function BytesToHex(ABytes: TBytes): string;
@ -462,19 +462,19 @@ end;
function B64Encode(const AValue: string): string; overload;
begin
//Do not use TNetEncoding
// Do not use TNetEncoding
Result := TIdEncoderMIME.EncodeString(AValue);
end;
function B64Encode(const AValue: TBytes): string; overload;
begin
//Do not use TNetEncoding
// Do not use TNetEncoding
Result := TIdEncoderMIME.EncodeBytes(TIdBytes(AValue));
end;
function B64Decode(const AValue: string): string;
begin
//Do not use TNetEncoding
// Do not use TNetEncoding
Result := TIdDecoderMIME.DecodeString(AValue);
end;
@ -637,7 +637,17 @@ begin
try
for S in FConfig.Keys do
Jo.AddPair(S, FConfig[S]);
{$IFDEF SYSTEMJSON}
Result := Jo.ToJSON;
{$ELSE}
Result := Jo.ToString;
{$ENDIF}
finally
Jo.Free;
end;
@ -729,6 +739,7 @@ type
public
end;
TURLSafeDecode = class(TIdDecoder4to3)
protected
class var GSafeBaseBase64DecodeTable: TIdDecodeTable;
@ -739,14 +750,13 @@ type
const
GURLSafeBase64CodeTable: string =
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_'; {Do not Localize}
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_'; { Do not Localize }
procedure TURLSafeEncode.InitComponent;
begin
inherited;
FCodingTable := ToBytes(GURLSafeBase64CodeTable);
FFillChar := '='; {Do not Localize}
FFillChar := '='; { Do not Localize }
end;
procedure TURLSafeDecode.InitComponent;
@ -754,10 +764,10 @@ begin
inherited;
FDecodeTable := GSafeBaseBase64DecodeTable;
FCodingTable := ToBytes(GURLSafeBase64CodeTable);
FFillChar := '='; {Do not Localize}
FFillChar := '='; { Do not Localize }
end;
function URLSafeB64encode(const Value: string; IncludePadding: Boolean): String; overload;
function URLSafeB64encode(const Value: string; IncludePadding: Boolean): string; overload;
begin
if IncludePadding then
Result := TURLSafeEncode.EncodeString(Value)
@ -766,7 +776,7 @@ begin
end;
/// <summary>
/// Remove "trimmed" character from the end of the string passed as parameter
/// Remove "trimmed" character from the end of the string passed as parameter
/// </summary>
/// <param name="Value">Original string</param>
/// <param name="TrimmedChar">Character to remove</param>
@ -776,12 +786,12 @@ var
Strlen: Integer;
begin
Strlen := Length(Value);
while (Strlen>0) and (Value[Strlen]=TrimmedChar) do
while (Strlen > 0) and (Value[Strlen] = TrimmedChar) do
dec(StrLen);
result := copy(value, 1, StrLen)
end;
function URLSafeB64encode(const Value: TBytes; IncludePadding: Boolean): String; overload;
function URLSafeB64encode(const Value: TBytes; IncludePadding: Boolean): string; overload;
begin
if IncludePadding then
@ -790,14 +800,14 @@ begin
Result := RTrim(TURLSafeEncode.EncodeBytes(TIdBytes(Value)), '=');
end;
function URLSafeB64Decode(const Value: string): String;
function URLSafeB64Decode(const Value: string): string;
begin
// SGR 2017-07-03 : b64url might not include padding. Need to add it before decoding
case Length(value) mod 4 of
0:
begin
Result := TURLSafeDecode.DecodeString(Value);
end;
begin
Result := TURLSafeDecode.DecodeString(Value);
end;
2:
Result := TURLSafeDecode.DecodeString(Value + '==');
3:

View File

@ -646,6 +646,8 @@ begin
FCustomClaims.FClaims.AddOrSetValue(lName, lValue);
end;
FCustomClaims.FClaims.TrimExcess;
FRegisteredClaims.FClaims.TrimExcess;
finally
lJPayload.Free;
end;

View File

@ -48,7 +48,7 @@ type
FSetupJWTClaims: TJWTClaimsSetup;
FSecret: string;
FLeewaySeconds: Cardinal;
FLoginURLSegment: String;
FLoginURLSegment: string;
protected
procedure InternalRender(
AJSONValue: TJSONValue;
@ -102,15 +102,15 @@ uses System.NetEncoding, System.DateUtils;
{ TMVCJWTAuthenticationMiddleware }
constructor TMVCJWTAuthenticationMiddleware.Create(AAuthenticationHandler: IMVCAuthenticationHandler;
AConfigClaims: TJWTClaimsSetup;
ASecret: string = 'D3lph1MVCFram3w0rk';
ALoginURLSegment: string = '/login';
AClaimsToCheck: TJWTCheckableClaims = [
TJWTCheckableClaim.ExpirationTime,
TJWTCheckableClaim.NotBefore,
TJWTCheckableClaim.IssuedAt
];
ALeewaySeconds: Cardinal = 300);
AConfigClaims: TJWTClaimsSetup;
ASecret: string = 'D3lph1MVCFram3w0rk';
ALoginURLSegment: string = '/login';
AClaimsToCheck: TJWTCheckableClaims = [
TJWTCheckableClaim.ExpirationTime,
TJWTCheckableClaim.NotBefore,
TJWTCheckableClaim.IssuedAt
];
ALeewaySeconds: Cardinal = 300);
begin
inherited Create;
FAuthenticationHandler := AAuthenticationHandler;
@ -215,6 +215,7 @@ begin
AContext.LoggedUser.UserName := JWTValue.CustomClaims['username'];
AContext.LoggedUser.Roles.AddRange(JWTValue.CustomClaims['roles'].Split([',']));
AContext.LoggedUser.LoggedSince := JWTValue.Claims.IssuedAt;
AContext.LoggedUser.CustomData := JWTValue.CustomClaims.AsCustomData;
FAuthenticationHandler.OnAuthorization(AContext.LoggedUser.Roles, AControllerQualifiedClassName, AActionName, IsAuthorized);
@ -248,6 +249,7 @@ var
SessionData: TSessionData;
IsValid: Boolean;
JWTValue: TJWT;
lCustomPair: TPair<string, string>;
begin
if SameText(AContext.Request.PathInfo, FLoginURLSegment) and (AContext.Request.HTTPMethod = httpPOST) then
begin
@ -296,6 +298,18 @@ begin
AContext.LoggedUser.LoggedSince := JWTValue.Claims.IssuedAt;
AContext.LoggedUser.Realm := JWTValue.Claims.Subject;
if SessionData.Count > 0 then
begin
AContext.LoggedUser.CustomData := TMVCCustomData.Create;
for lCustomPair in SessionData do
begin
AContext.LoggedUser.CustomData.AddOrSetValue(lCustomPair.Key, lCustomPair.Value);
if not JWTValue.CustomClaims.Items[lCustomPair.Key].IsEmpty then
raise EMVCJWTException.CreateFmt('JWT Error: "%s" is a reserved key name', [lCustomPair.Key]);
JWTValue.CustomClaims.Items[lCustomPair.Key] := lCustomPair.Value;
end;
end;
InternalRender(
TJSONObject.Create(TJSONPair.Create('token', JWTValue.GetToken)),
TMVCMediaType.APPLICATION_JSON,

View File

@ -767,9 +767,9 @@ begin
FQueryStringParams := nil;
FRawBody := nil;
FAccept := 'application/json';
FContentType := 'application/json; charset=utf-8';
FContentType := 'application/json';
FResource := '';
FContentEncoding := '';
FContentEncoding := 'utf-8';
FRequestHeaders := TStringlist.Create;
FLastSessionID := '';
FNextRequestIsAsynch := False;

View File

@ -230,12 +230,9 @@ const
implementation
function DateTimeToISOTimeStamp(const ADateTime: TDateTime): string;
var
fs: TFormatSettings;
begin
// fs.TimeSeparator := ':';
Result := DateToISO8601(ADateTime, true)
// Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', ADateTime, fs);
end;

View File

@ -50,7 +50,7 @@ uses
type
TMVCJSONSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
private
public
procedure ObjectToJSONObject(
const AObject: TObject;
const AJSONObject: TJSONObject;
@ -104,7 +104,7 @@ type
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase
);
protected
{ IMVCSerializer }
function SerializeObject(
const AObject: TObject;
const AType: TMVCSerializationType = stDefault;
@ -158,7 +158,7 @@ type
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
);
public
procedure AfterConstruction; override;
end;

View File

@ -61,13 +61,13 @@ type
end;
TMVCJsonDataObjectsSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
private
// procedure SerializeDynamicArray(
// const AValue: TValue;
// const AArray: TJsonArray;
// const AType: TMVCSerializationType;
// const AIgnoredAttributes: TMVCIgnoredList
// );
public
// procedure SerializeDynamicArray(
// const AValue: TValue;
// const AArray: TJsonArray;
// const AType: TMVCSerializationType;
// const AIgnoredAttributes: TMVCIgnoredList
// );
procedure ObjectToJsonObject(
const AObject: TObject;
const AJsonObject: TJsonObject;
@ -109,6 +109,12 @@ type
const ANameCase: TMVCNameCase;
const AIgnoredFields: TMVCIgnoredList
);
procedure DataSetToJsonArray(
const ADataSet: TDataSet;
const AJsonArray: TJsonArray;
const ANameCase: TMVCNameCase;
const AIgnoredFields: TMVCIgnoredList
);
procedure JsonObjectToDataSet(
const AJsonObject: TJsonObject;
const ADataSet: TDataSet;
@ -121,7 +127,7 @@ type
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase
);
protected
{ IMVCSerializer }
function SerializeObject(
const AObject: TObject;
const AType: TMVCSerializationType = stDefault;
@ -357,8 +363,8 @@ begin
tkArray, tkDynArray:
begin
raise EMVCSerializationException.CreateFmt('Cannot serialize %s of TypeKind tkSet.', [AName]);
// ChildJsonArray := AJsonObject.A[AName];
// SerializeDynamicArray(AValue, ChildJsonArray, AType, AIgnored);
// ChildJsonArray := AJsonObject.A[AName];
// SerializeDynamicArray(AValue, ChildJsonArray, AType, AIgnored);
end;
tkUnknown:
@ -366,6 +372,23 @@ begin
end;
end;
procedure TMVCJsonDataObjectsSerializer.DataSetToJsonArray(
const ADataSet: TDataSet;
const AJsonArray: TJsonArray;
const ANameCase: TMVCNameCase;
const AIgnoredFields: TMVCIgnoredList
);
var
LJObj: TJsonObject;
begin
while not ADataSet.Eof do
begin
LJobj := AJsonArray.AddObject;
DataSetToJsonObject(ADataSet, lJObj, ANameCase, AIgnoredFields);
ADataSet.Next;
end;
end;
procedure TMVCJsonDataObjectsSerializer.DataSetToJsonObject(
const ADataSet: TDataSet; const AJsonObject: TJsonObject;
const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList);
@ -413,9 +436,12 @@ begin
ftDateTime:
AJsonObject.S[FieldName] := DateTimeToISOTimeStamp(ADataSet.Fields[I].AsDateTime);
ftTime, ftTimeStamp:
ftTime:
AJsonObject.S[FieldName] := SQLTimeStampToStr('hh:nn:ss', ADataSet.Fields[I].AsSQLTimeStamp);
ftTimeStamp:
AJsonObject.S[FieldName] := DateTimeToISOTimeStamp(SQLTimeStampToDateTime(ADataSet.Fields[I].AsSQLTimeStamp));
ftCurrency:
AJsonObject.F[FieldName] := ADataSet.Fields[I].AsCurrency;
@ -957,26 +983,26 @@ begin
end;
end;
//procedure TMVCJsonDataObjectsSerializer.SerializeDynamicArray(
// const AValue: TValue;
// const AArray: TJsonArray;
// const AType: TMVCSerializationType;
// const AIgnoredAttributes: TMVCIgnoredList
// );
//var
// I: Integer;
// Obj: TObject;
//begin
// if AValue.GetArrayLength > 0 then
// if not AValue.GetArrayElement(I).IsObject then
// raise EMVCSerializationException.Create('Cannot serialize non-object in dynamic (or static) arrays');
// for I := 0 to AValue.GetArrayLength - 1 do
// begin
// Obj := AValue.GetArrayElement(I).AsObject;
// if Assigned(Obj) then
// ObjectToJsonObject(Obj, AArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes);
// end;
//end;
// procedure TMVCJsonDataObjectsSerializer.SerializeDynamicArray(
// const AValue: TValue;
// const AArray: TJsonArray;
// const AType: TMVCSerializationType;
// const AIgnoredAttributes: TMVCIgnoredList
// );
// var
// I: Integer;
// Obj: TObject;
// begin
// if AValue.GetArrayLength > 0 then
// if not AValue.GetArrayElement(I).IsObject then
// raise EMVCSerializationException.Create('Cannot serialize non-object in dynamic (or static) arrays');
// for I := 0 to AValue.GetArrayLength - 1 do
// begin
// Obj := AValue.GetArrayElement(I).AsObject;
// if Assigned(Obj) then
// ObjectToJsonObject(Obj, AArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes);
// end;
// end;
function TMVCJsonDataObjectsSerializer.SerializeObject(
const AObject: TObject;

View File

@ -306,9 +306,9 @@ type
FRoles: TList<string>;
FLoggedSince: TDateTime;
FRealm: string;
FCustomData: TMVCCustomData;
procedure SetLoggedSince(const AValue: TDateTime);
protected
{ protected declarations }
procedure SetCustomData(const Value: TMVCCustomData);
public
constructor Create;
destructor Destroy; override;
@ -323,6 +323,7 @@ type
property Roles: TList<string> read FRoles;
property LoggedSince: TDateTime read FLoggedSince write SetLoggedSince;
property Realm: string read FRealm write FRealm;
property CustomData: TMVCCustomData read FCustomData write SetCustomData;
end;
TWebContext = class
@ -1268,11 +1269,13 @@ constructor TUser.Create;
begin
inherited Create;
FRoles := TList<string>.Create;
FCustomData := nil;
end;
destructor TUser.Destroy;
begin
FRoles.Free;
FreeAndNil(FCustomData);
inherited Destroy;
end;
@ -1315,6 +1318,11 @@ begin
AWebSession[TMVCConstants.CURRENT_USER_SESSION_KEY] := FUserName + '$$' + DateTimeToISOTimeStamp(FLoggedSince) + '$$' + FRealm + '$$' + LRoles;
end;
procedure TUser.SetCustomData(const Value: TMVCCustomData);
begin
FCustomData := Value;
end;
procedure TUser.SetLoggedSince(const AValue: TDateTime);
begin
if (FLoggedSince = 0) then
@ -2395,25 +2403,30 @@ end;
procedure TMVCController.Render(const AContent: string);
var
LContentType: string;
OutEncoding: TEncoding;
LOutEncoding: TEncoding;
LSavedContentType: string;
begin
LSavedContentType := ContentType;
LContentType := ContentType + '; charset=' + ContentCharset;
GetContext.Response.RawWebResponse.ContentType := LContentType;
OutEncoding := TEncoding.GetEncoding(ContentCharset);
LOutEncoding := TEncoding.GetEncoding(ContentCharset);
try
if SameText('UTF-8', UpperCase(ContentCharset)) then
GetContext.Response.SetContentStream(TStringStream.Create(AContent, TEncoding.UTF8), LContentType)
GetContext.Response.SetContentStream(
TStringStream.Create(AContent, TEncoding.UTF8),
LContentType
)
else
begin
GetContext.Response.SetContentStream(
TBytesStream.Create(
TEncoding.Convert(TEncoding.Default, OutEncoding, TEncoding.Default.GetBytes(AContent))),
TEncoding.Convert(TEncoding.Default, LOutEncoding, TEncoding.Default.GetBytes(AContent))),
LContentType
);
end;
finally
OutEncoding.Free;
LOutEncoding.Free;
end;
ContentType := LSavedContentType;
end;
procedure TMVCController.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean);
@ -2484,6 +2497,8 @@ end;
procedure TMVCController.SetContentType(const AValue: string);
begin
GetContext.Response.ContentType := AValue;
if AValue.Contains(';') then
GetContext.Response.ContentType := AValue;
end;
procedure TMVCController.SetStatusCode(const AValue: Integer);

View File

@ -873,13 +873,13 @@ begin
res := RESTClient
.Accept(TMVCMediaType.TEXT_PLAIN)
.ContentType(TMVCMediaType.TEXT_PLAIN)
.ContentEncoding('iso8859-1')
.ContentEncoding('iso-8859-1')
.doPOST('/testconsumes/textiso8859_1', [],
'àèéìòù');
Assert.areEqual<Integer>(HTTP_STATUS.OK, res.ResponseCode);
Assert.areEqual('àèéìòù', res.BodyAsString);
Assert.areEqual(TMVCMediaType.TEXT_PLAIN, res.ContentType);
Assert.areEqual('iso8859-1', res.ContentEncoding);
Assert.areEqual('iso-8859-1', res.ContentEncoding.ToLower);
end;