Italian community of Lazarus and Free Pascal

sudo apt install mingw-w64 mingw-w64-tools

program restfulhttpserverthreadsafe;

{$mode objfpc}{$H+}
{$define THREADPOOL}

{
 This code has been dedicated to the public domain.

 You may use, modify, copy, or distribute this code freely,
 for any purpose, without any conditions or warranties.

 Author: nomorelogic (Basso Marcello)
 Date: 13/05/2025

 Special thanks to (https://forum.lazarus.freepascal.org/index.php/topic,71031.0.html):
 - Thaddy
 - Fibonacci

 Abstract:
 this code is an intentionally simple version of a microservice for a restful json server
 is intended to be a basis for creating better servers
}

uses
  cthreads,
  Classes,
  SysUtils,
  cmem,
  libmicrohttpd,
  fpjson,
  jsonparser,
  syncobjs;

const
  PORT = 8888;

type

  TRestResponse = record
    StatusCode: cuint;
    ResText: string;
  end;

  TClientContextInfo = record
    Playload_AsText: string;
    PlayLoadIsJson: boolean;
    PlayLoad_AsJson: TJSONObject;
    Response: TRestResponse;
  end;
  PClientContextInfo = ^TClientContextInfo;

var
  ShouldStop: boolean = False;
  Daemon: PMHD_Daemon;
  StopLock: TCriticalSection;

  function HandleRestfulRequest(cls: Pointer; connection: PMHD_Connection;
    url, method, version: pchar; upload_data: pchar; upload_data_size: pSize_t;
    con_cls: PPointer): cint; cdecl;
  var
    response: PMHD_Response;
    jsonObj: TJSONObject;
    con_info: PClientContextInfo;
  begin
    Result := 0;

    // - - - - - - - - - - - - - - - - - - - - - - -
    // first call
    // the first invocation is used to initialize the
    // context of the request; generally a data structure is created
    // - - - - - - - - - - - - - - - - - - - - - - -
    if con_cls^ = nil then
    begin
      // init client context
      New(con_info);
      con_info^.Playload_AsText := '';
      con_info^.PlayLoadIsJson := False;
      con_info^.PlayLoad_AsJson := nil;
      con_info^.Response.StatusCode := MHD_HTTP_OK;
      con_info^.Response.ResText := '';
      con_cls^ := con_info;
      Exit(MHD_YES);
    end; // else begin

    con_info := PClientContextInfo(con_cls^);


    // - - - - - - - - - - - - - - - - - - - - - - -
    // Handle POST data
    // in the case of POST data: an additional callback
    // is executed to allow the input data to be handled
    // - - - - - - - - - - - - - - - - - - - - - - -
    if (method = MHD_HTTP_METHOD_POST) and (upload_data_size^ <> 0) then
    begin

      SetString(con_info^.Playload_AsText, upload_data, upload_data_size^);

      // Try to parse as JSON if content-type is application/json
      if Assigned(MHD_lookup_connection_value(connection, MHD_HEADER_KIND,
        MHD_HTTP_HEADER_CONTENT_TYPE)) then
        if (Pos('application/json',
          MHD_lookup_connection_value(connection, MHD_HEADER_KIND,
          MHD_HTTP_HEADER_CONTENT_TYPE)) > 0) then
        begin
          if con_info^.Playload_AsText <> '' then
          try
            con_info^.PlayLoadIsJson := True;
            con_info^.PlayLoad_AsJson :=
              GetJSON(con_info^.Playload_AsText) as TJSONObject;
          except
            // on exception: return error
            con_info^.Response.StatusCode := MHD_HTTP_INTERNAL_SERVER_ERROR;
            con_info^.Response.ResText := '{"error": "Invalid JSON format"}';
          end;

        end;

      upload_data_size^ := 0;
      Exit(MHD_YES);

    end; // <-- handle post data

    // - - - - - - - - - - - - - - - - - - - - - - -
    // last call
    // response handler
    // - - - - - - - - - - - - - - - - - - - - - - -
    if con_info^.Response.StatusCode = MHD_HTTP_OK then
    begin

      if url = '/shutdown' then
      begin
        jsonObj := TJSONObject.Create;
        jsonObj.Add('status', 'shutting down');
        con_info^.Response.ResText := jsonObj.AsJSON;
        jsonObj.Free;

        // try gracefully stop
        StopLock.Enter;
        try
          ShouldStop := True;
        finally
          StopLock.Leave;
        end;

      end
      else if (url = '/api/status') and (method = 'GET') then
      begin
        jsonObj := TJSONObject.Create;
        jsonObj.Add('status', 'ok');
        jsonObj.Add('uptime', FormatDateTime('hh:nn:ss', Now));
        con_info^.Response.ResText := jsonObj.AsJSON;
        jsonObj.Free;
      end
      else if url = '/api/echo' then
      begin
        if method = 'GET' then
        begin
          con_info^.Response.ResText := '{"method": "GET", "data": "echo"}';
        end
        else if method = 'POST' then
        begin
          // do we have a playload?
          if con_info^.PlayLoadIsJson then
          begin
            if Assigned(con_info^.PlayLoad_AsJson) then
              con_info^.Response.ResText := con_info^.PlayLoad_AsJson.AsJSON;
          end
          else
          begin
            con_info^.Response.ResText := con_info^.Playload_AsText;
          end;

          // playload is empty?
          if con_info^.Response.ResText = '' then
          begin
            con_info^.Response.StatusCode := MHD_HTTP_NO_CONTENT;
            con_info^.Response.ResText := '{"error": "No data received"}';
          end;
        end;

      end; // POST /api/echo

    end; // <-- second call

    // - - - - - - - - - - - - - - - - - - - - -
    // response
    // send respnse and free resources
    // - - - - - - - - - - - - - - - - - - - - -
    response := MHD_create_response_from_buffer(Length(con_info^.Response.ResText),
      PChar(con_info^.Response.ResText), MHD_RESPMEM_MUST_COPY);
    MHD_add_response_header(response, 'Content-Type', 'application/json');
    Result := MHD_queue_response(connection, con_info^.Response.StatusCode, response);

    // Free response
    MHD_destroy_response(response);

    // Free client context
    if Assigned(con_info^.PlayLoad_AsJson) then
      con_info^.PlayLoad_AsJson.Free;
    Dispose(con_info);
    con_cls^ := nil;

  end; // function HandleRestfulRequest

begin
  // critical section
  StopLock := TCriticalSection.Create;
  try

    // Create the MHD daemon with either thread pool OR thread-per-connection
    // Choose one of these options:

    // Option 1: Thread pool (fixed number of threads)
    {$if Defined(THREADPOOL)}
    Daemon := MHD_start_daemon(MHD_USE_INTERNAL_POLLING_THREAD or
      MHD_USE_DEBUG, PORT, nil, nil, @HandleRestfulRequest,
      nil, MHD_OPTION_THREAD_POOL_SIZE, 4, MHD_OPTION_END);

    {$else thread_per_connection}
    // Option 2: Thread-per-connection (one thread per request)
    Daemon := MHD_start_daemon(
      MHD_USE_THREAD_PER_CONNECTION or MHD_USE_DEBUG or MHD_USE_INTERNAL_POLLING_THREAD,
      PORT,
      nil,
      nil,
      @HandleRestfulRequest,
      nil,
      MHD_OPTION_END
    );
    {$ifend}

    if Daemon = nil then
    begin
      WriteLn('Error starting HTTP server!');
      Halt(1);
    end;

    WriteLn('rest server started at: http://localhost:', PORT);
    WriteLn('Endpoints: /api/status (GET), /api/echo (POST), /shutdown');

    // Loop server
    while not ShouldStop do
      Sleep(100);

    MHD_stop_daemon(Daemon);
    WriteLn('Server stopped.');
  finally
    StopLock.Free;
  end;
end.

echo "request: GET status"
curl -X GET -H "Content-Type: application/json" http://localhost:8888/api/status
echo "<<"

echo "request: GET echo"
curl -X GET -H "Content-Type: application/json" http://localhost:8888/api/echo
echo "<<"

echo "request: POST echo"
curl -X POST -H "Content-Type: application/json" -d '{"message": "hello from client"}' http://localhost:8888/api/echo
echo "<<"

echo "request: shutdown"
curl -X GET -H "Content-Type: application/json" http://localhost:8888/shutdown
echo "<<"