* Configurable HTTP Status codes

git-svn-id: trunk@41585 -

packages/fcl-web/src/restbridge/sqldbrestauth.pp

@@ -236,7 +236,7 @@ begin
     IO.UserID:=UID
   else
     begin
-    IO.Response.Code:=401;
+    IO.Response.Code:=IO.RestStatuses.GetStatusCode(rsUnauthorized);
     IO.Response.CodeText:=SUnauthorized;
     IO.Response.WWWAuthenticate:=Format('BASIC Realm: "%s"',[AuthenticationRealm]);
     end;

packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -192,11 +192,13 @@ Type
     FSchemas: TSQLDBRestSchemaList;
     FListRoute: THTTPRoute;
     FItemRoute: THTTPRoute;
+    FStatus: TRestStatusConfig;
     FStrings: TRestStringsConfig;
     procedure SetActive(AValue: Boolean);
     procedure SetAuthenticator(AValue: TRestAuthenticator);
     procedure SetConnections(AValue: TSQLDBRestConnectionList);
     procedure SetSchemas(AValue: TSQLDBRestSchemaList);
+    procedure SetStatus(AValue: TRestStatusConfig);
     procedure SetStrings(AValue: TRestStringsConfig);
   Protected
     // Auxiliary methods.
@@ -207,6 +209,7 @@ Type
     Function CreateConnectionList : TSQLDBRestConnectionList; virtual;
     Function CreateSchemaList : TSQLDBRestSchemaList; virtual;
     function CreateRestStrings: TRestStringsConfig; virtual;
+    function CreateRestStatusConfig: TRestStatusConfig; virtual;
     function CreateDBHandler(IO: TRestIO): TSQLDBRestDBHandler; virtual;
     function CreateInputStreamer(IO: TRestIO): TRestInputStreamer; virtual;
     function CreateOutputStreamer(IO: TRestIO): TRestOutputStreamer; virtual;
@@ -277,6 +280,8 @@ Type
     Property DefaultConnection : UTF8String Read FDefaultConnection Write FDefaultConnection;
     // Input/Output strings configuration
     Property Strings : TRestStringsConfig Read FStrings Write SetStrings;
+    // HTTP Status codes configuration
+    Property Statuses : TRestStatusConfig Read FStatus Write SetStatus;
     // default Output options, modifiable by query.
     Property OutputOptions : TRestOutputOptions Read FOutputOptions Write FOutputOptions Default allOutputOptions;
     // Set this to allow only this input format.
@@ -428,6 +433,12 @@ begin
   FSchemas.Assign(AValue);
 end;
 
+procedure TSQLDBRestDispatcher.SetStatus(AValue: TRestStatusConfig);
+begin
+  if FStatus=AValue then Exit;
+  FStatus.Assign(AValue);
+end;
+
 procedure TSQLDBRestDispatcher.SetStrings(AValue: TRestStringsConfig);
 begin
   if FStrings=AValue then Exit;
@@ -523,8 +534,8 @@ begin
     aName:='json';
   D:=TStreamerFactory.Instance.FindStreamerByName(rstInput,aName);
   if (D=Nil) then
-    Raise ESQLDBRest.CreateFmt(400,SErrUnknownOrUnSupportedFormat,[aName]);
-  Result:=TRestInputStreamer(D.MyClass.Create(IO.RequestContentStream,Fstrings,@IO.DoGetVariable));
+    Raise ESQLDBRest.CreateFmt(FStatus.GetStatusCode(rsInvalidParam),SErrUnknownOrUnSupportedFormat,[aName]);
+  Result:=TRestInputStreamer(D.MyClass.Create(IO.RequestContentStream,Fstrings,FStatus,@IO.DoGetVariable));
 end;
 
 function TSQLDBRestDispatcher.CreateOutputStreamer(IO : TRestIO): TRestOutputStreamer;
@@ -539,8 +550,8 @@ begin
     aName:='json';
   D:=TStreamerFactory.Instance.FindStreamerByName(rstOutput,aName);
   if (D=Nil) then
