Deserialiser for URLEncoded Body

[fastbike]

I'm using HTMX for the web side of a new app, although this problem would generalise to any data submitted by an HTML form.

The controller accepts data with an http POST, of ContentType "application/x-www-form-urlencoded"

    [MVCPath('/($HPIFac)'), MVCHTTPMethod([httpPOST])]
    [MVCProduces('text/html')]
    [MVCConsumes('application/x-www-form-urlencoded')]
    procedure UpdateFacility(HPIFac: string);
...
procedure TFacilityController.UpdateFacility(HPIFac: string);
var
  Facility: TFacility;
begin
  Facility := Context.Request.BodyAs<TFacility>;
...

I'm trying to deserialise it into a custom object (TFacility), however there is no class I can register as a serialiser for that content type with the MVC Engine. i.e. I'd need something like

    FMVC.AddSerializer('application/x-www-form-urlencoded',TMVCURLEncodedDataSerializer.Create);

Before I start writing my own, is this a valid approach (the body is just a set of name/value pairs, delimited with "&" )

ID=1&Name=Test%20Facility&RegionID=2

[fastbike]

My first cut, which can handle text, numbers and booleans. Good enough to get me going. I have not written any unit tests yet.

unit MVCFramework.Serializer.URLEncoded;

// serialiser for URL encoded data

{$I dmvcframework.inc}

interface

uses System.Classes, System.Rtti,
  System.TypInfo,
  Data.DB,
  MVCFramework.Commons,
  MVCFramework.Serializer.Intf,
  MVCFramework.Serializer.Abstract,
  MVCFramework.DuckTyping,
  MVCFramework.Serializer.Commons,
  System.SysUtils;

type

  TMVCURLEncodedDataSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
  private
    procedure DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember; const RawData: string;
      const AName: string; var AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
      const ACustomAttributes: TArray<TCustomAttribute>);

  protected
    procedure RaiseNotImplemented;
  protected
    { IMVCSerializer }
    procedure RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer);

    function SerializeObject(const AObject: TObject; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
      const ASerializationAction: TMVCSerializationAction = nil): string; overload;

    function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType = stDefault;
      const AIgnoredAttributes: TMVCIgnoredList = nil; const ASerializationAction: TMVCSerializationAction = nil)
      : string; overload;

    function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
      const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string;

    function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
      const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string;

    procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
      const ARootNode: String = ''); overload;

    procedure DeserializeObject(const ASerializedObject: string; const AObject: IInterface;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil); overload;

    procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil;
      const ARootNode: String = ''); overload;

    procedure DeserializeCollection(const ASerializedList: string; const AList: IInterface; const AClazz: TClass;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = nil); overload;

    procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet;
      const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs);

    procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet;
      const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs);
  public
    procedure URLEncodedStringToObject(const Data: TStringList; const AObject: TObject; const AType: TMVCSerializationType;
      const AIgnoredAttributes: TMVCIgnoredList);

  end;

implementation

uses
  System.NetEncoding;

{ TMVCURLEncodedDataSerializer }

