unit AIHttpClient;

{$mode objfpc}{$H+}

// Windows-native HTTPS transport for the AI chat feature. UTF-8 in/out.
// Pure request/response; no threads, no globals -> safe to call from a worker thread.
//
// Security contract (mirrors AIConfig's URL policy):
//   - HTTPS required, except literal loopback (localhost, 127/8, [::1]) may use HTTP.
//   - userinfo in the authority is rejected outright (no credential leakage via URL).
//   - TLS certificate validation is NEVER disabled.
//   - Automatic redirects are disabled AND any 3xx is treated as failure, so secret
//     headers can never be replayed to a different host.
//   - Response is capped at 8 MiB before any append/allocation.
//   - Outbound header lines are validated (no CR/LF, valid field-name) before any send.
//   - Sensitive header values (Authorization, x-api-key) are redacted from all errors.
//   - On any non-2xx, ResponseBody is cleared; a bounded (<=2048 B), redacted excerpt
//     rides in ErrorText only.
// Non-Windows builds return an explicit "unsupported" error with no network fallback.

interface

uses
  {$IFDEF WINDOWS}Windows,{$ENDIF}
  Classes, SysUtils;

// Returns True only on an HTTP 2xx response. On any other outcome returns False with
// ErrorText populated (status + a bounded, credential-redacted body excerpt, <=2048 B
// total) and ResponseBody cleared. Outputs are always initialized, even on exception.
function PostJSON(const URL: UTF8String; Headers: TStrings; const Body: UTF8String;
  TimeoutMS: DWORD; out StatusCode: DWORD; out ResponseBody: UTF8String;
  out ErrorText: UTF8String): Boolean;

{$IFDEF AIHTTP_TEST}
// Internals exposed for unit tests only.
type
  TParsedURL = record
    Scheme: UTF8String;   // 'http' | 'https'
    Host:   UTF8String;   // IPv6 literals have brackets stripped ('::1')
    Path:   UTF8String;   // request target: path plus query, never empty ('/')
    Port:   Word;
    Secure: Boolean;
  end;

const
  AIHTTP_MAX_RESPONSE = 8 * 1024 * 1024;   // 8 MiB hard cap
  AIHTTP_MIN_TIMEOUT  = 5000;
  AIHTTP_MAX_TIMEOUT  = 300000;

function AIHttp_ParseURL(const URL: UTF8String; out P: TParsedURL; out ErrorText: UTF8String): Boolean;
function AIHttp_Redact(const Text: UTF8String; Headers: TStrings): UTF8String;
function AIHttp_CapExceeded(CurrentLen, ChunkLen: SizeInt): Boolean;
function AIHttp_ValidTimeout(TimeoutMS: DWORD): Boolean;
function AIHttp_ValidHeaderLine(const Line: UTF8String): Boolean;

const
  AIHTTP_MAX_ERRTEXT = 2048;   // final ErrorText byte cap (after redaction)
{$ENDIF}

implementation

{$IFNDEF AIHTTP_TEST}
// Release builds don't export the test surface, but the transport implementation
// still needs this record. Under AIHTTP_TEST the interface already declares it, so
// guard here to keep exactly one definition per build.
type
  TParsedURL = record
    Scheme: UTF8String;   // 'http' | 'https'
    Host:   UTF8String;   // IPv6 literals have brackets stripped ('::1')
    Path:   UTF8String;   // request target: path plus query, never empty ('/')
    Port:   Word;
    Secure: Boolean;
  end;
{$ENDIF}

const
  MAX_RESPONSE  = 8 * 1024 * 1024;   // 8 MiB
  MIN_TIMEOUT   = 5000;
  MAX_TIMEOUT   = 300000;
  MAX_ERRTEXT   = 2048;              // final ErrorText byte cap (after redaction)
  MAX_ERR_BODY  = 1024;              // body excerpt appended into ErrorText (bounded, then final-capped)
  REDACT_MARK   = '***REDACTED***';