-    Raise ESQLDBRest.CreateFmt(400,SErrUnknownOrUnSupportedFormat,[aName]);
-  Result:=TRestOutputStreamer(D.MyClass.Create(IO.Response.ContentStream,Fstrings,@IO.DoGetVariable));
+    Raise ESQLDBRest.CreateFmt(FStatus.GetStatusCode(rsInvalidParam),SErrUnknownOrUnSupportedFormat,[aName]);
+  Result:=TRestOutputStreamer(D.MyClass.Create(IO.Response.ContentStream,Fstrings,FStatus,@IO.DoGetVariable));
 end;
 
 
@@ -558,6 +569,7 @@ begin
     // Set up output
     Result.Response.ContentStream:=TMemoryStream.Create;
     Result.Response.FreeContentStream:=True;
+    Result.SetRestStatuses(FStatus);
     Result.SetRestStrings(FStrings);
     aInput:=CreateInputStreamer(Result);
     aoutPut:=CreateOutPutStreamer(Result);
@@ -610,6 +622,7 @@ begin
   FSchemas:=CreateSchemaList;
   FOutputOptions:=allOutputOptions;
   FDispatchOptions:=DefaultDispatcherOptions;
+  FStatus:=CreateRestStatusConfig;
 end;
 
 destructor TSQLDBRestDispatcher.Destroy;
@@ -621,6 +634,7 @@ begin
   FreeAndNil(FSchemas);
   FreeAndNil(FConnections);
   FreeAndNil(FStrings);
+  FreeAndNil(FStatus);
   inherited Destroy;
 end;
 
@@ -630,6 +644,11 @@ begin
   Result:=TRestStringsConfig.Create
 end;
 
+function TSQLDBRestDispatcher.CreateRestStatusConfig: TRestStatusConfig;
+begin
+  Result:=TRestStatusConfig.Create;
+end;
+
 function TSQLDBRestDispatcher.ExtractRestResourceName(IO: TRestIO): UTF8String;
 
 begin
@@ -921,18 +940,18 @@ end;
 procedure TSQLDBRestDispatcher.SetDefaultResponsecode(IO : TRestIO);
 
 Const
-  DefaultCodes : Array[TRestOperation] of Integer = (500,200,201,200,204,200,200);
+  DefaultCodes : Array[TRestOperation] of TRestStatus = (rsError,rsGetOK,rsPOSTOK,rsPUTOK,rsDeleteOK,rsCORSOK,rsGetOK);
   DefaultTexts : Array[TRestOperation] of string = ('Internal Error','OK','Created','OK','No content','OK','OK');
 
 Var
-  aCode : Integer;
+  aCode : TRestStatus;
   aText : String;
 
 begin
   aCode:=DefaultCodes[IO.Operation];
   aText:=DefaultTexts[IO.Operation];
   if IO.Response.Code=0 then
-    IO.Response.Code:=aCode;
+    IO.Response.Code:=FStatus.GetStatusCode(aCode);
   if (IO.Response.CodeText='') then
     IO.Response.CodeText:=aText;
 end;
@@ -1106,7 +1125,7 @@ Var
 begin
   ST:=IO.Connection.GetStatementInfo(aSQL).StatementType;
   if (st<>stSelect) then
-    Raise ESQLDBRest.Create(400,'Only SELECT SQL is allowed for custom view'); // Should never happen.
+    raise ESQLDBRest.Create(FStatus.GetStatusCode(rsInvalidParam), SErrOnlySELECTSQLAllowedInCustomView); // Should never happen.
   Q:=TRestSQLQuery.Create(aOwner);
   try
     Q.DataBase:=IO.Connection;
@@ -1134,13 +1153,13 @@ begin
   else if (IO.Resource=FMetadataDetailResource) then
     begin
     if IO.GetVariable('ID',RN,[vsRoute,vsQuery])=vsNone then
-      Raise ESQLDBRest.Create(500,'Could not find resource name'); // Should never happen.
+      raise ESQLDBRest.Create(FStatus.GetStatusCode(rsError), SErrCouldNotFindResourceName); // Should never happen.
     Result:=CreateMetadataDetailDataset(IO,RN,AOwner)
     end
   else   if (IO.Resource=FCustomViewResource) then
     begin
     if IO.GetVariable(FStrings.GetRestString(rpCustomViewSQLParam),RN,[vsRoute,vsQuery])=vsNone then
