mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-29 12:40:25 +02:00
* Merging revisions r45047 from trunk:
------------------------------------------------------------------------
r45047 | michael | 2020-04-24 07:41:19 +0200 (Fri, 24 Apr 2020) | 1 line
* V2 may not contain error object
------------------------------------------------------------------------
git-svn-id: branches/fixes_3_2@45200 -
This commit is contained in:
michael
parent
561a02b4e1
commit
9c83b6b8e7
@ -27,6 +27,8 @@ Type
|
||||
{ ---------------------------------------------------------------------
|
||||
JSON-RPC Handler support
|
||||
---------------------------------------------------------------------}
|
||||
TJSONRPCHandlerDef = Class;
|
||||
TCustomJSONRPCDispatcher = Class;
|
||||
|
||||
{ TJSONParamDef }
|
||||
|
||||
@ -90,6 +92,7 @@ Type
|
||||
FOptions: TJSONRPCOptions;
|
||||
FParamDefs: TJSONParamDefs;
|
||||
FExecParams : TJSONData;
|
||||
FResultType: TJSONtype;
|
||||
procedure SetParamDefs(const AValue: TJSONParamDefs);
|
||||
Protected
|
||||
function CreateParamDefs: TJSONParamDefs; virtual;
|
||||
@ -107,7 +110,10 @@ Type
|
||||
Procedure CheckParams(Const Params : TJSONData);
|
||||
Function ParamByName(Const AName : String) : TJSONData;
|
||||
Function Execute(Const Params : TJSONData; AContext : TJSONRPCCallContext = Nil) : TJSONData;
|
||||
// Checked on incoming request
|
||||
Property ParamDefs : TJSONParamDefs Read FParamDefs Write SetParamDefs;
|
||||
// Used in parameter descriptions
|
||||
Property ResultType : TJSONtype Read FResultType Write FResultType;
|
||||
end;
|
||||
TCustomJSONRPCHandlerClass = Class of TCustomJSONRPCHandler;
|
||||
|
||||
@ -140,18 +146,60 @@ Type
|
||||
JSON-RPC dispatcher support
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
TCreateAPIOption = (caoFormatted,caoFullParams);
|
||||
TCreateAPIOptions = set of TCreateAPIOption;
|
||||
|
||||
{ TAPIDescriptionCreator }
|
||||
|
||||
TAPIDescriptionCreator = Class(TPersistent)
|
||||
private
|
||||
FDefaultOptions: TCreateAPIOptions;
|
||||
FDispatcher: TCustomJSONRPCDispatcher;
|
||||
FNameSpace : String;
|
||||
FURL : String;
|
||||
FAPIType : String;
|
||||
function GetNameSpace: String;
|
||||
function isNameSpaceStored: Boolean;
|
||||
Protected
|
||||
Function GetOwner: TPersistent; override;
|
||||
procedure AddParamDefs(O: TJSONObject; Defs: TJSONParamDefs); virtual;
|
||||
function CreateParamDef(aDef: TJSONParamDef): TJSONObject; virtual;
|
||||
function HandlerToAPIMethod(H: TCustomJSONRPCHandler; aOptions: TCreateAPIOptions): TJSONObject; virtual;
|
||||
function HandlerDefToAPIMethod(H: TJSONRPCHandlerDef; aOptions: TCreateAPIOptions): TJSONObject; virtual;
|
||||
function DefaultNameSpace: String; virtual;
|
||||
Function PublishHandler(H: TCustomJSONRPCHandler): Boolean; virtual;
|
||||
function PublishHandlerDef(HD: TJSONRPCHandlerDef): Boolean; virtual;
|
||||
Public
|
||||
Constructor Create(aDispatcher : TCustomJSONRPCDispatcher); virtual;
|
||||
Procedure Assign(Source : TPersistent); override;
|
||||
function CreateAPI(aOptions: TCreateAPIOptions): TJSONObject; overload;
|
||||
function CreateAPI : TJSONObject; overload;
|
||||
Property Dispatcher : TCustomJSONRPCDispatcher Read FDispatcher;
|
||||
Published
|
||||
// Namespace for API description. Must be set. Default 'FPWeb'
|
||||
Property NameSpace : String Read GetNameSpace Write FNameSpace Stored isNameSpaceStored;
|
||||
// URL property for API router. Must be set.
|
||||
Property URL : String Read FURL Write FURL;
|
||||
// "type". By default: 'remoting'
|
||||
Property APIType : String Read FAPIType Write FAPIType;
|
||||
// Default options for creating an API
|
||||
Property DefaultOptions : TCreateAPIOptions Read FDefaultOptions Write FDefaultOptions;
|
||||
end;
|
||||
|
||||
TJSONRPCDispatchOption = (jdoSearchRegistry, // Check JSON Handler registry
|
||||
jdoSearchOwner, // Check owner (usually webmodule) for request handler
|
||||
jdoJSONRPC1, // Allow JSON RPC-1
|
||||
jdoJSONRPC2, // Allow JSON RPC-2
|
||||
jdoRequireClass, // Require class name (as in Ext.Direct)
|
||||
jdoNotifications, // Allow JSON Notifications
|
||||
jdoStrictNotifications // Error if notification returned result. Default is to discard result.
|
||||
jdoStrictNotifications, // Error if notification returned result. Default is to discard result.
|
||||
jdoAllowAPI, // Allow client to get API description
|
||||
jdoCacheAPI // Cache the API description
|
||||
);
|
||||
TJSONRPCDispatchOptions = set of TJSONRPCDispatchOption;
|
||||
|
||||
Const
|
||||
DefaultDispatchOptions = [jdoSearchOwner,jdoJSONRPC1,jdoJSONRPC2,jdoNotifications];
|
||||
DefaultDispatchOptions = [jdoSearchOwner,jdoJSONRPC1,jdoJSONRPC2,jdoNotifications,jdoAllowAPI,jdoCacheAPI];
|
||||
|
||||
Type
|
||||
TDispatchRequestEvent = Procedure(Sender : TObject; Const AClassName,AMethod : TJSONStringType; Const Params : TJSONData) of object;
|
||||
@ -159,14 +207,21 @@ Type
|
||||
|
||||
{ TCustomJSONRPCDispatcher }
|
||||
|
||||
|
||||
TCustomJSONRPCDispatcher = Class(TComponent)
|
||||
private
|
||||
FAPICreator: TAPIDescriptionCreator;
|
||||
FFindHandler: TFindRPCHandlerEvent;
|
||||
FOnDispatchRequest: TDispatchRequestEvent;
|
||||
FOnEndBatch: TNotifyEvent;
|
||||
FOnStartBatch: TNotifyEvent;
|
||||
FOptions: TJSONRPCDispatchOptions;
|
||||
FCachedAPI : TJSONObject;
|
||||
FCachedAPIOptions : TCreateAPIOptions;
|
||||
procedure SetAPICreator(AValue: TAPIDescriptionCreator);
|
||||
Protected
|
||||
// Create TAPIDescriptionCreator instance. Must have self as owner
|
||||
Function CreateAPICreator : TAPIDescriptionCreator; virtual;
|
||||
// Find handler. If none found, nil is returned. Executes OnFindHandler if needed.
|
||||
// On return 'DoFree' must be set to indicate that the hand
|
||||
Function FindHandler(Const AClassName,AMethodName : TJSONStringType;AContext : TJSONRPCCallContext; Out FreeObject : TComponent) : TCustomJSONRPCHandler; virtual;
|
||||
@ -201,8 +256,17 @@ Type
|
||||
Class Function ParamsProperty : String; virtual;
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
Class Function TransactionProperty : String; virtual;
|
||||
// execute request(s) using context
|
||||
Function Execute(Requests : TJSONData;AContext : TJSONRPCCallContext = Nil) : TJSONData;
|
||||
// Create an API description. If options are not specified, APICreator.DefaultOptions is used.
|
||||
Function CreateAPI(aOptions : TCreateAPIOptions): TJSONObject; overload;
|
||||
Function CreateAPI : TJSONObject; overload;
|
||||
// Return API Description including namespace, as a string. If options are not specified, APICreator.DefaultOptions is used.
|
||||
Function APIAsString(aOptions : TCreateAPIOptions) : TJSONStringType; virtual;
|
||||
Function APIAsString : TJSONStringType; virtual;
|
||||
Property APICreator : TAPIDescriptionCreator Read FAPICreator Write SetAPICreator;
|
||||
end;
|
||||
|
||||
TJSONRPCDispatcher = Class(TCustomJSONRPCDispatcher)
|
||||
@ -212,6 +276,7 @@ Type
|
||||
Property OnFindHandler;
|
||||
Property OnEndBatch;
|
||||
Property Options;
|
||||
Property APICreator;
|
||||
end;
|
||||
|
||||
|
||||
@ -237,6 +302,7 @@ Type
|
||||
FDataModuleClass : TDataModuleClass;
|
||||
FHandlerMethodName: TJSONStringType;
|
||||
FHandlerClassName: TJSONStringType;
|
||||
FResultType: TJSONType;
|
||||
procedure CheckNames(const AClassName, AMethodName: TJSONStringType);
|
||||
function GetParamDefs: TJSONParamDefs;
|
||||
procedure SetFPClass(const AValue: TCustomJSONRPCHandlerClass);
|
||||
@ -256,6 +322,7 @@ Type
|
||||
Property AfterCreate : TJSONRPCHandlerEvent Read FAfterCreate Write FAfterCreate;
|
||||
Property ArgumentCount : Integer Read FArgumentCount Write FArgumentCount;
|
||||
Property ParamDefs : TJSONParamDefs Read GetParamDefs Write SetParamDefs;
|
||||
Property ResultType : TJSONType Read FResultType Write FResultType;
|
||||
end;
|
||||
TJSONRPCHandlerDefClass = Class of TJSONRPCHandlerDef;
|
||||
|
||||
@ -489,6 +556,36 @@ begin
|
||||
raise EJSONRPC.CreateFmt(SErrParams, [Format(Fmt, Args)]);
|
||||
end;
|
||||
|
||||
{ TAPIDescriptionCreator }
|
||||
|
||||
function TAPIDescriptionCreator.GetOwner: TPersistent;
|
||||
begin
|
||||
Result:=FDispatcher;
|
||||
end;
|
||||
|
||||
constructor TAPIDescriptionCreator.Create(aDispatcher: TCustomJSONRPCDispatcher);
|
||||
begin
|
||||
FDispatcher:=aDispatcher;
|
||||
DefaultOptions:=[caoFullParams];
|
||||
end;
|
||||
|
||||
procedure TAPIDescriptionCreator.Assign(Source: TPersistent);
|
||||
|
||||
Var
|
||||
C : TAPIDescriptionCreator absolute Source;
|
||||
|
||||
begin
|
||||
if Source is TAPIDescriptionCreator then
|
||||
begin
|
||||
URL:=C.URL;
|
||||
NameSpace:=C.FNameSpace;
|
||||
FAPIType:=C.APIType;
|
||||
DefaultOptions:=C.DefaultOptions;
|
||||
end
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
|
||||
{ TJSONParamDef }
|
||||
|
||||
@ -799,6 +896,167 @@ end;
|
||||
|
||||
{ TCustomJSONRPCDispatcher }
|
||||
|
||||
// Create API method description
|
||||
|
||||
Function TAPIDescriptionCreator.CreateParamDef(aDef: TJSONParamDef) : TJSONObject;
|
||||
|
||||
begin
|
||||
With aDef do
|
||||
Result:=TJSONObject.Create(['name',Name,'type',JSONTypeName(DataType),'required',Required]);
|
||||
end;
|
||||
|
||||
procedure TAPIDescriptionCreator.AddParamDefs(O: TJSONObject; Defs: TJSONParamDefs);
|
||||
|
||||
Var
|
||||
A : TJSONArray;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
A:=TJSONArray.Create;
|
||||
O.Add('paramdefs',A);
|
||||
For I:=0 to Defs.Count-1 do
|
||||
A.Add(CreateParamDef(Defs[i]));
|
||||
end;
|
||||
|
||||
Function TAPIDescriptionCreator.HandlerToAPIMethod (H: TCustomJSONRPCHandler; aOptions : TCreateAPIOptions): TJSONObject;
|
||||
|
||||
begin
|
||||
Result:=TJSONObject.Create(['name',H.Name,'len',H.ParamDefs.Count]);
|
||||
if Not (caoFullParams in aOptions) then exit;
|
||||
Result.Add('resulttype',JSONTypeName(H.ResultType));
|
||||
if (H.ParamDefs.Count>0) then
|
||||
AddParamDefs(Result,H.ParamDefs);
|
||||
end;
|
||||
|
||||
Function TAPIDescriptionCreator.HandlerDefToAPIMethod (H: TJSONRPCHandlerDef; aOptions: TCreateAPIOptions): TJSONObject;
|
||||
|
||||
begin
|
||||
Result:=TJSONObject.Create(['name',H.HandlerMethodName,'len',H.ArgumentCount]);
|
||||
if Not (caoFullParams in aOptions) then exit;
|
||||
Result.Add('resulttype',JSONTypeName(H.ResultType));
|
||||
if (H.ParamDefs.Count>0) then
|
||||
AddParamDefs(Result,H.ParamDefs);
|
||||
end;
|
||||
|
||||
function TAPIDescriptionCreator.GetNameSpace: String;
|
||||
begin
|
||||
Result:=FNameSpace;
|
||||
If (Result='') then
|
||||
Result:=DefaultNameSpace
|
||||
end;
|
||||
|
||||
function TAPIDescriptionCreator.isNameSpaceStored: Boolean;
|
||||
begin
|
||||
Result:=NameSpace<>DefaultNameSpace;
|
||||
end;
|
||||
|
||||
function TAPIDescriptionCreator.DefaultNameSpace: String;
|
||||
begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TAPIDescriptionCreator.PublishHandler(H: TCustomJSONRPCHandler): Boolean;
|
||||
begin
|
||||
Result:=(H<>Nil)
|
||||
end;
|
||||
|
||||
Function TAPIDescriptionCreator.PublishHandlerDef(HD: TJSONRPCHandlerDef): Boolean;
|
||||
|
||||
begin
|
||||
Result:=(HD<>Nil)
|
||||
end;
|
||||
|
||||
function TAPIDescriptionCreator.CreateAPI(aOptions: TCreateAPIOptions): TJSONObject;
|
||||
|
||||
Var
|
||||
A,D : TJSONObject;
|
||||
R : TJSONArray;
|
||||
N : TJSONStringType;
|
||||
H : TCustomJSONRPCHandler;
|
||||
I,J : Integer;
|
||||
M : TCustomJSONRPCHandlerManager;
|
||||
HD : TJSONRPCHandlerDef;
|
||||
search : Boolean;
|
||||
C : TComponent;
|
||||
|
||||
begin
|
||||
D:=TJSONObject.Create;
|
||||
try
|
||||
D.Add('url',URL);
|
||||
D.Add('type',APIType);
|
||||
A:=TJSONObject.Create;
|
||||
D.Add('actions',A);
|
||||
R:=Nil;
|
||||
N:='';
|
||||
Search:=assigned(Dispatcher) and (jdoSearchOwner in Dispatcher.Options);
|
||||
C:=Dispatcher.Owner;
|
||||
If Search and Assigned(C) then
|
||||
begin
|
||||
for I:=C.ComponentCount-1 downto 0 do
|
||||
If C.Components[i] is TCustomJSONRPCHandler then
|
||||
begin
|
||||
H:=C.Components[i] as TCustomJSONRPCHandler;
|
||||
if PublishHandler(H) then
|
||||
begin
|
||||
If (R=Nil) then
|
||||
begin
|
||||
N:=C.Name;
|
||||
R:=TJSONArray.Create;
|
||||
A.Add(N,R);
|
||||
end;
|
||||
R.Add(HandlerToAPIMethod(H,aOptions));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Search:=assigned(Dispatcher) and (jdoSearchRegistry in Dispatcher.Options);
|
||||
If Search then
|
||||
begin
|
||||
M:=JSONRPCHandlerManager;
|
||||
For I:=M.HandlerCount-1 downto 0 do
|
||||
begin
|
||||
HD:=M.HandlerDefs[i];
|
||||
if PublishHandlerDef(HD) then
|
||||
begin
|
||||
If (R=Nil) or (CompareText(N,HD.HandlerClassName)<>0) then
|
||||
begin
|
||||
N:=HD.HandlerClassName;
|
||||
J:=A.IndexOfName(N);
|
||||
If (J=-1) then
|
||||
begin
|
||||
R:=TJSONArray.Create;
|
||||
A.Add(N,R);
|
||||
end
|
||||
else
|
||||
R:=A.Items[J] as TJSONArray;
|
||||
end;
|
||||
R.Add(HandlerDefToAPIMethod(HD,aOptions));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result:=D;
|
||||
except
|
||||
FreeAndNil(D);
|
||||
Raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAPIDescriptionCreator.CreateAPI: TJSONObject;
|
||||
begin
|
||||
Result:=CreateAPI(DefaultOptions);
|
||||
end;
|
||||
|
||||
procedure TCustomJSONRPCDispatcher.SetAPICreator(AValue: TAPIDescriptionCreator);
|
||||
begin
|
||||
if FAPICreator=AValue then Exit;
|
||||
FAPICreator.Assign(AValue);
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCDispatcher.CreateAPICreator: TAPIDescriptionCreator;
|
||||
begin
|
||||
Result:=TAPIDescriptionCreator.Create(Self);
|
||||
end;
|
||||
|
||||
|
||||
function TCustomJSONRPCDispatcher.FindHandler(const AClassName, AMethodName: TJSONStringType;AContext : TJSONRPCCallContext;Out FreeObject : TComponent): TCustomJSONRPCHandler;
|
||||
|
||||
Var
|
||||
@ -861,9 +1119,11 @@ function TCustomJSONRPCDispatcher.FormatResult(Const AClassName, AMethodName: TJ
|
||||
Const Params,ID, Return : TJSONData) : TJSONData;
|
||||
|
||||
begin
|
||||
Result:=TJSONObject.Create(['result',Return,'error',TJSonNull.Create,transactionproperty,ID.Clone]);
|
||||
Result:=TJSONObject.Create(['result',Return,transactionproperty,ID.Clone]);
|
||||
if jdoJSONRPC2 in options then
|
||||
TJSONObject(Result).Add('jsonrpc','2.0');
|
||||
TJSONObject(Result).Add('jsonrpc','2.0')
|
||||
else
|
||||
TJSONObject(Result).Add('error',TJSonNull.Create);
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCDispatcher.CreateJSON2Error(const AMessage: String;
|
||||
@ -1100,9 +1360,17 @@ end;
|
||||
constructor TCustomJSONRPCDispatcher.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FAPICreator:=CreateAPICreator;
|
||||
FOptions:=DefaultDispatchOptions;
|
||||
end;
|
||||
|
||||
destructor TCustomJSONRPCDispatcher.Destroy;
|
||||
begin
|
||||
FreeAndNil(FAPICreator);
|
||||
FreeAndNil(FCachedAPI);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCDispatcher.Execute(Requests: TJSONData;AContext : TJSONRPCCallContext = Nil): TJSONData;
|
||||
begin
|
||||
If Assigned(FOnStartBatch) then
|
||||
@ -1114,6 +1382,58 @@ begin
|
||||
FOnEndBatch(Self);
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCDispatcher.CreateAPI(aOptions: TCreateAPIOptions): TJSONObject;
|
||||
|
||||
Var
|
||||
CAO : TCreateAPIOptions;
|
||||
|
||||
begin
|
||||
CAO:=aOptions-[caoFormatted];
|
||||
Result:=Nil;
|
||||
if (jdoCacheAPI in Options)
|
||||
and (FCachedAPI<>Nil)
|
||||
and (CAO=FCachedAPIOptions) then
|
||||
Result:=TJSONObject(FCachedAPI.Clone)
|
||||
else
|
||||
begin
|
||||
Result:=APICreator.CreateAPI(aOptions);
|
||||
if (jdoCacheAPI in Options) then
|
||||
begin
|
||||
FCachedAPI:=TJSONObject(Result.Clone);
|
||||
FCachedAPIOptions:=CAO;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCDispatcher.CreateAPI: TJSONObject;
|
||||
begin
|
||||
Result:=CreateAPI(APICreator.DefaultOptions);
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCDispatcher.APIAsString(aOptions: TCreateAPIOptions): TJSONStringType;
|
||||
|
||||
Var
|
||||
S : TJSONObject;
|
||||
|
||||
begin
|
||||
S:=CreateAPI(aOptions);
|
||||
try
|
||||
if caoFormatted in aOptions then
|
||||
Result:=S.FormatJSON()
|
||||
else
|
||||
Result:=S.AsJSON;
|
||||
if APICreator.NameSpace<>'' then
|
||||
Result:=APICreator.NameSpace+' = '+Result;
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomJSONRPCDispatcher.APIAsString: TJSONStringType;
|
||||
begin
|
||||
Result:=APIAsString(APICreator.DefaultOptions);
|
||||
end;
|
||||
|
||||
{ TJSONRPCHandlerDef }
|
||||
|
||||
procedure TJSONRPCHandlerDef.SetFPClass(const AValue: TCustomJSONRPCHandlerClass
|
||||
@ -1350,6 +1670,7 @@ begin
|
||||
D:=AddHandlerDef(CN,C.Name);
|
||||
D.ArgumentCount:=TCustomJSONRPCHandler(C).ParamDefs.Count;
|
||||
D.ParamDefs:=TCustomJSONRPCHandler(C).ParamDefs;
|
||||
D.ResultType:=TCustomJSONRPCHandler(C).ResultType;
|
||||
{$ifdef wmdebug}SendDebug('Registering provider '+C.Name);{$endif}
|
||||
D.FDataModuleClass:=TDataModuleClass(DM.ClassType);
|
||||
end;
|
||||
@ -1377,6 +1698,7 @@ Function TCustomJSONRPCHandlerManager.RegisterHandler(Const AClassName,
|
||||
Var
|
||||
I : Integer;
|
||||
B : Boolean;
|
||||
H : TCustomJSONRPCHandler;
|
||||
|
||||
begin
|
||||
B:=FRegistering;
|
||||
@ -1391,6 +1713,13 @@ begin
|
||||
Result:=AddHandlerDef(AClassName,AMEthodName);
|
||||
Result.HandlerClass:=AClass;
|
||||
Result.ArgumentCount:=AArgumentCount;
|
||||
H:=Aclass.Create(Nil);
|
||||
try
|
||||
Result.ParamDefs:=H.ParamDefs;
|
||||
Result.ResultType:=H.ResultType;
|
||||
finally
|
||||
H.Free;
|
||||
end;
|
||||
finally
|
||||
FRegistering:=B;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user