Code improvements

HashLoad · Dec 28, 2023 · 0ca93dd · 0ca93dd
1 parent 2beabec
commit 0ca93dd
Show file tree

Hide file tree

Showing 6 changed files with 115 additions and 41 deletions.
diff --git a/boss-lock.json b/boss-lock.json
@@ -1,19 +1,19 @@
 {
 	"hash": "830981b993a8554a72d15f4378c1a4cc",
-	"updated": "2023-03-09T23:16:37.9915349-03:00",
+	"updated": "2023-12-28T09:51:18.5301133-03:00",
 	"installedModules": {
 		"github.com/hashload/horse": {
 			"name": "horse",
-			"version": "3.1.0",
-			"hash": "fc3b8eefb46c1a3b387e86ca46a9faa1",
+			"version": "3.1.5",
+			"hash": "3824f65f99e511ba73d3fdd2f6d16413",
 			"artifacts": {},
 			"failed": false,
 			"changed": false
 		},
 		"github.com/hashload/jhonson": {
 			"name": "jhonson",
-			"version": "1.1.5",
-			"hash": "b4efa1372fdf1109fbaf5a625b702f90",
+			"version": "1.1.8",
+			"hash": "62d5763101381ad8aeec10773544b1dc",
 			"artifacts": {},
 			"failed": false,
 			"changed": false

diff --git a/boss.json b/boss.json
@@ -6,7 +6,7 @@
 	"mainsrc": "src/",
 	"projects": [],
 	"dependencies": {
-		"github.com/hashload/horse": "^3.1.0",
-		"github.com/hashload/jhonson": "^1.1.5"
+		"github.com/hashload/horse": "^3.1.4",
+		"github.com/hashload/jhonson": "^1.1.8"
 	}
 }
diff --git a/samples/delphi/samples.dpr b/samples/delphi/samples.dpr
@@ -3,18 +3,56 @@ program samples;
 {$APPTYPE CONSOLE}
 {$R *.res}
 
-uses Horse, Horse.Jhonson, Horse.HandleException, System.SysUtils;
+uses Horse, Horse.Jhonson, Horse.HandleException, System.SysUtils, System.JSON;
 
 begin
+  {$region 'Example 01: Handle-exception is responsible for notifying the client (Default)'}
   THorse
     .Use(Jhonson)
     .Use(HandleException);
+  {$endregion}
+
+  {$region 'Example 02: Handle-exception is responsible for notifying the client using the TInterceptExceptionCallback Callback'}
+//  THorse
+//    .Use(Jhonson)
+//    .Use(HandleException(
+//      procedure(const E: Exception; const Req: THorseRequest; const Res: THorseResponse; var ASendException: Boolean)
+//      var
+//        LGUID: TGUID;
+//        LMessage: string;
+//      begin
+//        CreateGUID(LGUID);
+//        LMessage := Format('ID: %s - Message: %s', [GUIDToString(LGUID), E.Message]);
+//        Writeln(LMessage);
+//      end));
+  {$endregion}
+
+  {$region 'Example 03: Developer is responsible for notifying the client using the TInterceptExceptionCallback Callback'}
+//  THorse
+//    .Use(Jhonson)
+//    .Use(HandleException(
+//      procedure(const E: Exception; const Req: THorseRequest; const Res: THorseResponse; var ASendException: Boolean)
+//      var
+//        LGUID: TGUID;
+//        LMessage: string;
+//      begin
+//        ASendException := False;
+//        CreateGUID(LGUID);
+//        LMessage := Format('ID: %s - Message: %s', [GUIDToString(LGUID), E.Message]);
+//        Writeln(LMessage);
+//        Res.Send<TJSONObject>(TJSONObject.Create.AddPair('myCustomError', E.Message)).Status(THTTPStatus.InternalServerError);
+//      end));
+  {$endregion}
 
   THorse.Get('/ping',
     procedure(Req: THorseRequest; Res: THorseResponse)
     begin
       raise EHorseException.New.Error('My Error!');
     end);
 
-  THorse.Listen(9000);
+  THorse.Listen(9000,
+    procedure
+    begin
+      Writeln('Server is running on port ' + THorse.Port.ToString);
+    end);
 end.
diff --git a/samples/lazarus/Console.lpi b/samples/lazarus/Console.lpi
@@ -1,16 +1,16 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="Console"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
@@ -24,7 +24,6 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="0"/>
     </RunParams>
     <Units Count="1">
       <Unit0>
@@ -44,6 +43,11 @@
       <OtherUnitFiles Value="..\..\src;..\..\modules\horse\src;..\..\modules\jhonson\src"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+      </Debugging>
+    </Linking>
     <Other>
       <CustomOptions Value="-dUseCThreads"/>
     </Other>

diff --git a/samples/lazarus/Console.lpr b/samples/lazarus/Console.lpr
@@ -6,6 +6,7 @@
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   {$ENDIF}{$ENDIF}
+  fpjson,
   Horse,
   Horse.Jhonson,
   Horse.HandleException,
@@ -16,10 +17,49 @@ procedure GetPing(Req: THorseRequest; Res: THorseResponse; Next: TNextProc);
   raise EHorseException.New.Error('My Error!');
 end;
 
+//procedure Example02(const E: Exception; const Req: THorseRequest; const Res: THorseResponse; var ASendException: Boolean);
+//var
+//  LGUID: TGUID;
+//  LMessage: string;
+//begin
+//  CreateGUID(LGUID);
+//  LMessage := Format('ID: %s - Message: %s', [GUIDToString(LGUID), E.Message]);
+//  Writeln(LMessage);
+//end;
+
+//procedure Example03(const E: Exception; const Req: THorseRequest; const Res: THorseResponse; var ASendException: Boolean);
+//var
+//  LGUID: TGUID;
+//  LMessage: string;
+//  LJSON: TJSONObject;
+//begin
+//  ASendException := False;
+//  CreateGUID(LGUID);
+//  LMessage := Format('ID: %s - Message: %s', [GUIDToString(LGUID), E.Message]);
+//  Writeln(LMessage);
+//  LJSON := TJSONObject.Create;
+//  LJSON.Add('myCustomError', E.Message);
+//  Res.Send<TJSONObject>(LJSON).Status(THTTPStatus.InternalServerError);
+//end;
+
 begin
+  {$region 'Example 01: Handle-exception is responsible for notifying the client (Default)'}
   THorse
     .Use(Jhonson)
     .Use(HandleException);
+  {$endregion}
+
+  {$region 'Example 02: Handle-exception is responsible for notifying the client using the TInterceptExceptionCallback Callback'}
+  //THorse
+  //  .Use(Jhonson)
+  //  .Use(HandleException(Example02));
+  {$endregion}
+
+  {$region 'Example 03: Developer is responsible for notifying the client using the TInterceptExceptionCallback Callback'}
+  //THorse
+  //  .Use(Jhonson)
+  //  .Use(HandleException(Example03));
+  {$endregion}
 
   THorse.Get('/ping', GetPing);
 

diff --git a/src/Horse.HandleException.pas b/src/Horse.HandleException.pas
@@ -1,41 +1,36 @@
 unit Horse.HandleException;
 
 {$IF DEFINED(FPC)}
-{$MODE DELPHI}{$H+}
+  {$MODE DELPHI}{$H+}
 {$ENDIF}
 
 interface
 
 uses
   {$IF DEFINED(FPC)}
-  SysUtils, fpjson,
+  SysUtils,
+  fpjson,
+  TypInfo,
   {$ELSE}
-  System.SysUtils, System.JSON,
+  System.SysUtils,
+  System.JSON,
+  System.TypInfo,
   {$ENDIF}
-  Horse, Horse.Commons;
+  Horse,
+  Horse.Commons;
 
 type
 {$IF DEFINED(FPC)}
-  TInterceptExceptionCallback = {$IF DEFINED(HORSE_FPC_FUNCTIONREFERENCES)}reference to {$ENDIF}procedure(AException: Exception; AResponse: THorseResponse; var ASendException: Boolean);
+  TInterceptExceptionCallback = procedure(const E: Exception; const Req: THorseRequest; const Res: THorseResponse; var ASendException: Boolean);
 {$ELSE}
-  TInterceptExceptionCallback = reference to procedure(AException: Exception; AResponse: THorseResponse; var ASendException: Boolean);
+  TInterceptExceptionCallback = reference to procedure(const E: Exception; const Req: THorseRequest; const Res: THorseResponse; var ASendException: Boolean);
 {$ENDIF}
 
 function HandleException: THorseCallback; overload;
 function HandleException(const ACallback: TInterceptExceptionCallback): THorseCallback; overload;
-procedure Middleware(Req: THorseRequest; Res: THorseResponse; Next: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF});
-
-function FormatExceptionJSON(AException: Exception): TJSONObject;
 
 implementation
 
-uses
-  {$IF DEFINED(FPC)}
-  TypInfo;
-  {$ELSE}
-  System.TypInfo;
-  {$ENDIF}
-
 var
   InterceptExceptionCallback: TInterceptExceptionCallback = nil;
 
@@ -44,27 +39,27 @@ procedure SendException(ARes: THorseResponse; AJson: TJSONObject; const AStatus:
   ARes.Send<TJSONObject>(AJson).Status(AStatus);
 end;
 
-function FormatExceptionJSON(AException: Exception): TJSONObject;
+function FormatExceptionJSON(const E: Exception): TJSONObject;
 var
   LEHorseException: EHorseException;
 begin
-  if (AException is EHorseException) then
+  if (E is EHorseException) then
   begin
-    LEHorseException := (AException as EHorseException);
+    LEHorseException := (E as EHorseException);
     Result := {$IF DEFINED(FPC)}GetJSON(LEHorseException.ToJSON) as TJSONObject{$ELSE}TJSONObject.ParseJSONValue(LEHorseException.ToJSON) as TJSONObject{$ENDIF};
   end
   else
   begin
     Result := TJSONObject.Create;
-    Result.{$IF DEFINED(FPC)}Add{$ELSE}AddPair{$ENDIF}('error', AException.Message);
+    Result.{$IF DEFINED(FPC)}Add{$ELSE}AddPair{$ENDIF}('error', E.Message);
   end;
 end;
 
 procedure Middleware(Req: THorseRequest; Res: THorseResponse; Next: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF});
 var
   LJSON: TJSONObject;
   LStatus: Integer;
-  lSendException: Boolean;
+  LSendException: Boolean;
 begin
   try
     Next();
@@ -74,24 +69,21 @@ procedure Middleware(Req: THorseRequest; Res: THorseResponse; Next: {$IF DEFINED
       if (E is EHorseCallbackInterrupted) then
         raise;
 
-      lSendException := True;
+      LSendException := True;
       if Assigned(InterceptExceptionCallback) then
-        InterceptExceptionCallback(E, Res, lSendException);
+        InterceptExceptionCallback(E, Req, Res, LSendException);
 
-      if not lSendException then
+      if not LSendException then
         Exit;
 
+      LJSON := FormatExceptionJSON(E);
       if (E is EHorseException) then
-      begin
-        LJSON := FormatExceptionJSON(E);
-        SendException(Res, LJSON, Integer(EHorseException(E).Status));
-      end
+        SendException(Res, LJSON, Integer(EHorseException(E).Status))
       else
       begin
         LStatus := Res.Status;
         if (LStatus < Integer(THTTPStatus.BadRequest)) then
           LStatus := Integer(THTTPStatus.InternalServerError);
-        LJSON := FormatExceptionJSON(E);
         SendException(Res, LJSON, LStatus);
       end;
     end;