Merge branch 'develop'

Author: Cesar4D

ClientWeb/ClientWeb.dpr

@@ -7,7 +7,8 @@ uses
   WEBLib.Forms,
   Main.View in 'Src\Main.View.pas' {MainView: TWebForm} {*.html},
   Login.View in 'Src\Login.View.pas' {LoginView: TWebForm} {*.html},
-  Clientes.Cadastrar.View in 'Src\ClientesCadastrar\Clientes.Cadastrar.View.pas' {ClientesCadastrarView: TWebForm} {*.html};
+  Clientes.Cadastrar.View in 'Src\ClientesCadastrar\Clientes.Cadastrar.View.pas' {ClientesCadastrarView: TWebForm} {*.html},
+  Configs in 'Src\Configs.pas';
 
 {$R *.res}
 

ClientWeb/ClientWeb.dproj

@@ -123,6 +123,7 @@
             <FormType>dfm</FormType>
             <DesignClass>TWebForm</DesignClass>
         </DCCReference>
+        <DCCReference Include="Src\Configs.pas"/>
         <None Include="Index.html"/>
         <None Include="Index.css"/>
         <None Include="AdminLTE\dist\css\adminlte.css"/>

ClientWeb/Src/Configs.pas

@@ -0,0 +1,10 @@
+unit Configs;
+
+interface
+
+var
+  Configs_Token: string;
+
+implementation
+
+end.

ClientWeb/Src/Login.View.dfm

@@ -61,4 +61,16 @@ object LoginView: TLoginView
     HeightPercent = 100.000000000000000000
     WidthPercent = 100.000000000000000000
   end
+  object XDataWebConnection1: TXDataWebConnection
+    URL = 'http://localhost:2001/tms/auth/'
+    Connected = True
+    Left = 72
+    Top = 16
+  end
+  object XDataWebClient1: TXDataWebClient
+    Connection = XDataWebConnection1
+    OnError = XDataWebClient1Error
+    Left = 216
+    Top = 16
+  end
 end

ClientWeb/Src/Login.View.pas

@@ -5,16 +5,14 @@ interface
 uses
   System.SysUtils,
   System.Classes,
-  JS,
   Web,
   WEBLib.Graphics,
   WEBLib.Controls,
   WEBLib.Forms,
   WEBLib.Dialogs,
   Vcl.Controls,
   Vcl.StdCtrls,
-  WEBLib.StdCtrls,
-  Main.View;
+  WEBLib.StdCtrls, Main.View, XData.Web.Client, XData.Web.Connection, JS, Configs;
 
 type
   TLoginView = class(TWebForm)
@@ -23,11 +21,16 @@   TLoginView = class(TWebForm)
     edtSenha: TWebEdit;
     btnEntrar: TWebButton;
     ckLembrarMe: TWebCheckBox;
+    [Async]
+    XDataWebConnection1: TXDataWebConnection;
+    XDataWebClient1: TXDataWebClient;
+    [Async]
     procedure btnEntrarClick(Sender: TObject);
     procedure WebFormShow(Sender: TObject);
     procedure edtLoginKeyPress(Sender: TObject; var Key: Char);
     procedure edtSenhaKeyPress(Sender: TObject; var Key: Char);
     procedure WebFormCreate(Sender: TObject);
+    procedure XDataWebClient1Error(Error: TXDataClientError);
   private
 
   public
@@ -52,6 +55,16 @@ procedure TLoginView.WebFormShow(Sender: TObject);
   edtLogin.SetFocus;
 end;
 
+procedure TLoginView.XDataWebClient1Error(Error: TXDataClientError);
+begin
+  ShowMessage(
+    'StatusCode: ' + Error.StatusCode.ToString + sLineBreak +
+    'RequestUrl: ' + Error.RequestUrl + sLineBreak +
+    'RequestId: ' + Error.RequestId + sLineBreak +
+    'ErrorCode: ' + Error.ErrorCode + sLineBreak +
+    'ErrorMessage: ' + Error.ErrorMessage);
+end;
+
 procedure TLoginView.edtLoginKeyPress(Sender: TObject; var Key: Char);
 begin
   if Key = #13 then