// ---------------------------------------------------------------------------
// URL parsing / loopback policy (self-contained; same semantics as AIConfig)
// ---------------------------------------------------------------------------

function IsLoopbackIPv4(const Host: UTF8String): boolean;
var parts: TStringArray; a, i: integer;
begin
  Result := False;
  parts := string(Host).Split(['.']);   // Host is ASCII for any IPv4 literal
  if Length(parts) <> 4 then Exit;
  if not (TryStrToInt(parts[0], a) and (a = 127)) then Exit;
  for i := 1 to 3 do
    if not (TryStrToInt(parts[i], a) and (a >= 0) and (a <= 255)) then Exit;
  Result := True;
end;

function IsLoopback(const Host: UTF8String): boolean;
var h: UTF8String;
begin
  h := LowerCase(Host);
  Result := (h = 'localhost') or (h = '::1') or IsLoopbackIPv4(h);
end;

// Parse a numeric string as a decimal port in 1..65535. Rejects '', signs, junk.
function ParsePort(const S: UTF8String; out Port: Word): boolean;
var i, v: integer;
begin
  Result := False;
  if (S = '') or (Length(S) > 5) then Exit;
  for i := 1 to Length(S) do
    if not (S[i] in ['0'..'9']) then Exit;
  v := StrToInt(S);
  if (v < 1) or (v > 65535) then Exit;
  Port := Word(v);
  Result := True;
end;

function DefaultPort(Secure: boolean): Word;
begin
  if Secure then Result := 443 else Result := 80;
end;

function AIHttp_ParseURL(const URL: UTF8String; out P: TParsedURL; out ErrorText: UTF8String): Boolean;
var
  i, sep: integer;
  hasPort: boolean;
  rest, authority, tail, hostport, portStr: UTF8String;
begin
  Result := False;
  P.Scheme := ''; P.Host := ''; P.Path := ''; P.Port := 0; P.Secure := False;
  ErrorText := '';

  // scheme
  i := Pos('://', URL);
  if i <= 0 then begin ErrorText := 'URL must include a scheme (https:// or http://)'; Exit; end;
  P.Scheme := LowerCase(Copy(URL, 1, i - 1));
  rest := Copy(URL, i + 3, MaxInt);
  if (P.Scheme <> 'http') and (P.Scheme <> 'https') then
  begin ErrorText := 'URL scheme must be http or https'; Exit; end;
  P.Secure := P.Scheme = 'https';

  // authority ends at the first '/', '?' or '#'
  sep := 1;
  while (sep <= Length(rest)) and (rest[sep] <> '/') and (rest[sep] <> '?') and (rest[sep] <> '#') do
    Inc(sep);
  authority := Copy(rest, 1, sep - 1);
  tail := Copy(rest, sep, MaxInt);

  // request target = path + query (fragment dropped, never sent to server)
  i := Pos('#', tail);
  if i > 0 then tail := Copy(tail, 1, i - 1);
  if tail = '' then P.Path := '/'
  else if tail[1] = '?' then P.Path := '/' + tail
  else P.Path := tail;

  // userinfo is a credential-leak vector -> reject, never strip
  if Pos('@', authority) > 0 then
  begin ErrorText := 'URL must not contain userinfo (user@host)'; Exit; end;

  // host[:port] — IPv6 literals are bracketed
  hasPort := False;
  portStr := '';
  if (authority <> '') and (authority[1] = '[') then
  begin
    i := Pos(']', authority);
    if i = 0 then begin ErrorText := 'URL has an unterminated IPv6 literal'; Exit; end;
    P.Host := Copy(authority, 2, i - 2);                 // strip brackets
    hostport := Copy(authority, i + 1, MaxInt);          // '' or ':port'
    if hostport <> '' then
    begin
      if hostport[1] <> ':' then
        begin ErrorText := 'URL has a malformed IPv6 authority'; Exit; end;
      hasPort := True;
      portStr := Copy(hostport, 2, MaxInt);
    end;
  end
  else
  begin
    i := Pos(':', authority);
    if i = 0 then P.Host := authority
    else
    begin
      P.Host := Copy(authority, 1, i - 1);
      hasPort := True;
      portStr := Copy(authority, i + 1, MaxInt);
      if Pos(':', portStr) > 0 then                      // stray colon -> ambiguous
      begin ErrorText := 'URL has a malformed authority'; Exit; end;
    end;
  end;

  if P.Host = '' then begin ErrorText := 'URL is missing a host'; Exit; end;

  if not hasPort then
    P.Port := DefaultPort(P.Secure)
  else if not ParsePort(portStr, P.Port) then            // present but empty/invalid -> reject
  begin ErrorText := 'URL has an invalid port'; Exit; end;

  // HTTP only for loopback
  if (not P.Secure) and (not IsLoopback(P.Host)) then
  begin ErrorText := 'HTTP is only allowed for loopback; use HTTPS for remote hosts'; Exit; end;

  Result := True;