-      Raise ESQLDBRest.Create(400,'Could not find SQL statement for custom view'); // Should never happen.
+      raise ESQLDBRest.Create(FStatus.GetStatusCode(rsInvalidParam), SErrNoSQLStatement); // Should never happen.
     Result:=CreateCustomViewDataset(IO,RN,aOwner);
     end
 
@@ -1159,7 +1178,7 @@ begin
     Allowed:=(ExtractRestOperation(IO.Request,True) in ([roUnknown]+IO.Resource.AllowedOperations));
   if not Allowed then
     begin
-    IO.Response.Code:=403;
+    IO.Response.Code:=FStatus.GetStatusCode(rsCORSNotAllowed);
     IO.Response.CodeText:='FORBIDDEN';
     IO.CreateErrorResponse;
     end
@@ -1171,7 +1190,7 @@ begin
     IO.Response.SetCustomHeader('Access-Control-Allow-Origin',S);
     S:=IO.Resource.GetHTTPAllow;
     IO.Response.SetCustomHeader('Access-Control-Allow-Methods',S);
-    IO.Response.Code:=200;
+    IO.Response.Code:=FStatus.GetStatusCode(rsCORSOK);
     IO.Response.CodeText:='OK';
     end;
 end;
@@ -1277,7 +1296,7 @@ begin
   Result:=(aIO.Operation in aIO.Resource.GetAllowedOperations(aIO.RestContext));
 end;
 
-Function TSQLDBRestDispatcher.CheckResourceAccess(IO : TRestIO) : Boolean;
+function TSQLDBRestDispatcher.CheckResourceAccess(IO: TRestIO): Boolean;
 
 Var
   NeedDB : Boolean;
@@ -1289,12 +1308,12 @@ begin
     exit;
   Result:=AllowRestResource(IO);
   if not Result then
-    CreateErrorContent(IO,403,'Forbidden')
+    CreateErrorContent(IO,FStatus.GetStatusCode(rsResourceNotAllowed),'FORBIDDEN')
   else
     begin
     Result:=AllowRestOperation(IO);
     if not Result then
-      CreateErrorContent(IO,405,'Method not allowed')
+      CreateErrorContent(IO,FStatus.GetStatusCode(rsRestOperationNotAllowed),'METHOD NOT ALLOWED')
     end;
 end;
 
@@ -1309,20 +1328,20 @@ var
 begin
   Operation:=ExtractRestOperation(IO.Request);
   if (Operation=roUnknown) then
-    CreateErrorContent(IO,400,'Invalid method')
+    CreateErrorContent(IO,FStatus.GetStatusCode(rsInvalidMethod),'INVALID METHOD')
   else
     begin
     IO.SetOperation(Operation);
     ResourceName:=ExtractRestResourceName(IO);
     if (ResourceName='') then
-      CreateErrorContent(IO,404,'Invalid resource')
+      CreateErrorContent(IO,FStatus.GetStatusCode(rsNoResourceSpecified),'INVALID RESOURCE')
     else
       begin
       Resource:=FindSpecialResource(IO,ResourceName);
       If Resource=Nil then
         Resource:=FindRestResource(ResourceName);
       if Resource=Nil then
-        CreateErrorContent(IO,404,'Invalid resource')
+        CreateErrorContent(IO,FStatus.GetStatusCode(rsUnknownResource),'NOT FOUND')
       else
         begin
         IO.SetResource(Resource);
@@ -1330,9 +1349,9 @@ begin
         if Connection=Nil then
           begin
           if (rdoConnectionInURL in DispatchOptions) then
-            CreateErrorContent(IO,400,Format(SErrNoconnection,[GetConnectionName(IO)]))
+            CreateErrorContent(IO,FStatus.GetStatusCode(rsNoConnectionSpecified),Format(SErrNoconnection,[GetConnectionName(IO)]))
           else
-            CreateErrorContent(IO,500,Format(SErrNoconnection,[GetConnectionName(IO)]));
+            CreateErrorContent(IO,FStatus.GetStatusCode(rsError), Format(SErrNoconnection,[GetConnectionName(IO)]));
           end
         else if CheckResourceAccess(IO) then
           if Operation=roOptions then
@@ -1394,7 +1413,7 @@ begin
         end;
       if (Code=0) then
         begin
-        Code:=500;
+        Code:=FStatus.GetStatusCode(rsError);
         Msg:=Format(SErrUnexpectedException,[E.ClassName,E.Message]);
         end;
       IO.Response.Code:=Code;