@@ -65,21 +78,36 @@ procedure TLoginView.edtSenhaKeyPress(Sender: TObject; var Key: Char);
 end;
 
 procedure TLoginView.btnEntrarClick(Sender: TObject);
+var
+  LResponse: TXDataClientResponse;
 begin
-  if edtLogin.Text <> 'admin' then
+  if Trim(edtLogin.Text).IsEmpty or Trim(edtSenha.Text).IsEmpty then
   begin
-    ShowMessage('Login inválido');
+    ShowMessage('Login e senha devem ser informados');
     edtLogin.SetFocus;
     Exit;
   end;
 
-  if edtSenha.Text <> 'admin' then
+  LResponse := TAwait.Exec<TXDataClientResponse>(
+    XDataWebClient1.RawInvokeAsync('ILoginService.Login', [edtLogin.Text, edtSenha.Text]));
+
+  if LResponse.StatusCode <>  200 then
   begin
-    ShowMessage('Senha inválido');
-    edtSenha.SetFocus;
+    ShowMessage('Login ou senha informados são inválidos');
+    edtLogin.SetFocus;
     Exit;
   end;
 
+  Configs_Token := string(TJSObject(LResponse.Result)['value']);
+  if Configs_Token.Trim.IsEmpty then
+  begin
+    ShowMessage('Token não pode ser recuperado');
+    edtLogin.SetFocus;
+    Exit;
+  end;
+
+  ShowMessage('Token: ' + Configs_Token);
+
   MainView := TMainView.CreateNew;
   MainView.ShowModal;
 end;

ClientWeb/Src/Main.View.dfm

@@ -916,6 +916,8 @@ object MainView: TMainView
   end
   object XDataWebConnection1: TXDataWebConnection
     URL = 'http://localhost:8000/tms/xdata'
+    OnError = XDataWebConnection1Error
+    OnRequest = XDataWebConnection1Request
     Left = 96
     Top = 16
   end

ClientWeb/Src/Main.View.pas

@@ -21,10 +21,22 @@ interface
   XData.Web.Connection,
   WEBLib.DB,
   JS,
-  Clientes.Cadastrar.View, VCL.TMSFNCTypes, VCL.TMSFNCUtils, VCL.TMSFNCGraphics, VCL.TMSFNCGraphicsTypes, System.Rtti,
-  VCL.TMSFNCDataGridCell, VCL.TMSFNCDataGridData, VCL.TMSFNCDataGridBase, VCL.TMSFNCDataGridCore,
-  VCL.TMSFNCDataGridRenderer, VCL.TMSFNCCustomControl, VCL.TMSFNCDataGrid, VCL.TMSFNCCustomComponent,
-  VCL.TMSFNCDataGridDatabaseAdapter;
+  Clientes.Cadastrar.View,
+  VCL.TMSFNCTypes,
+  VCL.TMSFNCUtils,
+  VCL.TMSFNCGraphics,
+  VCL.TMSFNCGraphicsTypes,
+  System.Rtti,
+  VCL.TMSFNCDataGridCell,
+  VCL.TMSFNCDataGridData,
+  VCL.TMSFNCDataGridBase,
+  VCL.TMSFNCDataGridCore,
+  VCL.TMSFNCDataGridRenderer,
+  VCL.TMSFNCCustomControl,
+  VCL.TMSFNCDataGrid,
+  VCL.TMSFNCCustomComponent,
+  VCL.TMSFNCDataGridDatabaseAdapter,
+  Configs;
 
 type
   TMainView = class(TWebForm)
@@ -73,6 +85,8 @@   TMainView = class(TWebForm)
     [Async]
     procedure btnDeleteClick(Sender: TObject);
     procedure XDataWebClient1Error(Error: TXDataClientError);
+    procedure XDataWebConnection1Error(Error: TXDataWebConnectionError);
+    procedure XDataWebConnection1Request(Args: TXDataWebConnectionRequest);
   private
     function GetClientePreenchido(const AView: TClientesCadastrarView): TJSObject;
   public
