Fix UTF-8 routing with wide Char and FPC Radix callbacks

doc/routing.md

@@ -23,6 +23,8 @@ THorse.Head  ('/items/:id', ...);
 
 Method-routing is exact: `THorse.Get` only matches `GET` requests to that path. A request with the wrong method on a known path returns `405 Method Not Allowed`. A request with an unknown path returns `404 Not Found`.
 
+When `THorse.CaseSensitive` is `False`, route matching folds ASCII letters only. UTF-8 route text is supported, but non-ASCII case folding is intentionally not implied: `/AÇÃO` and `/ação` should be registered and requested with the same non-ASCII spelling.
+
 ## Path parameters
 
 Use a colon-prefixed segment to capture part of the URL:

doc/routing.pt-BR.md

@@ -23,6 +23,8 @@ THorse.Head  ('/items/:id', ...);
 
 O roteamento por método é exato: `THorse.Get` só atende requisições `GET` para aquele caminho. Uma requisição com método errado em um caminho conhecido retorna `405 Method Not Allowed`. Uma requisição com caminho desconhecido retorna `404 Not Found`.
 
+Quando `THorse.CaseSensitive` é `False`, a comparação ignora maiúsculas e minúsculas apenas para letras ASCII. Rotas UTF-8 são suportadas, mas isso não implica case folding de caracteres não ASCII: `/AÇÃO` e `/ação` devem ser registrados e requisitados com a mesma grafia não ASCII.
+
 ## Parâmetros de caminho
 
 Use um segmento prefixado com dois-pontos para capturar parte da URL:

src/Horse.Core.ByteSpan.pas

@@ -41,7 +41,7 @@ function TByteSpan.ToString(const ABuffer: TBytes): string;
   if IsEmpty or (ABuffer = nil) or (FOffset < 0) or (FOffset + FLength > System.Length(ABuffer)) then
     Result := ''
   else
-    SetString(Result, PChar(@ABuffer[FOffset]), FLength);
+    Result := TEncoding.UTF8.GetString(ABuffer, FOffset, FLength);
 end;
 
 end.

src/Horse.Core.Param.pas

@@ -34,6 +34,7 @@   THorseCoreParam = class
     FFields: TDictionary<string, THorseCoreParamField>;
     FContent: TStrings;
     FRequired: Boolean;
+    FDecodeValues: Boolean;
 
     function GetItem(const AKey: string): string;
     function GetDictionary: THorseList;
@@ -66,7 +67,8 @@   THorseCoreParam = class
     function AddStream(const AKey: string; const AContent: TStream): THorseCoreParam; overload;
     function AddStream(const AKey: string; const AContent: TStream; const AOwnsStream: Boolean): THorseCoreParam; overload;
 
-    constructor Create(const AParams: THorseList);
+    constructor Create(const AParams: THorseList;
+      const ADecodeValues: Boolean = True);
     destructor Destroy; override;
   end;
 
@@ -81,11 +83,13 @@ implementation
   Horse.Utils,
   Horse.Core.Param.Config;
 
-constructor THorseCoreParam.Create(const AParams: THorseList);
+constructor THorseCoreParam.Create(const AParams: THorseList;
+  const ADecodeValues: Boolean);
 begin
   inherited Create;
   FParams := AParams;
   FRequired := False;
+  FDecodeValues := ADecodeValues;
 end;
 
 destructor THorseCoreParam.Destroy;
@@ -146,7 +150,10 @@ function THorseCoreParam.TryGetValue(const AKey: string; var AValue: string): Bo
   Result := FParams.TryGetValue(AKey, LVal);
   if Result then
   begin
-    AValue := DecodeParam(LVal);
+    if FDecodeValues then
+      AValue := DecodeParam(LVal)
+    else
+      AValue := LVal;
     if AValue <> LVal then
       FParams.AddOrSetValue(AKey, AValue);
   end;
@@ -158,7 +165,10 @@ function THorseCoreParam.GetItem(const AKey: string): string;
 begin
   if FParams.TryGetValue(AKey, LVal) then
   begin
-    Result := DecodeParam(LVal);
+    if FDecodeValues then
+      Result := DecodeParam(LVal)
+    else
+      Result := LVal;
     if Result <> LVal then
       FParams.AddOrSetValue(AKey, Result);
   end