@@ -1406,7 +1425,7 @@ begin
   except
     on Ex : exception do
      begin
-     IO.Response.Code:=500;
+     IO.Response.Code:=FStatus.GetStatusCode(rsError);
      IO.Response.CodeText:=Format('Unexpected exception %s while handling original exception %s : "%s" (Original: "%s")',[Ex.ClassName,E.ClassName,Ex.Message,E.Message]);
      end;
   end;

packages/fcl-web/src/restbridge/sqldbrestconst.pp

@@ -45,6 +45,10 @@ Resourcestring
   SErrInvalidCDSMissingElement = 'Invalid CDS Data packet: missing %s element';
   SErrNoResourceDataFound = 'Failed to find resource data in input';
   SErrNoRESTDispatcher = 'No REST bridge dispatcher assigned to handle request!';
+  SErrCouldNotFindResourceName = 'Could not find resource name';
+  SErrNoSQLStatement = 'Could not find SQL statement for custom view';
+  SErrOnlySELECTSQLAllowedInCustomView = 'Only SELECT SQL is allowed for '
+    +'custom view';
 
 Const
   DefaultAuthenticationRealm = 'REST API Server';

packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -150,7 +150,7 @@ begin
   Result:='';
   if (IO.GetVariable('ID',Qry,[vsQuery,vsRoute,vsHeader])=vsNone) or (Qry='') then
     if not Assigned(PostParams) then
-      raise ESQLDBRest.Create(400,SErrNoKeyParam);
+      raise ESQLDBRest.Create(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrNoKeyParam);
   L:=FResource.GetFieldArray(flWhereKey);
   SetLength(FilteredFields,Length(L));
   for I:=0 to Length(L)-1 do
@@ -203,7 +203,7 @@ begin
           Case IO.StrToNullBoolean(Qry,True) of
             nbTrue : Result:=Result+Format('(%s IS NULL)',[RF.FieldName]);
             nbFalse : Result:=Result+Format('(%s IS NOT NULL)',[RF.FieldName]);
-            nbNone :  Raise ESQLDBRest.CreateFmt(400,SErrInvalidBooleanForField,[RF.PublicName])
+            nbNone :  Raise ESQLDBRest.CreateFmt(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrInvalidBooleanForField,[RF.PublicName])
           end;
         end;
   SetLength(FilteredFields,aLen);
@@ -252,11 +252,11 @@ begin
       While (J>=0) and Not SameText(L[J].PublicName,FN) do
         Dec(J);
       if J<0 then
-        Raise ESQLDBRest.CreateFmt(400,SErrInvalidSortField,[FN]);
+        Raise ESQLDBRest.CreateFmt(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrInvalidSortField,[FN]);
       F:=L[J];
       if Desc then
         if not (foOrderByDesc in F.Options) then
-          Raise ESQLDBRest.CreateFmt(400,SErrInvalidSortDescField,[FN]);
+          Raise ESQLDBRest.CreateFmt(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrInvalidSortDescField,[FN]);
       AddField(I-1,F,Desc)
       end;
     end;
@@ -447,7 +447,7 @@ begin
       begin
       P:=aQuery.Params.FindParam(FilterParamPrefix[FF.Operation]+F.FieldName);
       if not Assigned(P) then
-        Raise ESQLDBRest.CreateFmt(500,SErrFilterParamNotFound,[F.PublicName]);
+        Raise ESQLDBRest.CreateFmt(IO.RestStatuses.GetStatusCode(rsError),SErrFilterParamNotFound,[F.PublicName]);
       if Assigned(FF.ValueParam) then
         P.Value:=FF.ValueParam.Value
       else
@@ -481,7 +481,7 @@ begin
         if (D<>Nil) then
           SetParamFromData(P,F,D)
         else if (aOperation in [roDelete]) then
-          Raise ESQLDBRest.CreateFmt(400,SErrMissingParameter,[P.Name])
+          Raise ESQLDBRest.CreateFmt(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrMissingParameter,[P.Name])
         else
           P.Clear;
       finally
@@ -508,7 +508,7 @@ begin
   if aLimit=0 then
     exit;
   if Not (IO.Connection is TSQLConnector) then
