From 2301f09d7749d3de96f2b13c9f5c919d920c0213 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Mon, 18 Nov 2024 23:00:37 +0100 Subject: [PATCH] * OpenAPI support for SQLDBRest --- .../examples/restbridge/demorestbridge.lpi | 1 + .../examples/restbridge/demorestbridge.pp | 4 +- .../fcl-web/src/restbridge/sqldbrestbridge.pp | 38 +- .../fcl-web/src/restbridge/sqldbrestio.pp | 7 +- .../src/restbridge/sqldbrestopenapi.pas | 345 ++++++++++++++++++ packages/fcl-web/tests/testsqldbopenapi.pas | 284 ++++++++++++++ 6 files changed, 674 insertions(+), 5 deletions(-) create mode 100644 packages/fcl-web/src/restbridge/sqldbrestopenapi.pas create mode 100644 packages/fcl-web/tests/testsqldbopenapi.pas diff --git a/packages/fcl-web/examples/restbridge/demorestbridge.lpi b/packages/fcl-web/examples/restbridge/demorestbridge.lpi index 8f4ba196c5..f7cc935b7f 100644 --- a/packages/fcl-web/examples/restbridge/demorestbridge.lpi +++ b/packages/fcl-web/examples/restbridge/demorestbridge.lpi @@ -46,6 +46,7 @@ + diff --git a/packages/fcl-web/examples/restbridge/demorestbridge.pp b/packages/fcl-web/examples/restbridge/demorestbridge.pp index 911e1ed451..ab05c4bfa5 100644 --- a/packages/fcl-web/examples/restbridge/demorestbridge.pp +++ b/packages/fcl-web/examples/restbridge/demorestbridge.pp @@ -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'; diff --git a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp index 59c61ab100..117a4ac9d5 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp @@ -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( diff --git a/packages/fcl-web/src/restbridge/sqldbrestio.pp b/packages/fcl-web/src/restbridge/sqldbrestio.pp index ee1983a8ba..2001a30f4b 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestio.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestio.pp @@ -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 } diff --git a/packages/fcl-web/src/restbridge/sqldbrestopenapi.pas b/packages/fcl-web/src/restbridge/sqldbrestopenapi.pas new file mode 100644 index 0000000000..2ac66cb396 --- /dev/null +++ b/packages/fcl-web/src/restbridge/sqldbrestopenapi.pas @@ -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 (I0 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. + diff --git a/packages/fcl-web/tests/testsqldbopenapi.pas b/packages/fcl-web/tests/testsqldbopenapi.pas new file mode 100644 index 0000000000..f50d78cc91 --- /dev/null +++ b/packages/fcl-web/tests/testsqldbopenapi.pas @@ -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. +