procedure TMVCURLEncodedDataSerializer.DeserializeCollection(const ASerializedList: string; const AList: IInterface;
  const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeCollection(const ASerializedList: string; const AList: TObject;
  const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: String);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet;
  const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet;
  const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.DeserializeObject(const ASerializedObject: string; const AObject: IInterface;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
begin
  // ??
end;

procedure TMVCURLEncodedDataSerializer.DeserializeObject(const ASerializedObject: string; const AObject: TObject;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: String);
var
  SL: TStringList;
begin
  if (ASerializedObject = EmptyStr) then
    raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body');

  if not Assigned(AObject) then
    Exit;

  SL := TStringList.Create;
  try
    try
      SL.Delimiter := '&';
      SL.DelimitedText := ASerializedObject;
      if GetTypeSerializers.ContainsKey(AObject.ClassInfo) then
      begin
        // todo: do we handle custom type serialisers
        // GetTypeSerializers.Items[AObject.ClassInfo].DeserializeRoot(SelectRootNodeOrWholeObject(ARootNode, JSONObject),
        // AObject, [])
      end
      else
      begin
        URLEncodedStringToObject(SL, AObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
      end;
    except
      on E: Exception do
        raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message);
    end;
  finally
    SL.Free;
  end;
end;

procedure TMVCURLEncodedDataSerializer.RaiseNotImplemented;
begin
  raise EMVCException.Create('Not Implemented');
end;

procedure TMVCURLEncodedDataSerializer.RegisterTypeSerializer(const ATypeInfo: PTypeInfo; AInstance: IMVCTypeSerializer);
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
  const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
  const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeObject(const AObject: TObject; const AType: TMVCSerializationType;
  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

function TMVCURLEncodedDataSerializer.SerializeRecord(const ARecord: Pointer; const ARecordTypeInfo: PTypeInfo;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
  const ASerializationAction: TMVCSerializationAction): string;
begin
  RaiseNotImplemented;
end;

procedure TMVCURLEncodedDataSerializer.URLEncodedStringToObject(const Data: TStringList; const AObject: TObject;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
var
  lObjType: TRttiType;
  lProp: TRttiProperty;
  lFld: TRttiField;
  lAttributeValue: TValue;
  lKeyName: string;
  lErrMsg: string;
begin
  if AObject = nil then
  begin
    Exit;
  end;

  lProp := nil;
  lFld := nil;

  lObjType := GetRttiContext.GetType(AObject.ClassType);
  case AType of
    stDefault, stProperties:
      begin
        try
          for lProp in lObjType.GetProperties do
          begin
{$IFDEF AUTOREFCOUNT}
            if TMVCSerializerHelper.IsAPropertyToSkip(lProp.Name) then
              continue;
{$ENDIF}
            if ((not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lProp)) and
              (not IsIgnoredAttribute(AIgnoredAttributes, lProp.Name)) and (lProp.IsWritable or lProp.GetValue(AObject).IsObject))
            then
            begin
              lAttributeValue := lProp.GetValue(AObject);
              lKeyName := TMVCSerializerHelper.GetKeyName(lProp, lObjType);

              if Data.IndexOfName(lKeyName) > -1 then
              begin
                DataValueToAttribute(AObject, lProp, Data.Values[lKeyName], lKeyName, lAttributeValue, AType, AIgnoredAttributes,
                  lProp.GetAttributes);
                if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) and lProp.IsWritable then
                begin
                  lProp.SetValue(AObject, lAttributeValue);
                end;
              end;
            end;
          end;
        except
          on E: EInvalidCast do
          begin
            if lProp <> nil then
            begin
              lErrMsg := Format('Invalid class typecast for property "%s" [Expected: %s, Data: %s]',
                [lKeyName, lProp.PropertyType.ToString(), Data.Values[lKeyName]]);
            end
            else
            begin
              lErrMsg := Format('Invalid class typecast for property "%s" [Data: %s]', [lKeyName, Data.Values[lKeyName]]);
            end;
            raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg);
          end;
        end;
      end;
    stFields:
      begin
        try
          for lFld in lObjType.GetFields do
            if (not TMVCSerializerHelper.HasAttribute<MVCDoNotDeserializeAttribute>(lFld)) and
              (not IsIgnoredAttribute(AIgnoredAttributes, lFld.Name)) then
            begin
              lAttributeValue := lFld.GetValue(AObject);
              lKeyName := TMVCSerializerHelper.GetKeyName(lFld, lObjType);
              if Data.IndexOfName(lKeyName) > -1 then
              begin
                DataValueToAttribute(AObject, lFld, Data.Values[lKeyName], lKeyName, lAttributeValue, AType, AIgnoredAttributes,
                  lFld.GetAttributes);
                if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) then
                  lFld.SetValue(AObject, lAttributeValue);
              end;
            end;
        except
          on E: EInvalidCast do
          begin
            if lFld <> nil then
            begin
              lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Data: %s]',
                [lKeyName, lFld.FieldType.ToString(), Data.Values[lKeyName]]);
            end
            else
            begin
              lErrMsg := Format('Invalid class typecast for field "%s" [Data: %s]', [lKeyName, Data.Values[lKeyName]]);
            end;
            raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg);
          end;
        end;
      end;
  end;