end;

// ---------------------------------------------------------------------------
// Redaction / cap / timeout helpers
// ---------------------------------------------------------------------------

// Redact every non-blank value of a sensitive header (Authorization, x-api-key),
// matching header names case-insensitively. The value is the exact secret string, so
// redaction of the value is a literal (case-sensitive) substring replace.
function AIHttp_Redact(const Text: UTF8String; Headers: TStrings): UTF8String;
var
  i, c: integer;
  line, name, val: UTF8String;
begin
  Result := Text;
  if Headers = nil then Exit;
  for i := 0 to Headers.Count - 1 do
  begin
    line := Headers[i];
    c := Pos(':', line);
    if c <= 0 then Continue;
    name := LowerCase(Trim(Copy(line, 1, c - 1)));
    if (name <> 'authorization') and (name <> 'x-api-key') then Continue;
    val := Trim(Copy(line, c + 1, MaxInt));
    if val = '' then Continue;                            // nothing to redact
    Result := StringReplace(Result, val, REDACT_MARK, [rfReplaceAll]);
  end;
end;

// A single outbound header line is well-formed iff it contains no CR/LF (header
// injection) and has a non-empty, syntactically valid field-name before the first
// colon. field-name is an RFC 7230 token (tchar+); anything else is rejected so a
// crafted value cannot smuggle an extra Authorization/x-api-key line the redactor
// can never enumerate. Value part is not constrained here beyond the CR/LF ban.
function AIHttp_ValidHeaderLine(const Line: UTF8String): Boolean;
var i, c: integer; ch: Char;
begin
  Result := False;
  for i := 1 to Length(Line) do
    if (Line[i] = #13) or (Line[i] = #10) or (Line[i] = #0) then Exit;
      // no CR/LF -> no injected lines; no NUL -> WinHTTP's NUL-terminated view of the
      // wide header can't diverge from the redactor's view of the full Pascal string
  c := Pos(':', Line);
  if c <= 1 then Exit;                                  // missing colon or empty field-name
  for i := 1 to c - 1 do
  begin
    ch := Line[i];
    if not (ch in ['A'..'Z','a'..'z','0'..'9',
        '!','#','$','%','&','''','*','+','-','.','^','_','`','|','~']) then Exit;  // tchar only
  end;
  Result := True;
end;

// Overflow-safe: would appending ChunkLen bytes to CurrentLen exceed the 8 MiB cap?
function AIHttp_CapExceeded(CurrentLen, ChunkLen: SizeInt): Boolean;
begin
  if (CurrentLen < 0) or (ChunkLen < 0) then Exit(True);
  if CurrentLen > MAX_RESPONSE then Exit(True);
  Result := ChunkLen > (MAX_RESPONSE - CurrentLen);
end;

// Timeout contract is a hard range, not a clamp: out-of-range is a caller error
// (a silent clamp would mask a misconfigured 0 or an absurd value).
function AIHttp_ValidTimeout(TimeoutMS: DWORD): Boolean;
begin
  Result := (TimeoutMS >= MIN_TIMEOUT) and (TimeoutMS <= MAX_TIMEOUT);
end;

// ===========================================================================
// Platform transport
// ===========================================================================

{$IFDEF WINDOWS}
type
  HINTERNET = Pointer;

const
  winhttpdll = 'winhttp.dll';

  WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0;
  WINHTTP_FLAG_SECURE               = $00800000;

  WINHTTP_OPTION_REDIRECT_POLICY        = 88;
  WINHTTP_OPTION_REDIRECT_POLICY_NEVER  = 0;

  WINHTTP_QUERY_STATUS_CODE = 19;
  WINHTTP_QUERY_FLAG_NUMBER = $20000000;

  WINHTTP_ADDREQ_FLAG_ADD     = $20000000;
  WINHTTP_ADDREQ_FLAG_REPLACE = $80000000;

function WinHttpOpen(pszAgentW: PWideChar; dwAccessType: DWORD;
  pszProxyW, pszProxyBypassW: PWideChar; dwFlags: DWORD): HINTERNET; stdcall; external winhttpdll;
function WinHttpConnect(hSession: HINTERNET; pswzServerName: PWideChar;
  nServerPort: Word; dwReserved: DWORD): HINTERNET; stdcall; external winhttpdll;
function WinHttpOpenRequest(hConnect: HINTERNET; pwszVerb, pwszObjectName, pwszVersion,
  pwszReferrer: PWideChar; ppwszAcceptTypes: Pointer; dwFlags: DWORD): HINTERNET; stdcall; external winhttpdll;
function WinHttpSetTimeouts(hInternet: HINTERNET;
  nResolveTimeout, nConnectTimeout, nSendTimeout, nReceiveTimeout: integer): BOOL; stdcall; external winhttpdll;
function WinHttpSetOption(hInternet: HINTERNET; dwOption: DWORD;
  lpBuffer: Pointer; dwBufferLength: DWORD): BOOL; stdcall; external winhttpdll;
function WinHttpAddRequestHeaders(hRequest: HINTERNET; pwszHeaders: PWideChar;
  dwHeadersLength, dwModifiers: DWORD): BOOL; stdcall; external winhttpdll;
// dwContext is a DWORD_PTR (pointer-sized) in WinHTTP: 4 bytes on Win32, 8 on Win64.
// PtrUInt is exact for both, unlike DWORD which would truncate/misalign the Win64 stack.
function WinHttpSendRequest(hRequest: HINTERNET; pwszHeaders: PWideChar;
  dwHeadersLength: DWORD; lpOptional: Pointer; dwOptionalLength, dwTotalLength: DWORD; dwContext: PtrUInt): BOOL; stdcall; external winhttpdll;
function WinHttpReceiveResponse(hRequest: HINTERNET; lpReserved: Pointer): BOOL; stdcall; external winhttpdll;
function WinHttpQueryHeaders(hRequest: HINTERNET; dwInfoLevel: DWORD; pwszName: PWideChar;
  lpBuffer: Pointer; var lpdwBufferLength: DWORD; var lpdwIndex: DWORD): BOOL; stdcall; external winhttpdll;
function WinHttpQueryDataAvailable(hRequest: HINTERNET; var lpdwNumberOfBytesAvailable: DWORD): BOOL; stdcall; external winhttpdll;
function WinHttpReadData(hRequest: HINTERNET; lpBuffer: Pointer;
  dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall; external winhttpdll;
function WinHttpCloseHandle(hInternet: HINTERNET): BOOL; stdcall; external winhttpdll;

function W(const S: UTF8String): UnicodeString;
begin
  Result := UTF8Decode(S);
end;

function PostJSON(const URL: UTF8String; Headers: TStrings; const Body: UTF8String;
  TimeoutMS: DWORD; out StatusCode: DWORD; out ResponseBody: UTF8String;
  out ErrorText: UTF8String): Boolean;
var
  p: TParsedURL;
  hSession, hConnect, hRequest: HINTERNET;
  t: integer;
  flags, policy: DWORD;
  wobj, whdr: UnicodeString;
  i: integer;
  code, sz, idx, avail, readN, bodyLen: DWORD;
  bodyPtr: Pointer;
  ok2xx: boolean;
  chunk: array of Byte;
  resp: UTF8String;

  // Every failure path funnels through here so ErrorText is always redacted AND
  // hard-capped to <= MAX_ERRTEXT bytes. Order matters: redact first (redaction can
  // grow the text), then cap, so a secret can never survive at the tail past the cut.
  procedure Fail(const msg: UTF8String);
  begin
    ErrorText := AIHttp_Redact(msg, Headers);
    if Length(ErrorText) > MAX_ERRTEXT then
      SetLength(ErrorText, MAX_ERRTEXT);
  end;

begin
  Result := False;
  StatusCode := 0;
  ResponseBody := '';
  ErrorText := '';
  hSession := nil; hConnect := nil; hRequest := nil;
  resp := '';
  try                     // outer: guarantees handle cleanup on every path
   try                    // inner: converts exceptions into a redacted ErrorText
    if not AIHttp_ParseURL(URL, p, ErrorText) then Exit;   // ParseURL text carries no secrets

    // Reject out-of-range timeouts outright rather than silently clamping.
    if not AIHttp_ValidTimeout(TimeoutMS) then
    begin
      Fail('TimeoutMS out of range (' + IntToStr(MIN_TIMEOUT) + '..' + IntToStr(MAX_TIMEOUT) + ')');
      Exit;
    end;
    t := integer(TimeoutMS);

    // Validate every outbound header BEFORE any WinHTTP call: a CR/LF or bogus
    // field-name could otherwise inject a second header line (e.g. a forged
    // Authorization the redactor never sees). Fail closed; message names no value.
    if Headers <> nil then
      for i := 0 to Headers.Count - 1 do
      begin
        if Trim(Headers[i]) = '' then Continue;
        if not AIHttp_ValidHeaderLine(Headers[i]) then
        begin Fail('invalid header line at index ' + IntToStr(i) + ' (CR/LF or malformed field-name)'); Exit; end;
      end;

    // Request body pointer must be nil when empty; explicit first-byte pointer otherwise.
    if Length(Body) > High(DWORD) then begin Fail('request body too large'); Exit; end;
    bodyLen := DWORD(Length(Body));
    if bodyLen = 0 then bodyPtr := nil else bodyPtr := @Body[1];

    hSession := WinHttpOpen(PWideChar(UnicodeString('CheatEngine-AI/1.0')),
      WINHTTP_ACCESS_TYPE_DEFAULT_PROXY, nil, nil, 0);
    if hSession = nil then begin Fail('WinHttpOpen failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;

    // Timeouts are a security control (bound a slowloris peer); fail closed if unset.
    if not WinHttpSetTimeouts(hSession, t, t, t, t) then
    begin Fail('WinHttpSetTimeouts failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;

    hConnect := WinHttpConnect(hSession, PWideChar(W(p.Host)), p.Port, 0);
    if hConnect = nil then begin Fail('WinHttpConnect failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;

    flags := 0;
    if p.Secure then flags := WINHTTP_FLAG_SECURE;
    wobj := W(p.Path);
    hRequest := WinHttpOpenRequest(hConnect, PWideChar(UnicodeString('POST')),
      PWideChar(wobj), nil, nil, nil, flags);
    if hRequest = nil then begin Fail('WinHttpOpenRequest failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;

    // Never follow redirects: secret headers must not cross to another host. This is a
    // hard security control, so a failure to set it must abort the request.
    policy := WINHTTP_OPTION_REDIRECT_POLICY_NEVER;
    if not WinHttpSetOption(hRequest, WINHTTP_OPTION_REDIRECT_POLICY, @policy, SizeOf(policy)) then
    begin Fail('WinHttpSetOption(redirect policy) failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;
    // NOTE: TLS certificate validation is left at WinHTTP defaults on purpose.

    if Headers <> nil then
      for i := 0 to Headers.Count - 1 do
      begin
        if Trim(Headers[i]) = '' then Continue;   // already validated above, pre-network
        whdr := W(Headers[i]);
        // A dropped auth/api-key header would silently send an unauthenticated request;
        // fail closed instead. Error text is redacted, so the header value never leaks.
        if not WinHttpAddRequestHeaders(hRequest, PWideChar(whdr), DWORD(-1),
             WINHTTP_ADDREQ_FLAG_ADD or WINHTTP_ADDREQ_FLAG_REPLACE) then
        begin Fail('WinHttpAddRequestHeaders failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;
      end;

    if not WinHttpSendRequest(hRequest, nil, 0,
         bodyPtr, bodyLen, bodyLen, 0) then
    begin Fail('WinHttpSendRequest failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;

    if not WinHttpReceiveResponse(hRequest, nil) then
    begin Fail('WinHttpReceiveResponse failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;

    // status code (numeric)
    code := 0; sz := SizeOf(code); idx := 0;
    if not WinHttpQueryHeaders(hRequest,
         WINHTTP_QUERY_STATUS_CODE or WINHTTP_QUERY_FLAG_NUMBER, nil, @code, sz, idx) then
    begin Fail('WinHttpQueryHeaders(status) failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;
    StatusCode := code;

    // read body with 8 MiB cap enforced before each append/allocation
    repeat
      avail := 0;
      if not WinHttpQueryDataAvailable(hRequest, avail) then
      begin Fail('WinHttpQueryDataAvailable failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;
      if avail = 0 then Break;
      if AIHttp_CapExceeded(Length(resp), avail) then
      begin
        // Cap breach is a failure: never hand back a partial (possibly secret-bearing)
        // body. Clear it; the bounded ErrorText is the only surfaced excerpt.
        ResponseBody := '';
        Fail('response exceeded 8 MiB cap');
        Exit;
      end;
      SetLength(chunk, avail);
      readN := 0;
      if not WinHttpReadData(hRequest, @chunk[0], avail, readN) then
      begin Fail('WinHttpReadData failed (err '+IntToStr(GetLastOSError)+')'); Exit; end;
      if readN = 0 then Break;
      i := Length(resp);
      SetLength(resp, i + integer(readN));
      Move(chunk[0], resp[i + 1], readN);
    until False;

    ok2xx := (code >= 200) and (code < 300);
    if ok2xx then
    begin
      ResponseBody := resp;
      Result := True;
    end
    else
    begin
      // Non-2xx bodies routinely echo the request's auth header (see providers' 401
      // payloads). Simplest safe contract: never surface the failure body at all —
      // clear ResponseBody, and carry only a bounded, redacted excerpt in ErrorText.
      // Fail() redacts then hard-caps the whole string to MAX_ERRTEXT centrally, so
      // the pre-bound here just limits the raw excerpt before redaction expands it.
      ResponseBody := '';
      Fail('HTTP ' + IntToStr(code) + '. ' + Copy(resp, 1, MAX_ERR_BODY));
      Result := False;
    end;
   except
    on E: Exception do
    begin
      Result := False;
      Fail('exception: ' + E.Message);
    end;
   end;
  // Handles ALWAYS close, on every early Exit and on exception.
  finally
    if hRequest <> nil then WinHttpCloseHandle(hRequest);
    if hConnect <> nil then WinHttpCloseHandle(hConnect);
    if hSession <> nil then WinHttpCloseHandle(hSession);
  end;
end;

{$ELSE}

function PostJSON(const URL: UTF8String; Headers: TStrings; const Body: UTF8String;
  TimeoutMS: DWORD; out StatusCode: DWORD; out ResponseBody: UTF8String;
  out ErrorText: UTF8String): Boolean;
begin
  StatusCode := 0;
  ResponseBody := '';
  ErrorText := 'HTTP transport is only supported on Windows (WinHTTP)';
  Result := False;
end;

{$ENDIF}

end.