mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-11 18:08:15 +02:00
* OpenAPI support for SQLDBRest
This commit is contained in:
parent
3855187038
commit
2301f09d77
@ -46,6 +46,7 @@
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
|
@ -23,7 +23,7 @@ uses
|
||||
{$ENDIF}{$ENDIF}
|
||||
Classes, SysUtils, CustApp, sqldbrestbridge, fphttpapp, IBConnection, odbcconn, mysql55conn, mysql56conn, pqconnection,
|
||||
mssqlconn, oracleconnection, sqldbrestxml, sqldbrestio, sqldbrestschema, sqldbrestdata, sqldbrestjson, sqldbrestcsv, sqldbrestcds,
|
||||
sqldbrestado, sqldbrestconst, sqldbrestauth, sqldbrestini, sqldb, sqldbrestauthini;
|
||||
sqldbrestado, sqldbrestconst, sqldbrestauth, sqldbrestini, sqldb, sqldbrestauthini, sqldbrestopenapi;
|
||||
|
||||
type
|
||||
{ TXMLSQLDBRestDispatcher }
|
||||
@ -107,7 +107,7 @@ begin
|
||||
FAuth.DefaultUserName:='me';
|
||||
FAuth.DefaultPassword:='secret';
|
||||
FAuth.AuthenticateUserSQL.Text:='select uID from users where (uLogin=:UserName) and (uPassword=:Password)';
|
||||
FDisp.DispatchOptions:=FDisp.DispatchOptions+[rdoCustomView,rdoHandleCORS];
|
||||
FDisp.DispatchOptions:=FDisp.DispatchOptions+[rdoCustomView,rdoHandleCORS,rdoOpenAPI];
|
||||
UN:=GetOptionValue('u','user');
|
||||
if UN='' then
|
||||
UN:='You';
|
||||
|
@ -41,7 +41,8 @@ Type
|
||||
rdoLegacyPut, // Makes PUT simulate PATCH : Not all values are required, missing values will be gotten from previous record.
|
||||
rdoAllowNoRecordUpdates, // Check rows affected, rowsaffected = 0 is OK.
|
||||
rdoAllowMultiRecordUpdates, // Check rows affected, rowsaffected > 1 is OK.
|
||||
rdoSingleEmptyOK // When asking a single resource and it does not exist, an empty dataset is returned
|
||||
rdoSingleEmptyOK, // When asking a single resource and it does not exist, an empty dataset is returned
|
||||
rdoOpenAPI // Serve OpenAPI document.
|
||||
);
|
||||
|
||||
TRestDispatcherOptions = set of TRestDispatcherOption;
|
||||
@ -154,6 +155,7 @@ Type
|
||||
|
||||
|
||||
{ TSQLDBRestDispatcher }
|
||||
TSQLDBRestDispatcher = Class;
|
||||
|
||||
TResourceAuthorizedEvent = Procedure (Sender : TObject; aRequest : TRequest; Const aResource : UTF8String; var AllowResource : Boolean) of object;
|
||||
TGetConnectionNameEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : String; var AConnectionName : UTF8String) of object;
|
||||
@ -162,11 +164,14 @@ Type
|
||||
TRestOperationEvent = Procedure(Sender : TObject; aConn: TSQLConnection; aResource : TSQLDBRestResource) of object;
|
||||
TRestGetFormatEvent = Procedure(Sender : TObject; aRest : TRequest; var aFormat : String) of object;
|
||||
TRestLogEvent = Procedure(Sender : TObject; aType : TRestDispatcherLogOption; Const aMessage : UTF8String) of object;
|
||||
TOpenAPIRouteCallBack = Procedure(aDispatcher : TSQLDBRestDispatcher; aRequest : TRequest; aResponse : TResponse);
|
||||
|
||||
TSQLDBRestDispatcher = Class(TComponent)
|
||||
Private
|
||||
Class Var FIOClass : TRestIOClass;
|
||||
Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
|
||||
class var OpenAPIRequestHandler : TOpenAPIRouteCallBack;
|
||||
|
||||
private
|
||||
FAdminUserIDs: TStrings;
|
||||
FAfterPatch: TRestOperationEvent;
|
||||
@ -212,6 +217,7 @@ Type
|
||||
FListRoute: THTTPRoute;
|
||||
FItemRoute: THTTPRoute;
|
||||
FParamRoute: THTTPRoute;
|
||||
FOpenAPIRoute: THTTPRoute;
|
||||
FConnectionsRoute: THTTPRoute;
|
||||
FConnectionItemRoute: THTTPRoute;
|
||||
FMetadataRoute: THTTPRoute;
|
||||
@ -317,6 +323,8 @@ Type
|
||||
Public
|
||||
Class Procedure SetIOClass (aClass: TRestIOClass);
|
||||
Class Procedure SetDBHandlerClass (aClass: TSQLDBRestDBHandlerClass);
|
||||
class procedure SetOpenAPIRequestHandler(aHandler : TOpenAPIRouteCallBack);
|
||||
|
||||
Constructor Create(AOWner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
procedure RegisterRoutes;
|
||||
@ -324,6 +332,7 @@ Type
|
||||
procedure HandleMetadataParameterRequest(aRequest : TRequest; aResponse : TResponse);
|
||||
procedure HandleMetadataRequest(aRequest : TRequest; aResponse : TResponse);
|
||||
procedure HandleConnRequest(aRequest : TRequest; aResponse : TResponse);
|
||||
procedure HandleOpenAPIRequest(aRequest : TRequest; aResponse : TResponse);
|
||||
procedure HandleRequest(aRequest : TRequest; aResponse : TResponse);
|
||||
Procedure VerifyPathInfo(aRequest : TRequest);
|
||||
Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : Array of String; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
|
||||
@ -697,6 +706,20 @@ begin
|
||||
HandleRequest(aRequest,aResponse);
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestDispatcher.HandleOpenAPIRequest(aRequest: TRequest; aResponse: TResponse);
|
||||
|
||||
begin
|
||||
if Not Assigned(OpenAPIRequestHandler) then
|
||||
begin
|
||||
aResponse.Code:=404;
|
||||
aResponse.CodeText:='NOT FOUND';
|
||||
end
|
||||
else
|
||||
OpenAPIRequestHandler(Self,aRequest,aResponse);
|
||||
if not aResponse.ContentSent then
|
||||
aResponse.SendContent;
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestDispatcher.HandleMetadataRequest(aRequest: TRequest;aResponse: TResponse);
|
||||
|
||||
Var
|
||||
@ -752,10 +775,17 @@ begin
|
||||
end;
|
||||
Res:=Res+':connection/';
|
||||
end;
|
||||
if (rdoOpenAPI in DispatchOptions) then
|
||||
begin
|
||||
C:=Strings.GetRestString(rpOpenAPI);
|
||||
FOpenAPIRoute:=HTTPRouter.RegisterRoute(res+C,@HandleOpenAPIRequest);
|
||||
end;
|
||||
|
||||
Res:=Res+':resource';
|
||||
FListRoute:=HTTPRouter.RegisterRoute(res,@HandleRequest);
|
||||
FParamRoute:=HTTPRouter.RegisterRoute(Res+'/:ResourceName/'+P,@HandleMetadataParameterRequest);
|
||||
FItemRoute:=HTTPRouter.RegisterRoute(Res+'/:id',@HandleRequest);
|
||||
|
||||
end;
|
||||
|
||||
function TSQLDBRestDispatcher.GetInputFormat(IO : TRestIO) : String;
|
||||
@ -916,6 +946,11 @@ begin
|
||||
FDBHandlerClass:=TSQLDBRestDBHandler;
|
||||
end;
|
||||
|
||||
class procedure TSQLDBRestDispatcher.SetOpenAPIRequestHandler(aHandler: TOpenAPIRouteCallBack);
|
||||
begin
|
||||
OpenAPIRequestHandler:=aHandler;
|
||||
end;
|
||||
|
||||
constructor TSQLDBRestDispatcher.Create(AOWner: TComponent);
|
||||
begin
|
||||
inherited Create(AOWner);
|
||||
@ -2215,6 +2250,7 @@ begin
|
||||
Un(FMetadataItemRoute);
|
||||
Un(FMetadataParameterRoute);
|
||||
Un(FMetadataRoute);
|
||||
Un(FOpenAPIRoute);
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestDispatcher.HandleMetadataParameterRequest(
|
||||
|
@ -84,7 +84,8 @@ Type
|
||||
rpConnectionResourceName,
|
||||
rpParametersResourceName,
|
||||
rpParametersRoutePart,
|
||||
rpAttachment
|
||||
rpAttachment,
|
||||
rpOpenAPI
|
||||
);
|
||||
TRestStringProperties = Set of TRestStringProperty;
|
||||
|
||||
@ -146,6 +147,7 @@ Type
|
||||
Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
|
||||
Property ConnectionResourceName : UTF8string Index ord(rpConnectionResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
|
||||
Property AttachmentParam : UTF8String Index ord(rpAttachment) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
|
||||
Property OpenAPIEndPoint : UTF8String Index ord(rpOpenAPI) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
|
||||
end;
|
||||
|
||||
TRestStatus = (rsError, // Internal logic/unexpected error (500)
|
||||
@ -486,7 +488,8 @@ Const
|
||||
'_connection', { rpConnectionResourceName }
|
||||
'_parameters', { rpParametersResourceName }
|
||||
'parameters', { rpParametersRoutePart }
|
||||
'att' { rpAttachment }
|
||||
'att', { rpAttachment }
|
||||
'_openAPI' { rpOpenAPI }
|
||||
);
|
||||
DefaultStatuses : Array[TRestStatus] of Word = (
|
||||
500, { rsError }
|
||||
|
345
packages/fcl-web/src/restbridge/sqldbrestopenapi.pas
Normal file
345
packages/fcl-web/src/restbridge/sqldbrestopenapi.pas
Normal file
@ -0,0 +1,345 @@
|
||||
unit sqldbrestopenapi;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, httpdefs, sqldbrestbridge, sqldbrestschema, fpopenapi.objects, fpjson.schema.types,
|
||||
fpjson, fpjson.schema.schema, jsonwriter, fpopenapi.writer, sqldbrestio;
|
||||
|
||||
Const
|
||||
DefaultContentType = 'application/json';
|
||||
|
||||
type
|
||||
|
||||
{ TSLQDBRestSchemaToOpenAPI }
|
||||
|
||||
TSLQDBRestSchemaToOpenAPI = class(TComponent)
|
||||
private
|
||||
FBasePath: String;
|
||||
FContentType: String;
|
||||
FListPrefix: String;
|
||||
FListSuffix: String;
|
||||
FOperationIDDeletePrefix: String;
|
||||
FOperationIDGetPrefix: String;
|
||||
FOperationIDListPrefix: String;
|
||||
FOperationIDPatchPrefix: String;
|
||||
FOperationIDPostPrefix: String;
|
||||
FOperationIDPutPrefix: String;
|
||||
procedure ConvertResourceToPathItemID(aResource: TSQLDBRestResource; aOpenAPI: TOpenAPI);
|
||||
function GetComponentName(aResource: TSQLDBRestResource; aList: Boolean): string;
|
||||
function HasKeyField(aResource: TSQLDBRestResource): Boolean;
|
||||
procedure SetRequestBody(aAPIOperation: TAPIOperation; aResource: TSQLDBRestResource);
|
||||
Protected
|
||||
procedure ConvertResourceToListSchema(aResource: TSQLDBRestResource; aSchema: TJSONSchema);
|
||||
procedure ConvertResourceToPathItem(aResource: TSQLDBRestResource; aOpenAPI: TOpenAPI);
|
||||
procedure SetResponse(aAPIOperation: TAPIoperation; aOperationPrefix: String; aResource: TSQLDBRestResource; aList: Boolean);
|
||||
procedure ConvertFieldToProperty(aField: TSQLDBRestField; aSchema: TJSONSchema); virtual;
|
||||
function ConvertFieldTypeToSimpleType(aType: TRestFieldType): TSchemaSimpleType; virtual;
|
||||
procedure ConvertResourceToComponents(aResource: TSQLDBRestResource; aOpenAPI: TOpenAPI); virtual;
|
||||
procedure ConvertResourceToSchema(aResource: TSQLDBRestResource; aSchema: TJSONSchema); virtual;
|
||||
function FieldTypeHasStringFormat(aType: TRestFieldType; out aFormat: TStringFormatValidator): Boolean; virtual;
|
||||
Public
|
||||
Procedure InitDefaults;
|
||||
Public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
Procedure Convert(aSchema : TSQLDBRestSchema; aOpenAPI : TOpenAPI);
|
||||
Property ListPrefix : String Read FListPrefix Write FListPrefix;
|
||||
Property ListSuffix : String Read FListSuffix Write FListSuffix;
|
||||
Property BasePath : String Read FBasePath Write FBasePath;
|
||||
Property ContentType : String Read FContentType Write FContentType;
|
||||
Property OperationIDGetPrefix : String Read FOperationIDGetPrefix Write FOperationIDGetPrefix;
|
||||
Property OperationIDListPrefix : String Read FOperationIDListPrefix Write FOperationIDListPrefix;
|
||||
Property OperationIDPostPrefix : String Read FOperationIDPostPrefix Write FOperationIDPostPrefix;
|
||||
Property OperationIDPutPrefix : String Read FOperationIDPutPrefix Write FOperationIDPutPrefix;
|
||||
Property OperationIDPatchPrefix : String Read FOperationIDPatchPrefix Write FOperationIDPatchPrefix;
|
||||
Property OperationIDDeletePrefix : String Read FOperationIDDeletePrefix Write FOperationIDDeletePrefix;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TSLQDBRestSchemaToOpenAPI }
|
||||
|
||||
|
||||
constructor TSLQDBRestSchemaToOpenAPI.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
InitDefaults;
|
||||
end;
|
||||
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.InitDefaults;
|
||||
begin
|
||||
ContentType:=DefaultContentType;
|
||||
ListSuffix:='List';
|
||||
BasePath:='/REST/';
|
||||
OperationIDGetPrefix:='Get';
|
||||
OperationIDListPrefix:='List';
|
||||
OperationIDPostPrefix:='Create';
|
||||
OperationIDPutPrefix:='Replace';
|
||||
OperationIDPatchPrefix:='Update';
|
||||
OperationIDDeletePrefix:='Delete';
|
||||
end;
|
||||
|
||||
function TSLQDBRestSchemaToOpenAPI.FieldTypeHasStringFormat(aType : TRestFieldType; out aFormat: TStringFormatValidator) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=True;
|
||||
case aType of
|
||||
rftDate : aFormat:=sfvDate;
|
||||
rftTime : aFormat:=sfvTime;
|
||||
rftDateTime : aFormat:=sfvDatetime;
|
||||
rftBlob : aFormat:=sfvCustom;
|
||||
else
|
||||
Result:=False
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSLQDBRestSchemaToOpenAPI.ConvertFieldTypeToSimpleType(aType : TRestFieldType) : TSchemaSimpleType;
|
||||
|
||||
begin
|
||||
case aType of
|
||||
rftUnknown : Result:=sstAny;
|
||||
rftInteger : Result:=sstInteger;
|
||||
rftLargeInt : Result:=sstInteger;
|
||||
rftFloat : Result:=sstNumber;
|
||||
rftDate : Result:=sstString;
|
||||
rftTime : Result:=sstString;
|
||||
rftDateTime : Result:=sstString;
|
||||
rftString : Result:=sstString;
|
||||
rftBoolean : Result:=sstBoolean;
|
||||
rftBlob: Result:=sstString;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSLQDBRestSchemaToOpenAPI.HasKeyField(aResource : TSQLDBRestResource) : Boolean;
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
I:=0;
|
||||
While not Result and (I<aResource.Fields.Count) do
|
||||
begin
|
||||
Result:=foInKey in aResource.Fields[0].Options;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSLQDBRestSchemaToOpenAPI.GetComponentName(aResource : TSQLDBRestResource; aList : Boolean) : string;
|
||||
|
||||
begin
|
||||
Result:=aResource.ResourceName;
|
||||
if aList then
|
||||
Result:=ListPrefix+Result+ListSuffix;
|
||||
end;
|
||||
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.ConvertFieldToProperty(aField : TSQLDBRestField; aSchema : TJSONSchema);
|
||||
|
||||
var
|
||||
sst : TSchemaSimpleType;
|
||||
fvt : TStringFormatValidator;
|
||||
isActualString : Boolean;
|
||||
|
||||
|
||||
begin
|
||||
sst:=ConvertFieldTypeToSimpleType(aField.FieldType);
|
||||
aSchema.Validations.Types:=[sst];
|
||||
if (sst=sstString) then
|
||||
begin
|
||||
isActualString:=not FieldTypeHasStringFormat(aField.FieldType,fvt);
|
||||
if not IsActualString then
|
||||
aSchema.Validations.FormatValidator:=fvt
|
||||
else
|
||||
begin
|
||||
if aField.MaxLen>0 then
|
||||
aSchema.Validations.MaxLength:=aField.MaxLen;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.ConvertResourceToSchema(aResource: TSQLDBRestResource; aSchema : TJSONSchema);
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
lField : TSQLDBRestField;
|
||||
lFieldSchema: TJSONSchema;
|
||||
|
||||
begin
|
||||
aSchema.Validations.Types:=[sstObject];
|
||||
For I:=0 to aResource.Fields.Count-1 do
|
||||
begin
|
||||
lField:=aResource.Fields[I];
|
||||
lFieldSchema:=aSchema.Properties.Add(lField.PublicName);
|
||||
ConvertFieldToProperty(lField,lFieldSchema);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.ConvertResourceToListSchema(aResource: TSQLDBRestResource; aSchema : TJSONSchema);
|
||||
|
||||
var
|
||||
lSchema: TJSONSChema;
|
||||
|
||||
begin
|
||||
aSchema.Validations.Types:=[sstArray];
|
||||
lSchema:=TJSONSChema.Create(aSchema);
|
||||
lSchema.Ref:='#/components/schemas/'+GetComponentName(aResource,False);
|
||||
aSchema.Items.Add(lSchema);
|
||||
end;
|
||||
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.ConvertResourceToComponents(aResource: TSQLDBRestResource; aOpenAPI : TOpenAPI);
|
||||
|
||||
var
|
||||
lSchema : TJSONSchema;
|
||||
|
||||
begin
|
||||
lSchema:=aOpenAPI.Components.Schemas.Add(GetComponentName(aResource,False));
|
||||
ConvertResourceToSchema(aResource,lSchema);
|
||||
if roGet in aResource.AllowedOperations then
|
||||
begin
|
||||
lSchema:=aOpenAPI.Components.Schemas.Add(GetComponentName(aResource,True));
|
||||
ConvertResourceToListSchema(aResource,lSchema);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.SetResponse(aAPIOperation : TAPIoperation; aOperationPrefix : String; aResource : TSQLDBRestResource; aList : Boolean);
|
||||
|
||||
var
|
||||
lResponse : TResponse;
|
||||
lMedia : TMediaType;
|
||||
|
||||
begin
|
||||
aAPIOperation.OperationId:=aOperationPrefix+aResource.ResourceName;
|
||||
lResponse:=aAPIOperation.Responses.AddItem('default');
|
||||
lMedia:=lResponse.Content.AddItem(ContentType);
|
||||
lMedia.Schema.Ref:='#/components/schemas/'+GetComponentName(aResource,aList);
|
||||
end;
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.SetRequestBody(aAPIOperation : TAPIOperation; aResource :TSQLDBRestResource);
|
||||
|
||||
var
|
||||
lMedia : TMediaType;
|
||||
|
||||
begin
|
||||
lMedia:=aAPIOperation.RequestBody.Content.AddItem(ContentType);
|
||||
lMedia.Schema.Ref:='#/components/schemas/'+GetComponentName(aResource,False);
|
||||
end;
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.ConvertResourceToPathItem(aResource: TSQLDBRestResource; aOpenAPI : TOpenAPI);
|
||||
|
||||
var
|
||||
aPathItem : TPathItem;
|
||||
|
||||
begin
|
||||
aPathItem:=aOpenAPI.Paths.AddItem(aResource.ResourceName);
|
||||
if roGet in aResource.AllowedOperations then
|
||||
SetResponse(aPathItem.Get,OperationIDListPrefix,aResource,True);
|
||||
if roPost in aResource.AllowedOperations then
|
||||
begin
|
||||
SetResponse(aPathItem.Post,OperationIDPostPrefix,aResource,False);
|
||||
SetRequestBody(aPathItem.Post,aResource);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.ConvertResourceToPathItemID(aResource: TSQLDBRestResource; aOpenAPI : TOpenAPI);
|
||||
|
||||
var
|
||||
aPathItem : TPathItem;
|
||||
|
||||
begin
|
||||
if ([roGet,roPut,roPatch,roDelete] * aResource.AllowedOperations) = [] then
|
||||
exit;
|
||||
aPathItem:=aOpenAPI.Paths.AddItem(aResource.ResourceName+'/{ID}');
|
||||
if roGet in aResource.AllowedOperations then
|
||||
SetResponse(aPathItem.Get,OperationIDGetPrefix,aResource,False);
|
||||
if roPut in aResource.AllowedOperations then
|
||||
begin
|
||||
SetResponse(aPathItem.Put,OperationIDPutPrefix,aResource,False);
|
||||
SetRequestBody(aPathItem.Put,aResource);
|
||||
end;
|
||||
if roPatch in aResource.AllowedOperations then
|
||||
begin
|
||||
SetResponse(aPathItem.Patch,OperationIDPatchPrefix,aResource,False);
|
||||
SetRequestBody(aPathItem.Patch,aResource);
|
||||
end;
|
||||
if roDelete in aResource.AllowedOperations then
|
||||
SetResponse(aPathItem.Delete,OperationIDDeletePrefix,aResource,False);
|
||||
// if not aResource.AllowedOperations then
|
||||
end;
|
||||
|
||||
|
||||
procedure TSLQDBRestSchemaToOpenAPI.Convert(aSchema: TSQLDBRestSchema; aOpenAPI: TOpenAPI);
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
lResource : TSQLDBRestResource;
|
||||
|
||||
begin
|
||||
For I:=0 to aSchema.Resources.Count-1 do
|
||||
begin
|
||||
lResource:=aSchema.Resources[i];
|
||||
ConvertResourceToComponents(lResource,aOpenAPI);
|
||||
ConvertResourceToPathItem(lResource,aOpenAPI);
|
||||
if HasKeyField(lResource) then
|
||||
ConvertResourceToPathItemID(lResource,aOpenAPI);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure HandleOpenAPIRoute(aDispatcher : TSQLDBRestDispatcher; aRequest : TRequest; aResponse : httpdefs.TResponse);
|
||||
|
||||
var
|
||||
Converter : TSLQDBRestSchemaToOpenAPI;
|
||||
OpenAPI : TOpenAPI;
|
||||
Writer : TOpenAPIWriter;
|
||||
J : TJSONDataWriter;
|
||||
D : TJSONData;
|
||||
Schema : TSQLDBRestSchema;
|
||||
I : Integer;
|
||||
S : TJSONStringType;
|
||||
|
||||
begin
|
||||
J:=Nil;
|
||||
D:=NIl;
|
||||
OpenAPI:=Nil;
|
||||
Writer:=Nil;
|
||||
Converter:=TSLQDBRestSchemaToOpenAPI.Create(Nil);
|
||||
try
|
||||
OpenAPI:=TOpenAPI.Create;
|
||||
OpenAPI.OpenApi:='3.1.1';
|
||||
OpenAPI.Info.Title:='SQLDBRest interface '+aDispatcher.Name;
|
||||
OpenAPI.Info.Version:='1';
|
||||
For I:=0 to aDispatcher.Schemas.Count-1 do
|
||||
begin
|
||||
Schema:=aDispatcher.Schemas[i].Schema;
|
||||
Converter.Convert(Schema,OpenAPI);
|
||||
end;
|
||||
Writer:=TOpenAPIWriter.Create(Nil);
|
||||
J:=TJSONDataWriter.Create;
|
||||
Writer.Write(OpenAPI,J);
|
||||
D:=J.ExtractData;
|
||||
S:=aRequest.QueryFields.Values[aDispatcher.Strings.HumanReadableParam];
|
||||
if TRestIO.StrToNullBoolean(S,false)=nbTrue then
|
||||
S:=D.FormatJSON
|
||||
else
|
||||
S:=D.AsJSON;
|
||||
aResponse.Content:=S;
|
||||
aResponse.ContentType:='application/json';
|
||||
finally
|
||||
D.Free;
|
||||
J.Free;
|
||||
Writer.Free;
|
||||
Converter.Free;
|
||||
OpenAPI.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TSQLDBRestDispatcher.SetOpenAPIRequestHandler(@HandleOpenAPIRoute);
|
||||
end.
|
||||
|
284
packages/fcl-web/tests/testsqldbopenapi.pas
Normal file
284
packages/fcl-web/tests/testsqldbopenapi.pas
Normal file
@ -0,0 +1,284 @@
|
||||
unit testsqldbopenapi;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry, fpjson, fpjson.schema.types, fpjson.schema.schema,
|
||||
fpopenapi.types, fpopenapi.objects, sqldbrestschema, sqldbrestopenapi, fpopenapi.writer,
|
||||
jsonwriter;
|
||||
|
||||
|
||||
Type
|
||||
|
||||
{ TTestSQLDBRestOpenAPI }
|
||||
|
||||
TTestSQLDBRestOpenAPI = class(TTestCase)
|
||||
private
|
||||
FConverter: TSLQDBRestSchemaToOpenAPI;
|
||||
FOpenAPI: TOpenAPI;
|
||||
FSchema: TSQLDBRestSchema;
|
||||
protected
|
||||
procedure AssertGetOperation(aComponent: String);
|
||||
procedure AssertPostOperation(aComponent: String);
|
||||
procedure AssertListComponent(aComponent: string);
|
||||
procedure AssertListOperation(aComponent: String);
|
||||
procedure AssertSimpleComponent(aComponent: string; aExtraProperty: TSchemaSimpleType=sstNone);
|
||||
procedure Convert;
|
||||
function CreateResource(withID: boolean; aSecondFieldType: TRestFieldType): TSQLDBRestResource;
|
||||
Public
|
||||
Procedure SetUp; override;
|
||||
Procedure TearDown; override;
|
||||
Property Converter : TSLQDBRestSchemaToOpenAPI Read FConverter;
|
||||
Property OpenAPI : TOpenAPI Read FOpenAPI;
|
||||
Property Schema : TSQLDBRestSchema Read FSchema;
|
||||
Published
|
||||
Procedure TestHookup;
|
||||
procedure TestResourceReadOnly;
|
||||
procedure TestResourceReadOnlyWithID;
|
||||
procedure TestResourcePostOnly;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestSQLDBRestOpenAPI }
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
FConverter:=TSLQDBRestSchemaToOpenAPI.Create(Nil);
|
||||
FOpenAPI:=TOpenAPI.Create;
|
||||
FSchema:=TSQLDBRestSchema.Create(Nil);
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.TearDown;
|
||||
begin
|
||||
FreeAndNil(FSchema);
|
||||
FreeAndNil(FOpenAPI);
|
||||
FreeAndNil(FConverter);
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.TestHookup;
|
||||
begin
|
||||
AssertNotNull('Have converter',Converter);
|
||||
end;
|
||||
|
||||
function TTestSQLDBRestOpenAPI.CreateResource(withID : boolean; aSecondFieldType: TRestFieldType) : TSQLDBRestResource;
|
||||
|
||||
var
|
||||
lField : TSQLDBRestField;
|
||||
|
||||
begin
|
||||
Result:=Schema.Resources.AddResource('simple','simple');
|
||||
lField:=Result.Fields.AddField('id',rftInteger,[]);
|
||||
if WithID then
|
||||
lField.Options:=lField.Options+[foInKey];
|
||||
if aSecondFieldType<>rftUnknown then
|
||||
Result.Fields.AddField('b',aSecondFieldType,[]);
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.Convert;
|
||||
|
||||
var
|
||||
Writer : TOpenAPIWriter;
|
||||
J : TJSONDataWriter;
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
Converter.Convert(Schema,OpenAPI);
|
||||
Writer:=TOpenAPIWriter.Create(Nil);
|
||||
J:=TJSONDataWriter.Create;
|
||||
try
|
||||
Writer.Write(OpenAPI,J);
|
||||
Writeln(TestName,' OpenAPI:');
|
||||
D:=J.ExtractData;
|
||||
Writeln(D.FormatJSON);
|
||||
finally
|
||||
D.Free;
|
||||
J.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.AssertGetOperation(aComponent : String);
|
||||
|
||||
var
|
||||
lPath : TPathItem;
|
||||
Op : TAPIOperation;
|
||||
Res : TResponse;
|
||||
lMedia : TMediaType;
|
||||
|
||||
begin
|
||||
lPath:=OpenAPI.Paths[aComponent+'/{ID}'];
|
||||
AssertNotNull('have '+aComponent+'/{ID} path',lPath);
|
||||
AssertTrue('Get Operation',lPath.HasKeyWord(pkGet));
|
||||
OP:=lPath.Get;
|
||||
AssertEquals('Get OperationID','Get'+aComponent,OP.OperationId);
|
||||
AssertEquals('response count',1, OP.Responses.Count);
|
||||
AssertNotNull('Get default response',OP.Responses['default']);
|
||||
AssertEquals('response count',1, OP.Responses.Count);
|
||||
Res:=OP.Responses['default'];
|
||||
AssertNotNull('Have default response',Res);
|
||||
AssertTrue('Havemedia count',Res.HasKeyWord(rkContent));
|
||||
lMedia:=Res.Content.MediaTypes['application/json'];
|
||||
AssertNotNull('Have media',lMedia);
|
||||
AssertTrue('Have schema',lMedia.HasKeyWord(mtkSchema));
|
||||
AssertEquals('Have component ref','#components/schema/'+aComponent,lMedia.Schema.Ref);
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.AssertPostOperation(aComponent: String);
|
||||
var
|
||||
lPath : TPathItem;
|
||||
Op : TAPIOperation;
|
||||
Res : TResponse;
|
||||
lMedia : TMediaType;
|
||||
|
||||
begin
|
||||
lPath:=OpenAPI.Paths[aComponent];
|
||||
AssertNotNull('have '+aComponent+' path',lPath);
|
||||
AssertTrue('Post Operation',lPath.HasKeyWord(pkPost));
|
||||
OP:=lPath.Post;
|
||||
AssertEquals('Get OperationID','Create'+aComponent,OP.OperationId);
|
||||
AssertEquals('response count',1, OP.Responses.Count);
|
||||
AssertNotNull('Get default response',OP.Responses['default']);
|
||||
AssertEquals('response count',1, OP.Responses.Count);
|
||||
Res:=OP.Responses['default'];
|
||||
AssertNotNull('Have default response',Res);
|
||||
AssertTrue('Havemedia count',Res.HasKeyWord(rkContent));
|
||||
lMedia:=Res.Content.MediaTypes['application/json'];
|
||||
AssertNotNull('Have media',lMedia);
|
||||
AssertTrue('Have schema',lMedia.HasKeyWord(mtkSchema));
|
||||
AssertEquals('Have component ref','#components/schema/'+aComponent,lMedia.Schema.Ref);
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.AssertListOperation(aComponent : String);
|
||||
|
||||
var
|
||||
lPath : TPathItem;
|
||||
Op : TAPIOperation;
|
||||
Res : TResponse;
|
||||
lMedia : TMediaType;
|
||||
|
||||
begin
|
||||
lPath:=OpenAPI.Paths[aComponent];
|
||||
AssertNotNull('have '+acomponent+' path',lPath);
|
||||
AssertTrue('Get Operation',lPath.HasKeyWord(pkGet));
|
||||
OP:=lPath.Get;
|
||||
AssertEquals('Get OperationID','List'+aComponent,OP.OperationId);
|
||||
AssertEquals('response count',1, OP.Responses.Count);
|
||||
AssertNotNull('Get default response',OP.Responses['default']);
|
||||
AssertEquals('response count',1, OP.Responses.Count);
|
||||
Res:=OP.Responses['default'];
|
||||
AssertNotNull('Have default response',Res);
|
||||
AssertTrue('Havemedia count',Res.HasKeyWord(rkContent));
|
||||
lMedia:=Res.Content.MediaTypes['application/json'];
|
||||
AssertNotNull('Have media',lMedia);
|
||||
AssertTrue('Have schema',lMedia.HasKeyWord(mtkSchema));
|
||||
AssertEquals('Have component ref','#components/schema/'+aComponent+'List',lMedia.Schema.Ref);
|
||||
end;
|
||||
|
||||
Procedure TTestSQLDBRestOpenAPI.AssertSimpleComponent(aComponent : string; aExtraProperty : TSchemaSimpleType = sstNone);
|
||||
|
||||
var
|
||||
S,el : TJSONSchema;
|
||||
|
||||
begin
|
||||
AssertTrue('Components',OpenAPI.HasKeyWord(oakComponents));
|
||||
AssertTrue('Components.Schemas',OpenAPI.Components.HasKeyWord(ckSchemas));
|
||||
S:=OpenAPI.Components.Schemas[aComponent];
|
||||
AssertNotNull('Component '+aComponent+' Schema',S);
|
||||
AssertTrue(aComponent+' is array',S.Validations.Types=[sstObject]);
|
||||
AssertEquals(aComponent+' property count',1+Ord(aExtraProperty<>sstNone),S.properties.Count);
|
||||
el:=S.Properties[0];
|
||||
AssertNotNull(aComponent+'property 0 is valid',el);
|
||||
AssertEquals(aComponent+'property 0 is valid','id',el.Name);
|
||||
AssertTrue(aComponent+'property id type',el.Validations.Types=[sstInteger]);
|
||||
if aExtraProperty<>sstNone then
|
||||
begin
|
||||
el:=S.Properties[1];
|
||||
AssertNotNull(aComponent+'property 1 is valid',el);
|
||||
AssertEquals(aComponent+'property 1 is valid','b',el.Name);
|
||||
AssertTrue(aComponent+'property b type',el.Validations.Types=[aExtraProperty]);
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
Procedure TTestSQLDBRestOpenAPI.AssertListComponent(aComponent : string);
|
||||
|
||||
var
|
||||
S,el : TJSONSchema;
|
||||
|
||||
begin
|
||||
AssertTrue('Components',OpenAPI.HasKeyWord(oakComponents));
|
||||
AssertTrue('Components.Schemas',OpenAPI.Components.HasKeyWord(ckSchemas));
|
||||
S:=OpenAPI.Components.Schemas[aComponent+'List'];
|
||||
AssertNotNull('Component '+aComponent+'List Schema',S);
|
||||
AssertTrue(aComponent+' is array',S.Validations.Types=[sstArray]);
|
||||
AssertTrue(aComponent+' has 1 item',S.items.Count=1);
|
||||
el:=S.Items[0];
|
||||
AssertNotNull(aComponent+' item is valid',el);
|
||||
AssertEquals(aComponent+' reference to component','#components/schemas/'+aComponent,el.ref);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.TestResourceReadOnly;
|
||||
|
||||
var
|
||||
R : TSQLDBRestResource;
|
||||
|
||||
begin
|
||||
R:=CreateResource(False,rftUnknown);
|
||||
R.AllowedOperations:=[roGet];
|
||||
Convert;
|
||||
AssertTrue('Component schemas',OpenAPI.Components.HasKeyWord(ckSchemas));
|
||||
AssertEquals('Component Count',2, OpenAPI.Components.Schemas.Count);
|
||||
AssertSimpleComponent('simple');
|
||||
AssertListComponent('simple');
|
||||
AssertTrue('PathItems',OpenAPI.HasKeyWord(oakPaths));
|
||||
AssertEquals('Path Count',1, OpenAPI.Paths.Count);
|
||||
AssertListOperation('simple');
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.TestResourceReadOnlyWithID;
|
||||
var
|
||||
R : TSQLDBRestResource;
|
||||
|
||||
begin
|
||||
R:=CreateResource(True,rftUnknown);
|
||||
R.AllowedOperations:=[roGet];
|
||||
Convert;
|
||||
AssertTrue('Components',OpenAPI.HasKeyWord(oakComponents));
|
||||
AssertTrue('Component schemas',OpenAPI.Components.HasKeyWord(ckSchemas));
|
||||
AssertEquals('Component Count',2, OpenAPI.Components.Schemas.Count);
|
||||
AssertSimpleComponent('simple');
|
||||
AssertListComponent('simple');
|
||||
AssertTrue('PathItems',OpenAPI.HasKeyWord(oakPaths));
|
||||
AssertEquals('Path Count',2, OpenAPI.Paths.Count);
|
||||
AssertListOperation('simple');
|
||||
AssertGetOperation('simple');
|
||||
end;
|
||||
|
||||
procedure TTestSQLDBRestOpenAPI.TestResourcePostOnly;
|
||||
var
|
||||
R : TSQLDBRestResource;
|
||||
|
||||
begin
|
||||
R:=CreateResource(True,rftUnknown);
|
||||
R.AllowedOperations:=[roPost];
|
||||
Convert;
|
||||
AssertTrue('Components',OpenAPI.HasKeyWord(oakComponents));
|
||||
AssertTrue('Component schemas',OpenAPI.Components.HasKeyWord(ckSchemas));
|
||||
AssertEquals('Component Count',1, OpenAPI.Components.Schemas.Count);
|
||||
AssertSimpleComponent('simple');
|
||||
// AssertListComponent('simple');
|
||||
AssertTrue('PathItems',OpenAPI.HasKeyWord(oakPaths));
|
||||
AssertEquals('Path Count',1, OpenAPI.Paths.Count);
|
||||
AssertPostOperation('simple');
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterTest(TTestSQLDBRestOpenAPI);
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user