From 9c83b6b8e71d7b1bd76abd0d7ea29d4410c811ce Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 1 May 2020 10:37:36 +0000 Subject: [PATCH] * 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 - --- packages/fcl-web/src/jsonrpc/fpjsonrpc.pp | 337 +++++++++++++++++++++- 1 file changed, 333 insertions(+), 4 deletions(-) diff --git a/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp b/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp index b8fcc37df9..0d04c89aa4 100644 --- a/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp +++ b/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp @@ -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;