* OpenAPI support for SQLDBRest

This commit is contained in:
Michaël Van Canneyt 2024-11-18 23:00:37 +01:00
parent 3855187038
commit 2301f09d77
6 changed files with 674 additions and 5 deletions

View File

@ -46,6 +46,7 @@
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>

View File

@ -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';

View File

@ -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(

View File

@ -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 }

View 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.

View 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.