-    Raise ESQLDBRest.Create(500,SErrLimitNotSupported);
+    Raise ESQLDBRest.Create(IO.RestStatuses.GetStatusCode(rsError),SErrLimitNotSupported);
   CT:=lowerCase(TSQLConnector(IO.Connection).ConnectorType);
   if Copy(CT,1,5)='mysql' then
     CT:='mysql';
@@ -656,7 +656,7 @@ end;
 procedure TSQLDBRestDBHandler.DoNotFound;
 
 begin
-  IO.Response.Code:=404;
+  IO.Response.Code:=IO.RestStatuses.GetStatusCode(rsRecordNotFound);
   IO.Response.CodeText:='NOT FOUND';  // Do not localize
   IO.CreateErrorResponse;
 end;
@@ -768,7 +768,7 @@ Var
 begin
   // We do this first, so we don't run any unnecessary queries
   if not IO.RESTInput.SelectObject(0) then
-    raise ESQLDBRest.Create(400, SErrNoResourceDataFound);
+    raise ESQLDBRest.Create(IO.RestStatuses.GetStatusCode(rsInvalidParam), SErrNoResourceDataFound);
   InsertNewRecord;
   // Now build response
   FieldList:=BuildFieldList(False);
@@ -814,7 +814,7 @@ Var
 begin
   // We do this first, so we don't run any unnecessary queries
   if not IO.RESTInput.SelectObject(0) then
-    Raise ESQLDBRest.Create(400,SErrNoResourceDataFound);
+    Raise ESQLDBRest.Create(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrNoResourceDataFound);
   // Get the original record.
   FieldList:=BuildFieldList(True);
   D:=GetDatasetForResource(FieldList,True);

packages/fcl-web/src/restbridge/sqldbrestio.pp

@@ -133,6 +133,75 @@ Type
     Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
   end;
 
+  TRestStatus = (rsError,                   // Internal logic/unexpected error (500)
+                 rsGetOK,                   // GET command completed OK (200)
+                 rsPostOK,                  // POST command completed OK (204)
+                 rsPutOK,                   // PUT command completed OK (200)
+                 rsDeleteOK,                // DELETE command completed OK (204)
+                 rsInvalidParam,            // Something wrong/missing in Query parameters (400)
+                 rsCORSOK,                  // CORS request completed OK (200)
+                 rsCORSNotAllowed,          // CORS request not allowed (403)
+                 rsUnauthorized,            // Authentication failed (401)
+                 rsResourceNotAllowed,      // Resource request not allowed (403)
+                 rsRestOperationNotAllowed, // Resource operation (method) not allowed (405)
+                 rsInvalidMethod,           // Invalid HTTP method (400)
+                 rsUnknownResource,         // Unknown resource (404)
+                 rsNoResourceSpecified,     // Unable to determine resource (404)
+                 rsNoConnectionSpecified,   // Unable to determine connection for (400)
+                 rsRecordNotFound,          // Query did not return record for single resource (404)
+                 rsInvalidContent           // Invalid content for POST/PUT operation (400)
+
+                 );
+  TRestStatuses = set of TRestStatus;
+
+  { TRestStatusConfig }
+
+  TRestStatusConfig = Class(TPersistent)
+  private
+    FStatus : Array[TRestStatus] of Word;
+    function GetStatus(AIndex: Integer): Word;
+    function IsStatusStored(AIndex: Integer): Boolean;
+    procedure SetStatus(AIndex: Integer; AValue: Word);
+  Public
+    Procedure Assign(aSource : TPersistent); override;
+    function GetStatusCode(aStatus : TRestStatus): Word;
+  Published
+    // Internal logic/unexpected error (500)
+    Property Error : Word Index Ord(rsError) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // GET command completed OK (200)
+    Property GetOK : Word Index Ord(rsGetOK) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // POST command completed OK (204)
+    Property PostOK : Word Index Ord(rsPostOK) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // PUT command completed OK (200)
+    Property PutOK : Word Index Ord(rsPutOK) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // DELETE command completed OK (204)
+    Property DeleteOK : Word Index Ord(rsDeleteOK) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Something wrong/missing in Query parameters (400)
+    Property InvalidParam : Word Index Ord(rsInvalidParam) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // CORS request completed OK (200)
+    Property CORSOK : Word Index Ord(rsCORSOK) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // CORS request not allowed (403)
+    Property CORSNotAllowed : Word Index Ord(rsCORSNotAllowed) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Authentication failed (401)
+    Property Unauthorized : Word Index Ord(rsUnauthorized) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Resource request not allowed (403)
+    Property ResourceNotAllowed : Word Index Ord(rsResourceNotAllowed) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Resource operation (method) not allowed (405)
+    Property RestOperationNotAllowed : Word Index Ord(rsRestOperationNotAllowed) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Invalid HTTP method (400)
+    Property InvalidMethod : Word Index Ord(rsInvalidMethod) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Unknown resource (404)
+    Property UnknownResource : Word Index Ord(rsUnknownResource) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Unable to determine resource (404)
+    Property NoResourceSpecified : Word Index Ord(rsNoResourceSpecified) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Unable to determine connection for (400)
+    Property NoConnectionSpecified : Word Index Ord(rsNoConnectionSpecified) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Query did not return record for single resource (404)
+    Property RecordNotFound : Word Index Ord(rsRecordNotFound) Read GetStatus Write SetStatus Stored IsStatusStored;
+    // Invalid content for POST/PUT operation (400)
+    Property InvalidContent : Word Index Ord(rsInvalidContent) Read GetStatus Write SetStatus Stored IsStatusStored;
+  end;
+
   { TRestStreamer }
 
   TRestStreamer = Class(TObject)