@@ -263,7 +273,10 @@ function THorseCoreParam.GetContent: TStrings;
   begin
     FContent := TStringList.Create;
     for LPair in FParams do
-      FContent.Add(LPair.Key + '=' + DecodeParam(LPair.Value));
+      if FDecodeValues then
+        FContent.Add(LPair.Key + '=' + DecodeParam(LPair.Value))
+      else
+        FContent.Add(LPair.Key + '=' + LPair.Value);
   end;
   Result := FContent;
 end;
@@ -273,10 +286,13 @@ function THorseCoreParam.ToArray: TArray<TPair<string, string>>;
   I: Integer;
 begin
   Result := FParams.ToArray;
-  for I := 0 to Length(Result) - 1 do
+  if FDecodeValues then
   begin
-    Result[I].Value := DecodeParam(Result[I].Value);
-    FParams.AddOrSetValue(Result[I].Key, Result[I].Value);
+    for I := 0 to Length(Result) - 1 do
+    begin
+      Result[I].Value := DecodeParam(Result[I].Value);
+      FParams.AddOrSetValue(Result[I].Key, Result[I].Value);
+    end;
   end;
 end;
 

src/Horse.Core.Router.Radix.pas

@@ -38,6 +38,9 @@   TRadixFlow = class
   TRadixNode = class
   public
     Part: string;
+{$IF SizeOf(Char) > 1}
+    PartBytes: TArray<Byte>;
+{$ENDIF}
     IsParam: Boolean;
     ParamName: string;
     IsOptional: Boolean;
@@ -110,12 +113,18 @@ implementation
 
 {$IFDEF FPC}
 function StringToBytes(const AStr: string): TBytes;
+{$IF SizeOf(Char) = 1}
 var
   I: Integer;
+{$ENDIF}
 begin
+{$IF SizeOf(Char) = 1}
   SetLength(Result, Length(AStr));
   for I := 1 to Length(AStr) do
     Result[I - 1] := Byte(AStr[I]);
+{$ELSE}
+  Result := TEncoding.UTF8.GetBytes(AStr);
+{$ENDIF}
 end;
 {$ENDIF}
 
@@ -165,6 +174,12 @@ procedure RadixExecutorDoNext;
   GCurrentNext();
 end;
 
+procedure RadixExecutorDoPreValidation(Req: THorseRequest; Res: THorseResponse;
+  Next: TNextProc);
+begin
+  TRadixExecutor(GCurrentExecutor).DoPreValidation(Req, Res, Next);
+end;
+
 constructor TRadixExecutor.Create(ARouter: THorseRadixRouter; AReq: THorseRequest; ARes: THorseResponse);
 begin
   FRouter := ARouter;