end;

procedure TMVCURLEncodedDataSerializer.DataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember;
  const RawData: string; const AName: string; var AValue: TValue; const AType: TMVCSerializationType;
  const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray<TCustomAttribute>);
var
  RttiType: TRttiType;
begin
  AValue.Empty;
  case AType of
    stUnknown, stDefault, stProperties:
      RttiType := TRttiProperty(ARttiMember).PropertyType;
    stFields:
      RttiType := TRttiField(ARttiMember).FieldType;
  end;

  case RttiType.TypeKind of
    tkString, tkWideString, tkAnsiString, tkUString:
      AValue := TNetEncoding.URL.Decode(RawData);
    tkInteger:
      AValue := RawData.ToInteger;
    tkInt64:
      AValue := RawData.ToInt64;
    tkFloat:
      AValue := RawData.ToDouble;
    tkEnumeration:
      begin
        if SameText(RttiType.ToString, 'boolean') then
          AValue := RawData.ToBoolean;
      end;
    // any others ?
  end;
end;

end.

[danieleteti]

from Facebook discussion (just to trace it) I don't know htmx but normally I quite disagree to modify the API so deeply to just cope with client side "features". Why just don't use htmx extension to use JSON in body request? https://htmx.org/extensions/json-enc/

[fastbike]

I was not aware of those extensions, so I'll take a look. Regarding the need to change the API, HTMX works by dynamically changing the DOM, so a data submission will typically result in a lump of HTML being returned. E.g. A typical work flow for data in a grid/table, is to have the following endpoints:

• one endpoint to return the grid layout
• another (triggered by some editing UI interaction such as a button, double click etc) that returns the selected table row with editable controls with the current values of the data, and this replaces the tr element
• a final one that accepts the edits and returns a read only tr that replaces the editable row. All driven via templating.

I've found it relatively quick to get a basic PoC page up, until I used a form element elsewhere in the page and hit the blocker of the request body containing URL encoded data. Hence my code above.

[fastbike]

I've had a quick look. My class is declared with no hints for the name casing of the properties.

  TFacility = class
  private
    FHPIFac: string;
    FRegionID: Integer;
    FSendFlag: Boolean;
    FFacilityName: string;
    FLocationID: Integer;
  public
    property HPIFac: string read FHPIFac write FHPIFac;
    property FacilityName: string read FFacilityName write FFacilityName;
    property LocationID: Integer read FLocationID write FLocationID;
    property RegionID: Integer read FRegionID write FRegionID;
    property SendFlag: Boolean read FSendFlag write FSendFlag;

This means the deserialiser uses the ncAsIs option, so the json property names have to exactly match the casing in the Pascal code. So this html works OK <td><input type="text" name="FacilityName" value="{{FacilityName}}"></td> but this one does not <td><input type="text" name="facilityName" value="{{FacilityName}}"></td>

Given the case insensitive nature of Pascal, and the case sensitive nature of json, , this looks likely to cause bugs further down the line. Bugs that will be easy to introduce (front end html templates being done by an external party, DMVC application in house) and hard to find.

The alternative is to register a custom type serializer for each business object class ? Which I can imagine would be subject to error and is additional code that needs to be written, tested and maintained.

[danieleteti]

Now sample "serversideviews_mustache" uses this new deserializer.

https://github.com/danieleteti/delphimvcframework/blob/master/samples/serversideviews_mustache/WebSiteControllerU.pas#L37

https://github.com/danieleteti/delphimvcframework/blob/master/samples/serversideviews_mustache/WebSiteControllerU.pas#L228