@@ -140,12 +209,14 @@ Type
     FStream: TStream;
     FOnGetVar : TRestGetVariableEvent;
     FStrings: TRestStringsConfig;
+    FStatuses : TRestStatusConfig;
   Public
     // Registry
     Class Function GetContentType : String; virtual;
-    Constructor Create(aStream : TStream;aStrings : TRestStringsConfig;aOnGetVar : TRestGetVariableEvent);
+    Constructor Create(aStream : TStream;aStrings : TRestStringsConfig;aStatus : TRestStatusConfig; aOnGetVar : TRestGetVariableEvent);
     Function GetString(aString : TRestStringProperty) : UTF8String;
     Property Strings : TRestStringsConfig Read FStrings;
+    Property Statuses : TRestStatusConfig Read FStatuses;
     procedure InitStreaming; virtual; abstract;
     Function GetVariable(const aName : UTF8String) : UTF8String;
     Property Stream : TStream Read FStream;
@@ -217,6 +288,7 @@ Type
     FResourceName: UTF8String;
     FResponse: TResponse;
     FRestContext: TRestContext;
+    FRestStatuses: TRestStatusConfig;
     FRestStrings: TRestStringsConfig;
     FSchema: UTF8String;
     FTrans: TSQLTransaction;
@@ -233,6 +305,7 @@ Type
     Procedure SetResource(aResource : TSQLDBRestResource);
     procedure SetOperation(aOperation : TRestOperation);
     Procedure SetRestStrings(aValue : TRestStringsConfig);
+    Procedure SetRestStatuses(aValue : TRestStatusConfig);
     // Get things
     class function StrToNullBoolean(S: String; Strict: Boolean): TNullBoolean;
     Procedure DoGetVariable(Sender : TObject; Const aName : UTF8String; Out aVal : UTF8String);
@@ -252,6 +325,7 @@ Type
     Property Transaction : TSQLTransaction Read FTrans Write FTrans;
     Property Resource : TSQLDBRestResource Read FResource;
     Property RestStrings : TRestStringsConfig Read FRestStrings;
+    Property RestStatuses : TRestStatusConfig Read FRestStatuses;
     // owned by TRestIO
     Property RESTInput : TRestInputStreamer read FInput;
     Property RESTOutput : TRestOutputStreamer read FOutput;
@@ -358,6 +432,73 @@ Const
     'sql',             { rpCustomViewSQLParam }
     'datapacket'       { rpXMLDocumentRoot}
   );