@@ -131,6 +145,16 @@ procedure TMainView.XDataWebClient1Error(Error: TXDataClientError);
     'ErrorMessage: ' + Error.ErrorMessage);
 end;
 
+procedure TMainView.XDataWebConnection1Error(Error: TXDataWebConnectionError);
+begin
+  ShowMessage('StatusCode: ' + Error.ErrorMessage);
+end;
+
+procedure TMainView.XDataWebConnection1Request(Args: TXDataWebConnectionRequest);
+begin
+  Args.Request.Headers.SetValue('Authorization', 'Bearer ' + Configs_Token);
+end;
+
 procedure TMainView.btnGetNomeClick(Sender: TObject);
 var
   LResponse: TXDataClientResponse;
@@ -142,6 +166,9 @@ procedure TMainView.btnGetNomeClick(Sender: TObject);
     Exit;
   end;
 
+  if not XDataWebConnection1.Connected then
+    XDataWebConnection1.Open;
+
   LResponse := TAwait.Exec<TXDataClientResponse>(
     XDataWebClient1.RawInvokeAsync('IClientesService.GetNome', [StrToIntDef(edtCodigo.Text, 0)]));
 
@@ -159,6 +186,9 @@ procedure TMainView.btnGetClick(Sender: TObject);
     Exit;
   end;
 
+  if not XDataWebConnection1.Connected then
+    XDataWebConnection1.Open;
+
   LResponse := TAwait.Exec<TXDataClientResponse>(
     XDataWebClient1.RawInvokeAsync('IClientesService.Get', [StrToIntDef(edtCodigo.Text, 0)]));
 
@@ -180,6 +210,9 @@ procedure TMainView.btnListarClick(Sender: TObject);
 var
   LResponse: TXDataClientResponse;
 begin
+  if not XDataWebConnection1.Connected then
+    XDataWebConnection1.Open;
+
   LResponse := TAwait.Exec<TXDataClientResponse>(
     XDataWebClient1.RawInvokeAsync('IClientesService.List', []));
 
@@ -200,6 +233,9 @@ procedure TMainView.btnDeleteClick(Sender: TObject);
 var
   LResponse: TXDataClientResponse;
 begin
+  if not XDataWebConnection1.Connected then
+    XDataWebConnection1.Open;
+
   if await(TModalResult, MessageDlgAsync('Confirma realmente deletar o registro?', mtConfirmation, [mbYes, mbNo])) <> mrYes then
     Exit;
 

Server/Src/XData.DM.dfm

@@ -13,6 +13,11 @@ object XDataDM: TXDataDM
     end
     object XDataServer1Compress: TSparkleCompressMiddleware
     end
+    object XDataServer1JWT: TSparkleJwtMiddleware
+      ForbidAnonymousAccess = True
+      OnGetSecretEx = XDataServer1JWTGetSecretEx
+      OnForbidRequest = XDataServer1JWTForbidRequest
+    end
   end
   object SparkleHttpSysDispatcher1: TSparkleHttpSysDispatcher
     Left = 128

Server/Src/XData.DM.pas

@@ -10,14 +10,20 @@ interface
   XData.Server.Module,
   Sparkle.Comp.Server,
   Sparkle.Comp.HttpSysDispatcher,
-  XData.Comp.Server, Sparkle.Comp.CompressMiddleware, Sparkle.Comp.CorsMiddleware;
+  XData.Comp.Server,
+  Sparkle.Comp.CompressMiddleware,
+  Sparkle.Comp.CorsMiddleware, Sparkle.Comp.JwtMiddleware;
 
 type
   TXDataDM = class(TDataModule)
     XDataServer1: TXDataServer;
     SparkleHttpSysDispatcher1: TSparkleHttpSysDispatcher;
     XDataServer1CORS: TSparkleCorsMiddleware;
     XDataServer1Compress: TSparkleCompressMiddleware;
+    XDataServer1JWT: TSparkleJwtMiddleware;
+    procedure XDataServer1JWTGetSecretEx(Sender: TObject; const JWT: TJWT; Context: THttpServerContext;
+      var Secret: TBytes);
+    procedure XDataServer1JWTForbidRequest(Sender: TObject; Context: THttpServerContext; var Forbid: Boolean);
   private
 
   public