@@ -176,9 +191,13 @@ constructor TRadixExecutor.Create(ARouter: THorseRadixRouter; AReq: THorseReques
 function TRadixExecutor.Run: Boolean;
 var
   LStopwatch: TStopwatch;
+  LPreviousExecutor: Pointer;
+  LPreviousNext: TNextProc;
 begin
   LStopwatch := TStopwatch.StartNew;
   FResponse.Request := FRequest;
+  LPreviousExecutor := GCurrentExecutor;
+  LPreviousNext := GCurrentNext;
   GCurrentExecutor := Self;
   try
     try
@@ -192,9 +211,14 @@ function TRadixExecutor.Run: Boolean;
       end;
     end;
   finally
-    LStopwatch.Stop;
-    THorseCore.ExecuteOnTelemetry(FRequest, FResponse, LStopwatch.Elapsed.TotalMilliseconds);
-    THorse.ExecuteOnResponse(FRequest, FResponse);
+    try
+      LStopwatch.Stop;
+      THorseCore.ExecuteOnTelemetry(FRequest, FResponse, LStopwatch.Elapsed.TotalMilliseconds);
+      THorse.ExecuteOnResponse(FRequest, FResponse);
+    finally
+      GCurrentNext := LPreviousNext;
+      GCurrentExecutor := LPreviousExecutor;
+    end;
   end;
 end;
 
@@ -239,14 +263,15 @@ procedure TRadixExecutor.DoExecuteRoute;
       begin
         LKeys := LParams.Keys.ToArray;
         for I := 0 to Length(LKeys) - 1 do
-          FRequest.Params.Dictionary.AddOrSetValue(LKeys[I], DecodeParam(LParams.Items[LKeys[I]]));
+          FRequest.Params.Dictionary.AddOrSetValue(LKeys[I],
+            FRequest.DecodePathParam(LParams.Items[LKeys[I]]));
       end;
 
       LCallbacksList := TList<THorseCallback>.Create;
       try
         LCallbacksList.AddRange(FRouter.FGlobalMiddlewares);
 
-        LCallbacksList.Add(THorseCallback(DoPreValidation));
+        LCallbacksList.Add(Pointer(@RadixExecutorDoPreValidation));
 
         LCallbacksList.AddRange(LMiddlewares);
 
@@ -387,6 +412,9 @@ constructor TRadixNode.Create(const APart: string);
   LCloseParenthesis: Integer;
 begin
   Part := APart;
+{$IF SizeOf(Char) > 1}
+  PartBytes := TEncoding.UTF8.GetBytes(APart);
+{$ENDIF}
   Children := TObjectList<TRadixNode>.Create(True);
   Callbacks := TDictionary<TMethodType, TArray<THorseCallback>>.Create;
   Middlewares := TList<THorseCallback>.Create;
@@ -763,7 +791,13 @@ function THorseRadixRouter.FindNode(const ASegments: TArray<THorseBufferSlice>;
   // 1. Tenta correspondência exata via SWAR 64-bit
   for LChild in ANode.Children do
   begin
-    if (not LChild.IsParam) and (LChild.Part <> '*') and LCurrentSlice.Compare(LChild.Part, not THorseCore.CaseSensitive) then
+    if (not LChild.IsParam) and (LChild.Part <> '*') and
+{$IF SizeOf(Char) = 1}
+      LCurrentSlice.Compare(LChild.Part, not THorseCore.CaseSensitive) then
+{$ELSE}
+      LCurrentSlice.CompareBytes(LChild.PartBytes, 0, Length(LChild.PartBytes),
+        not THorseCore.CaseSensitive) then
+{$ENDIF}
     begin
       LTempNode := LChild;
       LBestMatch := FindNode(ASegments, AIndex + 1, LTempNode, AHTTPType, AMiddlewares, AParams);
@@ -878,7 +912,8 @@ function THorseRadixRouter.Execute(const ARequest: THorseRequest; const ARespons
                   begin
                     LKeys := LParams.Keys.ToArray;
                     for I := 0 to Length(LKeys) - 1 do
-                      ARequest.Params.Dictionary.AddOrSetValue(LKeys[I], DecodeParam(LParams.Items[LKeys[I]]));
+                      ARequest.Params.Dictionary.AddOrSetValue(LKeys[I],
+                        ARequest.DecodePathParam(LParams.Items[LKeys[I]]));
                   end;
 
                   LCallbacksList := TList<THorseCallback>.Create;

src/Horse.Core.RouterTree.NextCaller.pas

@@ -184,7 +184,8 @@ procedure TNextCaller.Init;
   begin
     for LTag in FTags do
     begin
-      FRequest.Params.Dictionary.AddOrSetValue(LTag, DecodeParam(LCurrentStr));
+      FRequest.Params.Dictionary.AddOrSetValue(LTag,
+        FRequest.DecodePathParam(LCurrentStr));
     end;
   end;
 end;

src/Horse.Core.RouterTree.pas

@@ -35,6 +35,9 @@   THorseRouterTree = class(TInterfacedObject, IHorseRouter)
     procedure PopulateQueuePath(AQueue: TQueue<string>; APath: string; const AUsePrefix: Boolean = True);
   private
     FPart: string;
+{$IF SizeOf(Char) > 1}
+    FPartBytes: TArray<Byte>;
+{$ENDIF}
     FTags: TArray<string>;
     FFullPath: string;
     FIsParamsKey: Boolean;
@@ -60,6 +63,7 @@   THorseRouterTree = class(TInterfacedObject, IHorseRouter)
     function CallNextPath(const ASegments: TArray<THorseBufferSlice>; AIndex: Integer; const AHTTPType: TMethodType; const ARequest: THorseRequest; const AResponse: THorseResponse): Boolean;
     function HasNext(const AMethod: TMethodType; const APaths: TArray<THorseBufferSlice>; AIndex: Integer = 0): Boolean;
     function CountLiteralSegments(const AMethod: TMethodType; const APaths: TArray<THorseBufferSlice>; AIndex: Integer = 0): Integer;
+    function MatchesPart(const APart: THorseBufferSlice): Boolean;
     class function NormalizeParamKey(const APart: string): string; static;
   public
     function CreateRouter(const APath: string): THorseRouterTree;
@@ -229,6 +233,16 @@ class function THorseRouterTree.NormalizeParamKey(const APart: string): string;
     Result := APart;
 end;
 
+function THorseRouterTree.MatchesPart(const APart: THorseBufferSlice): Boolean;
+begin
+{$IF SizeOf(Char) = 1}
+  Result := APart.Compare(FPart, not THorseCore.CaseSensitive);
+{$ELSE}
+  Result := APart.CompareBytes(FPartBytes, 0, Length(FPartBytes),
+    not THorseCore.CaseSensitive);
+{$ENDIF}
+end;
+
 procedure THorseRouterTree.RegisterRoute(const AHTTPType: TMethodType; const APath: string; const ACallback: THorseCallback);
 var
   LPathChain: TQueue<string>;
@@ -290,7 +304,7 @@ function THorseRouterTree.CallNextPath(const ASegments: TArray<THorseBufferSlice
 
   for LPair in FRoute do
   begin
-    if (LPair.Key <> '*') and LCurrent.Compare(LPair.Key, not THorseCore.CaseSensitive) then
+    if (LPair.Key <> '*') and LPair.Value.MatchesPart(LCurrent) then
     begin
       LAcceptable := LPair.Value;
       LFound := True;
@@ -610,7 +624,7 @@ function THorseRouterTree.CountLiteralSegments(const AMethod: TMethodType; const
   LNextRoute := nil;
   for LPair in FRoute do
   begin
-    if LNext.Compare(LPair.Key, not THorseCore.CaseSensitive) or (LPair.Key = '*') then
+    if LPair.Value.MatchesPart(LNext) or (LPair.Key = '*') then
     begin
       LNextRoute := LPair.Value;
       LFound := True;
@@ -653,7 +667,8 @@ function THorseRouterTree.HasNext(const AMethod: TMethodType; const APaths: TArr
     if Length(APaths) - 1 = AIndex then
       Exit(FCallBack.ContainsKey(AMethod) or (AMethod = mtAny));
   end
-  else if (Length(APaths) - 1 = AIndex) and (APaths[AIndex].Compare(FPart, not THorseCore.CaseSensitive) or FIsParamsKey) then
+  else if (Length(APaths) - 1 = AIndex) and
+    (MatchesPart(APaths[AIndex]) or FIsParamsKey) then
   begin
     Exit(FCallBack.ContainsKey(AMethod) or (AMethod = mtAny));
   end;
@@ -665,7 +680,7 @@ function THorseRouterTree.HasNext(const AMethod: TMethodType; const APaths: TArr
   LNextRoute := nil;
   for LPair in FRoute do
   begin
-    if LNext.Compare(LPair.Key, not THorseCore.CaseSensitive) or (LPair.Key = '*') then
+    if LPair.Value.MatchesPart(LNext) or (LPair.Key = '*') then
     begin
       LNextRoute := LPair.Value;
       LFound := True;
@@ -706,6 +721,9 @@ procedure THorseRouterTree.RegisterInternal(const AHTTPType: TMethodType; var AP
   begin
     LRawPart := APath.Dequeue;
     FPart := LRawPart;
+{$IF SizeOf(Char) > 1}
+    FPartBytes := TEncoding.UTF8.GetBytes(FPart);
+{$ENDIF}
 
     FIsOptional := False;
     FIsRouterRegex := False;
@@ -868,6 +886,9 @@ procedure THorseRouterTree.RegisterMiddlewareInternal(var APath: TQueue<string>;
   begin
     LRawPart := APath.Dequeue;
     FPart := LRawPart;
+{$IF SizeOf(Char) > 1}
+    FPartBytes := TEncoding.UTF8.GetBytes(FPart);
+{$ENDIF}
     FIsParamsKey := FPart.StartsWith(':');
     if FIsParamsKey then
     begin