+  DefaultStatuses : Array[TRestStatus] of Word = (
+    500, { rsError }
+    200, { rsGetOK }
+    201, { rsPostOK }
+    200, { rsPutOK }
+    204, { rsDeleteOK }
+    400, { rsInvalidParam }
+    200, { rsCORSOK}
+    403, { rsCORSNotallowed}
+    401, { rsUnauthorized }
+    403, { rsResourceNotAllowed }
+    405, { rsRestOperationNotAllowed }
+    400, { rsInvalidMethod }
+    404, { rsUnknownResource }
+    404, { rsNoResourceSpecified }
+    400, { rsNoConnectionSpecified }
+    404, { rsRecordNotFound }
+    400  { rsInvalidContent }
+  );
+
+{ TRestStatusConfig }
+
+function TRestStatusConfig.GetStatus(AIndex: Integer): Word;
+begin
+  Result:=GetStatusCode(TRestStatus(aIndex));
+end;
+
+function TRestStatusConfig.IsStatusStored(AIndex: Integer): Boolean;
+
+Var
+  W : Word;
+
+begin
+  W:=FStatus[TRestStatus(aIndex)];
+  Result:=(W<>0) and (W<>DefaultStatuses[TRestStatus(aIndex)]);
+end;
+
+procedure TRestStatusConfig.SetStatus(AIndex: Integer; AValue: Word);
+begin
+  if (aValue<>DefaultStatuses[TRestStatus(aIndex)]) then
+    aValue:=0;
+  FStatus[TRestStatus(aIndex)]:=aValue;
+end;
+
+procedure TRestStatusConfig.Assign(aSource: TPersistent);
+
+Var
+  C : TRestStatusConfig;
+  S : TRestStatus;
+
+begin
+  if aSource is TRestStatusConfig then
+    begin
+    C:=aSource as TRestStatusConfig;
+    for S in TRestStatus do
+      FStatus[S]:=C.FStatus[S];
+    end
+  else
+    inherited Assign(aSource);
+end;
+
+function TRestStatusConfig.GetStatusCode(aStatus: TRestStatus): Word;
+begin
+  Result:=FStatus[aStatus];
+  if Result=0 then
+    Result:=DefaultStatuses[aStatus];
+end;
 
 { TRestContext }
 
@@ -582,7 +723,7 @@ begin
     On E : Exception do
       begin
       S:=Format('Error formatting string "%s" with %d arguments. Original code: %d',[Fmt,Length(Args),aCode]);
-      aCode:=500;
+      aCode:=Statuses.GetStatusCode(rsError);
       end;
   end;
   CreateErrorContent(aCode,S);
@@ -630,11 +771,12 @@ end;
 
 { TRestStreamer }
 
-constructor TRestStreamer.Create(aStream: TStream; aStrings: TRestStringsConfig; aOnGetVar: TRestGetVariableEvent);
+constructor TRestStreamer.Create(aStream: TStream; aStrings: TRestStringsConfig; aStatus : TRestStatusConfig; aOnGetVar: TRestGetVariableEvent);
 begin
   FStream:=aStream;
   FOnGetVar:=aOnGetVar;
   FStrings:=aStrings;
+  FStatuses:=aStatus;
 end;
 
 function TRestStreamer.GetString(aString: TRestStringProperty): UTF8String;
@@ -729,6 +871,11 @@ begin
   FRestStrings:=aValue;
 end;
 
+procedure TRestIO.SetRestStatuses(aValue: TRestStatusConfig);
+begin
+  FRestStatuses:=aValue;
+end;
+
 procedure TRestIO.DoGetVariable(Sender: TObject; const aName: UTF8String; out
   aVal: UTF8String);
 begin
@@ -886,11 +1033,11 @@ begin
   if Not Result then
     Exit;
   if (S<>'') and not TryStrToInt64(S,aLimit) then
-    Raise ESQLDBRest.CreateFmt(400,SErrInvalidParam,[P]);
+    Raise ESQLDBRest.CreateFmt(RestStatuses.GetStatusCode(rsInvalidParam),SErrInvalidParam,[P]);
   P:=RestStrings.GetRestString(rpOffset);
   if GetVariable(P,S,[vsQuery])<>vsNone then
     if (S<>'') and not TryStrToInt64(S,aOffset) then
-      Raise ESQLDBRest.CreateFmt(400,SErrInvalidParam,[P]);
+      Raise ESQLDBRest.CreateFmt(RestStatuses.GetStatusCode(rsInvalidParam),SErrInvalidParam,[P]);
   if (aEnforceLimit>0) and (aLimit>aEnforceLimit) then
     aLimit:=aEnforceLimit;
 end;

packages/fcl-web/src/restbridge/sqldbrestjson.pp