@@ -33,4 +39,16 @@ implementation
 
 {$R *.dfm}
 
+procedure TXDataDM.XDataServer1JWTForbidRequest(Sender: TObject; Context: THttpServerContext; var Forbid: Boolean);
+begin
+  if Context.Request.Uri.AbsolutePath.Contains('swagger') then
+    Forbid := False;
+end;
+
+procedure TXDataDM.XDataServer1JWTGetSecretEx(Sender: TObject; const JWT: TJWT; Context: THttpServerContext;
+  var Secret: TBytes);
+begin
+  Secret := TEncoding.UTF8.GetBytes('sua-chave-secreta-1234567890-12345');
+end;
+
 end.

ServerAuth/Src/LoginService/LoginServiceImplementation.pas

@@ -40,7 +40,7 @@ function TLoginService.Login(const User, Password: string): string;
     JWT.Claims.SetClaimOfType<Boolean>('admin', True);
     JWT.Claims.SetClaimOfType<string>('teste', 'asdf');
 
-    Result := TJOSE.SHA256CompactToken('sua-chave-secreta', JWT);
+    Result := TJOSE.SHA256CompactToken('sua-chave-secreta-1234567890-12345', JWT);
   finally
     JWT.Free;
   end;

ServerAuth/Src/ServerAuth.Main.View.dfm

@@ -2,14 +2,15 @@ object ServerAuthMainView: TServerAuthMainView
   Left = 0
   Top = 0
   Caption = 'ServerAuthMainView'
-  ClientHeight = 304
-  ClientWidth = 577
+  ClientHeight = 343
+  ClientWidth = 545
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -12
   Font.Name = 'Segoe UI'
   Font.Style = []
+  Position = poScreenCenter
   OnCreate = FormCreate
   TextHeight = 15
   object btnStart: TButton
@@ -34,16 +35,17 @@ object ServerAuthMainView: TServerAuthMainView
     Left = 24
     Top = 64
     Width = 505
-    Height = 185
+    Height = 257
     ScrollBars = ssVertical
     TabOrder = 2
   end
   object btnSwaggerDocumentacao: TButton
-    Left = 278
+    Left = 336
     Top = 16
     Width = 193
     Height = 25
     Caption = 'Abrir documenta'#231#227'o Swagger'
     TabOrder = 3
+    OnClick = btnSwaggerDocumentacaoClick
   end
 end

ServerAuth/Src/ServerAuth.Main.View.pas

@@ -3,8 +3,17 @@
 interface
 
 uses
-  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
-  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
+  Winapi.Windows,
+  Winapi.Messages,
+  System.SysUtils,
+  System.Variants,
+  System.Classes,
+  ShellAPI,
+  Vcl.Graphics,
+  Vcl.Controls,
+  Vcl.Forms,
+  Vcl.Dialogs,
+  Vcl.StdCtrls,
   ServerAuth.XData.DM;
 
 type
@@ -16,13 +25,11 @@   TServerAuthMainView = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure btnStartClick(Sender: TObject);
     procedure btnStopClick(Sender: TObject);
+    procedure btnSwaggerDocumentacaoClick(Sender: TObject);
   private
     procedure AtualizarTela;
-    procedure btnSwaggerDocumentacaoClick(Sender: TObject);
     function GetServerBaseUrl: string;
-    { Private declarations }
   public
-    { Public declarations }
   end;
 
 var
@@ -75,8 +82,7 @@ procedure TServerAuthMainView.btnStopClick(Sender: TObject);
 
 procedure TServerAuthMainView.btnSwaggerDocumentacaoClick(Sender: TObject);
 begin
-  //ShellExecute(Handle, 'open', PChar(Self.GetServerBaseUrl + '/swaggerui'), nil, nil, SW_SHOWNORMAL);
+  ShellExecute(Handle, 'open', PChar(Self.GetServerBaseUrl + '/swaggerui'), nil, nil, SW_SHOWNORMAL);
 end;
 
-
 end.