mORMot Open Source

   TSQLRecord = ...
     ...
   protected
     ...
     function Validate(aRest: TSQLRest; const aFields: array of RawUTF8; // just as reference in the code
       aInvalidFieldIndex: PInteger=nil): string; overload;
     //>>EMartin: Validate fields and return error list. Invoked from server side validate.
     function ValidateAll(aRest: TSQLRest; const aFields: TSQLFieldBits=[0..MAX_SQLFIELDS-1]): string; overload; virtual;
     //<<EMartin
     ...
   end;

   ...

   TSQLRestServer = ...
   private
     ...
     fPublishedMethods: TDynArrayHashed; // just as reference in the code
     fServerSideValidate: Boolean; //EMartin
   protected
     ...
     function InternalUpdateEvent(aEvent: TSQLEvent; aTable: TSQLRecordClass; aID: integer; // just as reference in the code
       aIsBlobFields: PSQLFieldBits): boolean; virtual;
     ///>>EMartin: this method will validate logic business rules on TSQLRecord from server side
     function Validate(const aURI: TSQLRestServerURIContext): Boolean; virtual;
     //<<EMartin
   public
     ...
     property SessionClass: TAuthSessionClass read fSessionClass write fSessionClass; // just as reference in the code
      //>>EMartin: this property indicates whether execute TSQLValidate from server
      // side
      property ServerSideValidate: Boolean read fServerSideValidate write fServerSideValidate;
      //<<EMartin
     ...
   end;

   ...

implementation
...
//>>EMartin
function TSQLRecord.ValidateAll(aRest: TSQLRest; const aFields: TSQLFieldBits=[0..MAX_SQLFIELDS-1]): string;
var f, i: integer;
    Value: RawUTF8;
    Validate: TSynValidate;
    ValidateRest: TSynValidateRest absolute Validate;
    ErrMsg: String;
    Writer: TTextWriter;
begin
  result := '';
  if (self=nil) or IsZero(aFields) then
    // avoid GPF and handle case if no field was selected
    exit;
  Writer := TTextWriter.CreateOwnedStream;
  with RecordProps do
  for f := 0 to Fields.Count-1 do
  if Fields.List[f].SQLFieldType in COPIABLE_FIELDS then begin
    if (Filters<>nil) and (Filters[f]<>nil) then
      for i := 0 to Filters[f].Count-1 do begin
        Validate := TSynValidate(Filters[f].List[i]);
        if Validate.InheritsFrom(TSynValidate) then begin
          if Value='' then
            Fields.List[f].GetValueVar(self,false,Value,nil);
          if Validate.InheritsFrom(TSynValidateRest) then begin
            // set additional parameters
            ValidateRest.fProcessRec := self;
            ValidateRest.fProcessRest := aRest;
          end;
          if not Validate.Process(f,Value,ErrMsg) then begin
            // TSynValidate process failed -> add error to list
            if ErrMsg='' then
              // no custom message -> show a default message
              ErrMsg := format(sValidationFailed,[
                GetCaptionFromClass(Validate.ClassType)]);
          with Writer do
          begin
            if (Text <> '') then
              AddShort(',');
            AddShort('{"error":"');
            AddJSONEscapeString(ErrMsg);
            AddShort('","fieldName":"');
            AddJSONEscape(pointer(Fields.List[f].Name));
            AddShort('","fieldIndex":');
            Add(f);
            AddShort('}');
          end;
          end;
        end;
      end;
    Value := '';
  end;
  Writer.SetText(Value);
  Writer.Free;
  Result := UTF8ToString(Value);
end;
//<<EMartin
...
TSQLRestServerURIContext.ExecuteORMWrite ...
  ...
begin
  ...
    // here, Table<>nil and TableIndex in [0..MAX_SQLTABLES-1]
    if not (TableIndex in Call.RestAccessRights^.POST) then // check User
      Call.OutStatus := HTML_NOTALLOWED else
    if (Server.ServerSideValidate and not Server.Validate(Self)) then //EMartin Call.outBody will contain error messages
        Call.OutStatus := HTML_BADREQUEST else //EMartin
  ...
      // PUT ModelRoot/TableName/ID[/BlobFieldName] to update member/BLOB content
      if not (TableIndex in Call.RestAccessRights^.PUT) then // check User
        Call.OutStatus := HTML_NOTALLOWED else
        if not Server.RecordCanBeUpdated(Table,ID,seUpdate,@CustomErrorMsg) then
          Call.OutStatus := HTML_NOTMODIFIED else
        if (Server.ServerSideValidate and not Server.Validate(Self)) then //EMartin Call.outBody will contain error messages
          Call.OutStatus := HTML_BADREQUEST else begin //EMartin browser will treat as error
  ...
        // ModelRoot/TableName/ID to delete a member
        if not (TableIndex in Call.RestAccessRights^.DELETE) then // check User
          Call.OutStatus := HTML_NOTALLOWED else
        if not Server.RecordCanBeUpdated(Table,ID,seDelete,@CustomErrorMsg)
           or (Server.ServerSideValidate and not Server.Validate(Self)) then //EMartin Call.outBody will contain error messages
          Call.OutStatus := HTML_BADREQUEST else begin
  ...
end;

...

//>>EMartin
function TSQLRestServer.Validate(const aURI: TSQLRestServerURIContext): Boolean;
var
  SQLRec: TSQLRecord;
  Decoder: TJSONObjectDecoder;
  I: Integer;
  ModifiedFields: TSQLFieldBits;
  lErrors: String;
begin
  Result := True;
  if (aURI.Call^.InBody = '') then
    Exit;
  SQLRec := aURI.Table.Create;
  try
    Retrieve(aURI.ID, SQLRec);
    Decoder.Decode(aURI.Call^.InBody,nil,pNonQuoted);
    for I := Low(Decoder.FieldNames) to High(Decoder.FieldNames) do
      if (SQLRec.GetFieldValue(Decoder.FieldNames[i]) <> Decoder.FieldValues[i]) then
      begin
        SQLRec.SetFieldValue(Decoder.FieldNames[i], Pointer(Decoder.FieldValues[i]));
        Include(ModifiedFields, I);
      end;
    if (ModifiedFields <> []) then
    begin
      lErrors := SQLRec.ValidateAll(Self, ModifiedFields);
      Result := (lErrors = '');
      if not Result then
        with TTextWriter.CreateOwnedStream do
        begin
          AddShort('{"errors":[');
          AddString(StringToUTF8(lErrors));
          AddShort(']}');
          SetText(aURI.Call^.OutBody);
          Free;
        end;
    end;
  finally
    SQLRec.Free;
  end;
end;
//<<EMartin
...
    

TSQLServerRest.ServerSideValidate := true;

{"errors":[{"error":"Expect at least 5 characters","fieldName":"Description","fieldIndex":1},{"error":"Category and subcategory cannot be the same","fieldName":"Parent","fieldIndex":6}]}