@@ -87,7 +87,7 @@ begin
         end;
     end;
     if (FJSON=Nil)  then
-      Raise ESQLDBRest.CreateFmt(400,'Invalid JSON input: %s',[Msg]);
+      Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),'Invalid JSON input: %s',[Msg]);
     end;
 end;
 
@@ -150,7 +150,7 @@ end;
 procedure TJSONOutputStreamer.StartRow;
 begin
   if (FRow<>Nil) then
-    Raise ESQLDBRest.Create(500,SErrDoubleRowStart);
+    Raise ESQLDBRest.Create(Statuses.GetStatusCode(rsError),SErrDoubleRowStart);
   FRow:=TJSONObject.Create;
   FData.Add(FRow);
 end;
@@ -165,7 +165,7 @@ begin
   Result:=Nil;
   F:=aPair.DBField;;
   If (aPair.RestField.FieldType=rftUnknown) then
-    raise ESQLDBRest.CreateFmt(500,SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]);
+    raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]);
   If (F.IsNull) then
     Exit;
     Case aPair.RestField.FieldType of
@@ -190,7 +190,7 @@ Var
 begin
   N:=aPair.RestField.PublicName;
   if FRow=Nil then
-    Raise ESQLDBRest.CreateFmt(500,SErrFieldWithoutRow,[N]);
+    Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrFieldWithoutRow,[N]);
   D:=FieldToJSON(aPair);
   if (D=Nil) and ((not HasOption(ooSparse)) or (FRow is TJSONArray)) then
     D:=TJSONNull.Create;

packages/fcl-web/src/restbridge/sqldbrestxml.pp

@@ -158,13 +158,13 @@ begin
       end;
   end;
   if (FXML=Nil)  then
-    Raise ESQLDBRest.CreateFmt(400,SErrInvalidXMLInput,[Msg]);
+    Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),SErrInvalidXMLInput,[Msg]);
   FPacket:=FXML.DocumentElement;
   NN:=UTF8Decode(GetString(rpXMLDocumentRoot));
   if (NN<>'') then
     begin
     if FPacket.NodeName<>NN then
-      Raise ESQLDBRest.CreateFmt(400,SErrInvalidXMLInput,[SErrMissingDocumentRoot]);
+      Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),SErrInvalidXMLInput,[SErrMissingDocumentRoot]);
     NN:=UTF8Decode(GetString(rpDataRoot));
     N:=FPacket.FindNode(NN);
     end
@@ -178,7 +178,7 @@ begin
       N:=Nil
     end;
   if Not (Assigned(N) and (N is TDOMelement)) then
-    Raise ESQLDBRest.CreateFmt(400,SErrInvalidXMLInputMissingElement,[NN]);
+    Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsInvalidContent),SErrInvalidXMLInputMissingElement,[NN]);
   FData:=(N as TDOMelement);
 end;
 
@@ -211,7 +211,7 @@ end;
 procedure TXMLOutputStreamer.StartRow;
 begin
   if (FRow<>Nil) then
-    Raise ESQLDBRest.Create(500,SErrDoubleRowStart);
+    Raise ESQLDBRest.Create(Statuses.GetStatusCode(rsError),SErrDoubleRowStart);
   FRow:=FXML.CreateElement(UTF8Decode(GetString(rpRowName)));
   FData.AppendChild(FRow);
 end;
@@ -226,7 +226,7 @@ begin
   Result:=Nil;
   F:=aPair.DBField;;
   If (aPair.RestField.FieldType=rftUnknown) then
-    raise ESQLDBRest.CreateFmt(500,SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]);
+    raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrUnsupportedRestFieldType, [aPair.RestField.PublicName]);
   If (F.IsNull) then
     Exit;
   S:=FieldToString(aPair.RestField.FieldType,F);
@@ -243,7 +243,7 @@ Var
 begin
   N:=aPair.RestField.PublicName;
   if FRow=Nil then
-    Raise ESQLDBRest.CreateFmt(500,SErrFieldWithoutRow,[N]);
+    Raise ESQLDBRest.CreateFmt(Statuses.GetStatusCode(rsError),SErrFieldWithoutRow,[N]);
   D:=FieldToXML(aPair);
   if (D=Nil) and (not HasOption(ooSparse)) then
     D:=FXML.CreateElement(UTF8Decode(aPair.RestField.PublicName));