From 54bfe717222f03a2f59cae4635f65c0279617a46 Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Sun, 25 Dec 2022 19:46:07 +0100 Subject: [PATCH] https://github.com/danieleteti/delphimvcframework/issues/577 --- .../SwaggerPrimer.dpr | 48 +-- .../SwaggerPrimer.dproj | 359 ++---------------- .../WebModuleU.pas | 2 +- sources/MVCFramework.Commons.pas | 2 + sources/MVCFramework.Middleware.Swagger.pas | 34 +- 5 files changed, 73 insertions(+), 372 deletions(-) diff --git a/samples/swagger_api_versioning_primer/SwaggerPrimer.dpr b/samples/swagger_api_versioning_primer/SwaggerPrimer.dpr index 4e5460f5..35960296 100644 --- a/samples/swagger_api_versioning_primer/SwaggerPrimer.dpr +++ b/samples/swagger_api_versioning_primer/SwaggerPrimer.dpr @@ -8,9 +8,10 @@ uses WinAPI.Windows, {$ENDIF} System.SysUtils, + MVCFramework, MVCFramework.Logger, MVCFramework.Commons, - MVCFramework.REPLCommandsHandlerU, + MVCFramework.Signal, Web.ReqMulti, Web.WebReq, Web.WebBroker, @@ -25,56 +26,19 @@ uses procedure RunServer(APort: Integer); var LServer: TIdHTTPWebBrokerBridge; - LCustomHandler: TMVCCustomREPLCommandsHandler; - LCmd: string; begin Writeln('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION); - LCmd := 'start'; - if ParamCount >= 1 then - LCmd := ParamStr(1); - - LCustomHandler := - function(const Value: String; const Server: TIdHTTPWebBrokerBridge; out Handled: Boolean) - : THandleCommandResult - begin - Handled := False; - Result := THandleCommandResult.Unknown; - end; - LServer := TIdHTTPWebBrokerBridge.Create(nil); try LServer.OnParseAuthentication := TMVCParseAuthentication.OnParseAuthentication; LServer.DefaultPort := APort; LServer.MaxConnections := 0; LServer.ListenQueue := 200; + LServer.Active := True; - Writeln('Write "quit" or "exit" to shutdown the server'); - repeat - if LCmd.IsEmpty then - begin - Write('-> '); - ReadLn(LCmd) - end; - try - case HandleCommand(LCmd.ToLower, LServer, LCustomHandler) of - THandleCommandResult.Continue: - begin - Continue; - end; - THandleCommandResult.Break: - begin - Break; - end; - THandleCommandResult.Unknown: - begin - REPLEmit('Unknown command: ' + LCmd); - end; - end; - finally - LCmd := ''; - end; - until False; - + Writeln('CTRL+C to shutdown the server'); + WaitForTerminationSignal; + EnterInShutdownState; finally LServer.Free; end; diff --git a/samples/swagger_api_versioning_primer/SwaggerPrimer.dproj b/samples/swagger_api_versioning_primer/SwaggerPrimer.dproj index 80b6d7cd..4ea3e9f3 100644 --- a/samples/swagger_api_versioning_primer/SwaggerPrimer.dproj +++ b/samples/swagger_api_versioning_primer/SwaggerPrimer.dproj @@ -1,7 +1,7 @@  {53EA2B08-DB19-4D58-86AE-E3B7DB674D33} - 19.4 + 19.5 VCL SwaggerPrimer.dpr True @@ -155,28 +155,11 @@ Microsoft Office XP Sample Automation Server Wrapper Components - - - - true - - - - - true - - - - - true - - - - - SwaggerPrimer.exe - true - - + + + + + 1 @@ -195,16 +178,6 @@ 64 - - - classes - 1 - - - classes - 1 - - res\xml @@ -528,7 +501,7 @@ 1 .dylib - + 1 .dylib @@ -562,7 +535,7 @@ 0 - + 0 @@ -583,13 +556,17 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -599,137 +576,27 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 @@ -739,7 +606,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -749,7 +616,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -759,7 +626,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -769,7 +636,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -779,191 +646,37 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 @@ -973,7 +686,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1 @@ -983,7 +696,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -993,7 +706,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1003,7 +716,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1013,7 +726,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1023,7 +736,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1033,7 +746,7 @@ ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 - + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1 @@ -1055,8 +768,11 @@ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + - @@ -1067,7 +783,7 @@ 1 - + 1 @@ -1103,7 +819,7 @@ 1 - + 1 @@ -1160,6 +876,7 @@ + diff --git a/samples/swagger_api_versioning_primer/WebModuleU.pas b/samples/swagger_api_versioning_primer/WebModuleU.pas index 3153d7bf..7e3c792e 100644 --- a/samples/swagger_api_versioning_primer/WebModuleU.pas +++ b/samples/swagger_api_versioning_primer/WebModuleU.pas @@ -90,7 +90,7 @@ begin FMVC.AddMiddleware(TMVCSwaggerMiddleware.Create(FMVC, GetSwagInfoV1, '/api/swagger-v1.json', 'Method for authentication using JSON Web Token (JWT)', False, '','','/api/v1')); FMVC.AddMiddleware(TMVCSwaggerMiddleware.Create(FMVC, GetSwagInfoV2, '/api/swagger-v2.json', - 'Method for authentication using JSON Web Token (JWT)', False, '','','/api/v2')); + 'Method for authentication using JSON Web Token (JWT)', False, '','','/api/v2', [psHTTP, psHTTPS])); end; procedure TMyWebModule.WebModuleDestroy(Sender: TObject); diff --git a/sources/MVCFramework.Commons.pas b/sources/MVCFramework.Commons.pas index 626def2c..113a73f1 100644 --- a/sources/MVCFramework.Commons.pas +++ b/sources/MVCFramework.Commons.pas @@ -53,6 +53,8 @@ type TMVCHTTPMethods = set of TMVCHTTPMethodType; + TMVCTransferProtocolSchemes = set of (psHTTP, psHTTPS); + TMVCMediaType = record public const APPLICATION_ATOM_XML = 'application/atom+xml'; diff --git a/sources/MVCFramework.Middleware.Swagger.pas b/sources/MVCFramework.Middleware.Swagger.pas index 095a5077..0eb1ec17 100644 --- a/sources/MVCFramework.Middleware.Swagger.pas +++ b/sources/MVCFramework.Middleware.Swagger.pas @@ -38,7 +38,7 @@ uses MVCFramework.Swagger.Commons, Swag.Doc.SecurityDefinition, Swag.Common.Types, - System.JSON; + System.JSON, MVCFramework.Commons; type TMVCSwaggerMiddleware = class(TInterfacedObject, IMVCMiddleware) @@ -51,6 +51,7 @@ type fHost: string; fBasePath: string; fPathFilter: string; + fTransferProtocolSchemes: TMVCTransferProtocolSchemes; procedure DocumentApiInfo(const ASwagDoc: TSwagDoc); procedure DocumentApiSettings(AContext: TWebContext; ASwagDoc: TSwagDoc); procedure DocumentApiAuthentication(const ASwagDoc: TSwagDoc); @@ -58,11 +59,16 @@ type procedure SortApiPaths(ASwagDoc: TSwagDoc); procedure InternalRender(AContent: string; AContext: TWebContext); public - constructor Create(const AEngine: TMVCEngine; const ASwaggerInfo: TMVCSwaggerInfo; - const ASwaggerDocumentationURL: string = '/swagger.json'; const AJWTDescription: string = JWT_DEFAULT_DESCRIPTION; + constructor Create( + const AEngine: TMVCEngine; + const ASwaggerInfo: TMVCSwaggerInfo; + const ASwaggerDocumentationURL: string = '/swagger.json'; + const AJWTDescription: string = JWT_DEFAULT_DESCRIPTION; const AEnableBasicAuthentication: Boolean = False; - const AHost: string = ''; const ABasePath: string = ''; - const APathFilter: String = ''); + const AHost: string = ''; + const ABasePath: string = ''; + const APathFilter: String = ''; + const ATransferProtocolSchemes: TMVCTransferProtocolSchemes = [psHTTP, psHTTPS]); destructor Destroy; override; procedure OnBeforeRouting(AContext: TWebContext; var AHandled: Boolean); procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string; @@ -77,7 +83,6 @@ implementation uses System.SysUtils, - MVCFramework.Commons, System.Classes, JsonDataObjects, System.Rtti, @@ -99,7 +104,8 @@ uses constructor TMVCSwaggerMiddleware.Create(const AEngine: TMVCEngine; const ASwaggerInfo: TMVCSwaggerInfo; const ASwaggerDocumentationURL, AJWTDescription: string; const AEnableBasicAuthentication: Boolean; const AHost, ABasePath: string; - const APathFilter: String); + const APathFilter: String; + const ATransferProtocolSchemes: TMVCTransferProtocolSchemes); begin inherited Create; fSwagDocURL := ASwaggerDocumentationURL; @@ -110,6 +116,7 @@ begin fHost := AHost; fBasePath := ABasePath; fPathFilter := APathFilter; + fTransferProtocolSchemes := ATransferProtocolSchemes; end; destructor TMVCSwaggerMiddleware.Destroy; @@ -370,6 +377,8 @@ begin end; procedure TMVCSwaggerMiddleware.DocumentApiSettings(AContext: TWebContext; ASwagDoc: TSwagDoc); +var + lSwagSchemes: TSwagTransferProtocolSchemes; begin ASwagDoc.Host := fHost; if ASwagDoc.Host.IsEmpty then @@ -387,7 +396,16 @@ begin ASwagDoc.BasePath := '/'; end; - ASwagDoc.Schemes := [tpsHttp, tpsHttps]; + lSwagSchemes := []; + if psHTTP in fTransferProtocolSchemes then + begin + Include(lSwagSchemes, tpsHttp); + end; + if psHTTPS in fTransferProtocolSchemes then + begin + Include(lSwagSchemes, tpsHttps); + end; + ASwagDoc.Schemes := lSwagSchemes; end; procedure TMVCSwaggerMiddleware.InternalRender(AContent: string; AContext: TWebContext);