1 files changed, 178 insertions, 0 deletions
diff --git a/src/CepisHttp.pas b/src/CepisHttp.pas
new file mode 100644
index 0000000..384612f
--- /dev/null
+++ b/src/CepisHttp.pas
@@ -0,0 +1,178 @@
+{
+  CepisHttp - the transport the Cepis unit sits on.
+
+  One function, one GET, no state. Everything above it (retrying, backoff,
+  turning statuses into exceptions) lives in the Cepis unit, so swapping the
+  HTTP implementation touches only this file.
+
+  Free Pascal uses `fphttpclient`, which ships with the compiler. HTTPS needs
+  the `opensslsockets` unit linked in - it is, right here - and OpenSSL
+  present at run time, which is what makes an `https://` base URL work at all.
+
+  A Delphi branch built on `System.Net.HttpClient` is provided for source
+  compatibility. It has never been compiled: this library is developed and
+  tested with Free Pascal.
+}
+unit CepisHttp;
+
+{$IFDEF FPC}
+  {$MODE OBJFPC}
+  {$H+}
+{$ENDIF}
+
+interface
+
+uses
+  SysUtils, Classes;
+
+type
+  {
+    The outcome of one GET.
+
+    `Failed` separates the two kinds of answer. When it is True the request
+    never completed - DNS, refused connection, timeout, TLS - and only
+    `ErrorMessage` is meaningful. When it is False the server answered, and
+    `Status` holds what it answered, including 4xx and 5xx: those are answers,
+    not failures, and the layer above decides what they mean.
+
+    `Body` carries the response bytes decoded as UTF-8, which is what the API
+    sends. `RetryAfter` is the raw `Retry-After` header, unparsed, or empty.
+  }
+  TCepisHttpResponse = record
+    Status: Integer;
+    Body: string;
+    RetryAfter: string;
+    Failed: Boolean;
+    ErrorMessage: string;
+  end;
+
+{
+  Perform a single GET and describe what came back.
+
+  Never raises: a transport failure comes back as `Failed = True`. Retrying is
+  the caller's business.
+
+  `ATimeoutMS` bounds each socket operation - the connect, and each read - not
+  the call as a whole.
+}
+function CepisHttpGet(const AURL, AUserAgent, AAccept: string;
+  ATimeoutMS: Integer): TCepisHttpResponse;
+
+implementation
+
+uses
+{$IFDEF FPC}
+  fphttpclient, opensslsockets;
+{$ELSE}
+  System.Net.HttpClient, System.Net.URLClient;
+{$ENDIF}
+
+{$IFDEF FPC}
+
+function CepisHttpGet(const AURL, AUserAgent, AAccept: string;
+  ATimeoutMS: Integer): TCepisHttpResponse;
+var
+  Client: TFPHTTPClient;
+  Buffer: TMemoryStream;
+begin
+  Result.Status := 0;
+  Result.Body := '';
+  Result.RetryAfter := '';
+  Result.Failed := False;
+  Result.ErrorMessage := '';
+
+  Buffer := TMemoryStream.Create;
+  try
+    Client := TFPHTTPClient.Create(nil);
+    try
+      Client.AllowRedirect := True;
+      Client.ConnectTimeout := ATimeoutMS;
+      Client.IOTimeout := ATimeoutMS;
+      Client.AddHeader('User-Agent', AUserAgent);
+      Client.AddHeader('Accept', AAccept);
+      Client.AddHeader('Accept-Encoding', 'identity');
+      try
+        Client.HTTPMethod('GET', AURL, Buffer, []);
+        Result.Status := Client.ResponseStatusCode;
+        SetLength(Result.Body, Buffer.Size);
+        if Buffer.Size > 0 then
+          Move(Buffer.Memory^, Result.Body[1], Buffer.Size);
+        if Assigned(Client.ResponseHeaders) then
+          Result.RetryAfter :=
+            TFPHTTPClient.GetHeader(Client.ResponseHeaders, 'Retry-After');
+      except
+        on E: Exception do
+        begin
+          Result.Failed := True;
+          Result.Status := 0;
+          Result.Body := '';
+          Result.RetryAfter := '';
+          Result.ErrorMessage := E.ClassName + ': ' + E.Message;
+        end;
+      end;
+    finally
+      Client.Free;
+    end;
+  finally
+    Buffer.Free;
+  end;
+end;
+
+{$ELSE}
+
+function CepisHttpGet(const AURL, AUserAgent, AAccept: string;
+  ATimeoutMS: Integer): TCepisHttpResponse;
+var
+  Client: THTTPClient;
+  Response: IHTTPResponse;
+  Buffer: TMemoryStream;
+  Payload: TBytes;
+begin
+  Result.Status := 0;
+  Result.Body := '';
+  Result.RetryAfter := '';
+  Result.Failed := False;
+  Result.ErrorMessage := '';
+
+  Buffer := TMemoryStream.Create;
+  try
+    Client := THTTPClient.Create;
+    try
+      Client.ConnectionTimeout := ATimeoutMS;
+      Client.ResponseTimeout := ATimeoutMS;
+      Client.UserAgent := AUserAgent;
+      Client.HandleRedirects := True;
+      try
+        Response := Client.Get(AURL, Buffer,
+          [TNetHeader.Create('Accept', AAccept),
+           TNetHeader.Create('Accept-Encoding', 'identity')]);
+        Result.Status := Response.StatusCode;
+        SetLength(Payload, Buffer.Size);
+        if Buffer.Size > 0 then
+        begin
+          Buffer.Position := 0;
+          Buffer.ReadBuffer(Payload[0], Buffer.Size);
+        end;
+        Result.Body := TEncoding.UTF8.GetString(Payload);
+        Result.RetryAfter := Response.HeaderValue['Retry-After'];
+      except
+        on E: Exception do
+        begin
+          Result.Failed := True;
+          Result.Status := 0;
+          Result.Body := '';
+          Result.RetryAfter := '';
+          Result.ErrorMessage := E.ClassName + ': ' + E.Message;
+        end;
+      end;
+    finally
+      Client.Free;
+    end;
+  finally
+    Buffer.Free;
+  end;
+end;
+
+{$ENDIF}
+
+end.