mormot.soa.codegen.pas

/// Interface-based SOA Code and Documentation Generator
// - this unit is a part of the Open Source Synopse mORMot framework 2,
// licensed under a MPL/GPL/LGPL three license - see LICENSE.md
unit mormot.soa.codegen;

{
  *****************************************************************************

   SOA API Code and Documentation Generation
    - ORM and SOA Logic Extraction from RTTI
    - Doc/CodeGen wrapper Functions on Server Side
    - FPC Dedicated Generators
    - Compute Asynchronous Code from Synchronous Interface
    - Generate Code and Doc from Command-Line

  *****************************************************************************
}

interface

{$I ..\mormot.defines.inc}

uses
  sysutils,
  classes,
  variants,
  {$ifdef ISDELPHI}
  typinfo, // for proper Delphi inlining
  {$endif ISDELPHI}
  mormot.core.base,
  mormot.core.os,
  mormot.core.buffers,
  mormot.core.unicode,
  mormot.core.text,
  mormot.core.variants,
  mormot.core.data,
  mormot.core.datetime,
  mormot.core.rtti,
  mormot.core.json,
  mormot.core.interfaces,
  mormot.core.mustache,
  mormot.orm.base,
  mormot.orm.core,
  mormot.orm.rest,
  mormot.soa.core,
  mormot.soa.server,
  mormot.rest.core,
  mormot.rest.server,
  mormot.rest.memserver;


{ ************ ORM and SOA Logic Extraction from RTTI }

/// compute the Model information, ready to be exported as JSON
// - will publish the ORM and SOA properties
// - to be used e.g. for client code generation via Mustache templates
// - optional aSourcePath parameter may be used to retrieve additional description
// from the comments of the source code of the unit - this text content may
// also be injected by WRAPPER_RESOURCENAME
// - you may specify a description file (as generated by FillDescriptionFromSource)
function ContextFromModel(aServer: TRestServer;
  const aSourcePath: TFileName = '';
  const aDescriptions: TFileName = ''): variant;


{ ************ Doc/CodeGen wrapper Functions on Server Side }

/// generate a code/doc wrapper for a given Model and Mustache template content
// - will use all ORM and SOA properties of the supplied server
// - aFileName will be transmitted as {{filename}}, e.g. 'mORMotClient'
// - you should also specify a "fake" HTTP port e.g. 888
// - the template content could be retrieved from a file via StringFromFile()
// - you may optionally retrieve a copy of the data context as TDocVariant
// - this function may be used to generate the client at build time, directly
// from a just built server, in an automated manner
// - you may specify custom helpers (e.g. via TSynMustache.HelpersGetStandardList)
// and retrieve the generated data context after generation (if aContext is
// a TDocVariant object, its fields would be added to the rendering context),
// or a custom description file (as generated by FillDescriptionFromSource)
function WrapperFromModel(aServer: TRestServer;
  const aMustacheTemplate, aFileName: RawUtf8; aPort: integer;
  aHelpers: TSynMustacheHelpers = nil;
  aContext: PVariant = nil;
  const aDescriptions: TFileName = ''): RawUtf8;

/// generate a code/doc wrapper for a given set of types and Mustache template content
// - will use aTables[] to define the ORM information, and supplied aSharedServices[]
// aSharedServicesContract[] for SOA definition of a shared API (expected to
// be called from TRestClientUri.ServiceDefineSharedApi)
// - aFileName will be transmitted as {{filename}}, e.g. 'mORMotClient'
// - you should also specify a "fake" HTTP port e.g. 888
// - the template content could be retrieved from a file via StringFromFile()
// - you may optionally retrieve a copy of the data context as TDocVariant
// - this function may be used to generate the client at build time, directly
// from a just built server, in an automated manner
// - you may specify custom helpers (e.g. via TSynMustache.HelpersGetStandardList)
// and retrieve the generated data context after generation (if aContext is
// a TDocVariant object, its fields would be added to the rendering context),
// or a custom description file (as generated by FillDescriptionFromSource)
function WrapperForPublicAPI(const aTables: array of TOrmClass;
  const aRoot, aMustacheTemplate, aFileName: RawUtf8;
  const aSharedServices: array of TGuid;
  const aSharedServicesContract: array of RawUtf8;
  aResultAsJsonObjectWithoutResult: boolean; aPort: integer;
  aHelpers: TSynMustacheHelpers = nil; aContext: PVariant = nil;
  const aDescriptions: TFileName = ''): RawUtf8;

/// instantiate a TRest server instance, including supplied ORM and SOA definitions
// - will use aTables[] to define the ORM information, and supplied aSharedServices[]
// aSharedServicesContract[] for SOA definition of a shared API, implemented as
// abstract classes using TInterfaceStub
// - as used e.g. by WrapperForPublicAPI() to generate some code/doc wrappers
function WrapperFakeServer(const aTables: array of TOrmClass;
  const aRoot: RawUtf8;
  const aSharedServices: array of TGuid;
  const aSharedServicesContract: array of RawUtf8;
  aResultAsJsonObjectWithoutResult: boolean): TRestServerFullMemory;

/// you can call this procedure within a method-based service allow
// code-generation of an ORM and SOA client from a web browser
// - you have to specify one or several client *.mustache file paths
// - the first path containing any *.mustache file will be used as templates
// - for instance:
// ! procedure TCustomServer.Wrapper(Ctxt: TRestServerUriContext);
// ! begin // search in the current path
// !   WrapperMethod(Ctxt,['.']);
// ! end;
// - optional SourcePath parameter may be used to retrieve additional description
// from the comments of the source code of the unit
// - you may specify a description file (as generated by FillDescriptionFromSource)
procedure WrapperMethod(Ctxt: TRestServerUriContext;
  const Path: array of TFileName;
  const SourcePath: TFileName = '';
  const Descriptions: TFileName = '');

/// you can call this procedure to add a 'Wrapper' method-based service
//  to a given server, to allow code-generation of an ORM and SOA client
// - you have to specify one or several client *.mustache file paths
// - the first path containing any *.mustache file will be used as templates
// - if no path is specified (i.e. as []), it will search in the .exe folder
// - the root/wrapper URI will be accessible without authentication (i.e.
// from any plain browser)
// - for instance:
// ! aServer := TRestServerFullMemory.Create(aModel,'test.json',false,true);
// ! AddToServerWrapperMethod(aServer,['..']);
// - optional SourcePath parameter may be used to retrieve additional description
// from the comments of the source code of the unit
procedure AddToServerWrapperMethod(Server: TRestServer;
  const Path: array of TFileName;
  const SourcePath: TFileName = '');


{ ************ FPC Dedicated Generators }

/// you can call this procedure to generate the mORMotServer.pas unit needed
// to compile a given server source code using FPC
// - will locate FPCServer-mORMotServer.pas.mustache in the given Path[] array
// - will write the unit using specified file name or to mORMotServer.pas in the
// current directory if DestFileName is '', or to a sub-folder of the matching
// Path[] if DestFileName starts with '\' (to allow relative folder use)
// - the missing RTTI for records and interfaces would be defined, together
// with some patch comments for published record support (if any) for the ORM
procedure ComputeFPCServerUnit(Server: TRestServer;
  const Path: array of TFileName; DestFileName: TFileName = '');

/// you can call this procedure to generate the mORMotInterfaces.pas unit needed
// to register all needed interface RTTI for FPC
// - to circumvent http://bugs.freepascal.org/view.php?id=26774 unresolved issue
// - will locate FPC-mORMotInterfaces.pas.mustache in the given Path[] array
// - will write the unit using specified file name or to mORMotInterfaces.pas in
// the current directory if DestFileName is '', or to a sub-folder of the
// matching Path[] if DestFileName starts with '\' (to allow relative folder use)
// - all used interfaces will be exported, including SOA and mocking/stubing
// types: so you may have to run this function AFTER all process is done
procedure ComputeFPCInterfacesUnit(const Path: array of TFileName;
  DestFileName: TFileName = '');


{ ************ Compute Asynchronous Code from Synchronous Interface }


/// this function would generate a pascal unit defining asynchronous
// (non-blocking) types from a DDD's blocking dual-phase Select/Command service
// - you should specify the services to be converted, as an array - note that
// due to how RTTI is stored by the compiler, all "pure input" parameters should
// be defined explicitly as "const", otherwise the generated class won't match
// - optionally, the TCQRSServiceClass implementing the first Select() phase of
// the blocking service may be specified in queries array; a set of unit names
// in which those TCQRSServiceClass are defined may be specified
// - a Mustache template content should be provided - e.g. asynch.pas.mustache
// as published in SQLite3\DDD\dom folder of the source code repository
// - FileName would contain the resulting unit filename (without the .pas)
// - ProjectName would be written in the main unit comment
// - CallType should be the type used at Domain level to identify each
// asynchronous call - this type should be an integer, or a function may be
// supplied as CallFunction (matching VariantToInteger signature)
// - the first phase of the service should have set Key: KeyType, which would be
// used to create a single shared asynchronous service instance for all keys
// - ExceptionType may be customize, mainly to use a Domain-specific class
// - blocking execution may reach some timeout waiting for the asynchronous
// acknowledgement: a default delay (in ms) is to be supplied, and some custom
// delays may be specified as trios, e.g. ['IMyInterface', 'Method', 10000, ...]
function GenerateAsynchServices(const services: array of TGuid;
  const queries: array of TClass;
  const units: array of const;
  const additionalcontext: array of const;
  Template, FileName, ProjectName, CallType, CallFunction,
  Key, KeyType, ExceptionType: RawUtf8;
  DefaultDelay: integer; const CustomDelays: array of const): RawUtf8;


{ ************ Generate Code and Doc from Command-Line }

type
  /// the options retrieved during a ExecuteFromCommandLine() call
  TServiceClientCommandLineOptions = set of (
    cloPrompt,
    cloNoColor,
    cloPipe,
    cloHeaders,
    cloVerbose,
    cloNoExpand,
    cloNoBody);

  /// event handler to let ExecuteFromCommandLine call a remote server
  // - before call, aParams.InBody will be set with the expected JSON content
  TOnCommandLineCall = procedure(aOptions: TServiceClientCommandLineOptions;
    const aService: TInterfaceFactory; aMethod: PInterfaceMethod;
    var aParams: TRestUriParams) of object;

const
  /// help information displayed by ExecuteFromCommandLine() with no command
  // - note that Windows and POSIX don't handle the double quotes similarly,
  // so putting JSON on the command line could be tricky and needs ' escaping
  EXECUTEFROMCOMMANDLINEHELP =
   ' % help  -> show all services (interfaces)'#13#10 +
   ' % [service] [help]  -> show all methods of a given service'#13#10 +
   ' % [service] [method] help -> show parameters of a given method'#13#10 +
   ' % [options] [service] [method] [parameters] -> call a given method ' +
   {$ifdef OSWINDOWS}
   'with [parameters] being name=value or name=""value with spaces"" or ' +
   'name:={""some"":""json""}' +
   ' and [options] as /nocolor /pipe /headers /verbose /noexpand /nobody';
   {$else}
   'with [parameters] being name=value or name=''"value with spaces"'' or ' +
   'name:=''{"some":"json"}''' +
   ' and [options] as --nocolor --pipe --headers --verbose --noexpand --nobody';
   {$endif OSWINDOWS}

/// command-line SOA remote access to mORMot interface-based services
// - supports the EXECUTEFROMCOMMANDLINEHELP commands
// - you shall have registered the aServices interface(s) by a previous call to
// the overloaded Get(TypeInfo(IMyInterface)) method or RegisterInterfaces()
// - you may specify an optional description file, as previously generated
// by mormot.soa.codegen.pas' FillDescriptionFromSource function - a local
// 'WrappersDescription' resource will also be checked
// - to actually call the remote server, aOnCall should be supplied
procedure ExecuteFromCommandLine(
  const aServices: array of TGuid;
  const aOnCall: TOnCommandLineCall;
  const aDescriptions: TFileName = '');



implementation

{ ************ ORM and SOA Logic Extraction from RTTI }

type
  /// a cross-platform published property kind
  // - does not match mormot.orm.core.pas TOrmFieldType: here we recognize only
  // types which may expect a special behavior in SynCrossPlatformREST.pas unit
  // - should match TOrmFieldKind order in SynCrossPlatformREST.pas
  TCrossPlatformOrmFieldKind = (
    cpkDefault,
    cpkDateTime,
    cpkTimeLog,
    cpkBlob,
    cpkModTime,
    cpkCreateTime,
    cpkRecord,
    cpkVariant);

const
  /// those text values should match TOrmFieldKind in SynCrossPlatformREST.pas
  // - was previously named sft* in mORMot 1.18
  CROSSPLATFORMKIND_TEXT: array[TCrossPlatformOrmFieldKind] of RawUtf8 = (
    'oftUnspecified',
    'oftDateTime',
    'oftTimeLog',
    'oftBlob',
    'oftModTime',
    'oftCreateTime',
    'oftRecord',
    'oftVariant');

const
  CROSSPLATFORM_KIND: array[TOrmFieldType] of TCrossPlatformOrmFieldKind =(
    cpkDefault,    // oftUnknown
    cpkDefault,    // oftAnsiText
    cpkDefault,    // oftUtf8Text
    cpkDefault,    // oftEnumerate
    cpkDefault,    // oftSet
    cpkDefault,    // oftInteger
    cpkDefault,    // oftID
    cpkDefault,    // oftRecord
    cpkDefault,    // oftBoolean
    cpkDefault,    // oftFloat
    cpkDateTime,   // oftDateTime
    cpkTimeLog,    // oftTimeLog
    cpkDefault,    // oftCurrency
    cpkDefault,    // oftObject
    cpkVariant,    // oftVariant
    cpkVariant,    // oftNullable
    cpkBlob,       // oftBlob
    cpkDefault,    // oftBlobDynArray
    cpkDefault,    // oftBlobCustom
    cpkRecord,     // oftUtf8Custom
    cpkDefault,    // oftMany
    cpkModTime,    // oftModTime
    cpkCreateTime, // oftCreateTime
    cpkDefault,    // oftTID
    cpkDefault,    // oftRecordVersion
    cpkDefault,    // oftSessionUserID
    cpkDateTime,   // oftDateTimeMS
    cpkDefault,    // oftUnixTime
    cpkDefault);   // oftUnixMSTime

  TYPES_ORM: array[TOrmFieldType] of TWrapperType = (
    wUnknown,        // oftUnknown
    wString,         // oftAnsiText
    wRawUtf8,        // oftUtf8Text
    wEnum,           // oftEnumerate
    wSet,            // oftSet
    wUnknown,        // oftInteger - wUnknown to force exact type
    wORM,            // oftID
    wReference,      // oftRecord
    wBoolean,        // oftBoolean
    wUnknown,        // oftFloat - wUnknown to force exact type
    wDateTime,       // oftDateTime
    wTimeLog,        // oftTimeLog
    wCurrency,       // oftCurrency
    wObject,         // oftObject
    wVariant,        // oftVariant
    wVariant,        // oftNullable
    wBlob,           // oftBlob
    wArray,          // oftBlobDynArray - with specific code below
    wRecord,         // oftBlobCustom
    wRecord,         // oftUtf8Custom
    wUnknown,        // oftMany
    wModTime,        // oftModTime
    wCreateTime,     // oftCreateTime
    wID,             // oftID
    wRecordVersion,  // oftRecordVersion
    wID,             // oftSessionUserID
    wDateTime,       // oftDateTimeMS
    wUnknown,        // oftUnixTime
    wUnknown);       // oftUnixMSTime

type
  TWrapperContextRest = class(TWrapperContext)
  protected
    fServer: TRestServer;
    fHasAnyRecord: boolean; // identify TOrmPropInfoRecordTyped
    function CustomType(rtti: TRttiCustom): TWrapperType; override;
  public
    constructor CreateFromModel(aServer: TRestServer;
      const aSourcePath: TFileName; const aDescriptions: TFileName);
    function Context: variant; override;
  end;


{ TWrapperContextRest }

constructor TWrapperContextRest.CreateFromModel(aServer: TRestServer;
  const aSourcePath, aDescriptions: TFileName);
var
  t, f, s: PtrInt;
  nfoList: TOrmPropInfoList;
  nfo: TOrmPropInfo;
  nfoOrmFieldRttiTypeName: RawUtf8;
  kind: TCrossPlatformOrmFieldKind;
  hasRecord: boolean;
  fields, services: TDocVariantData;
  field, rec: variant;
  srv: TServiceFactoryServer;
  uri: RawUtf8;
begin
  Create(aSourcePath, aDescriptions);
  fServer := aServer;
  TDocVariant.NewFast([
    @fields,
    @services]);
  // compute ORM information
  for t := 0 to fServer.Model.TablesMax do
  begin
    nfoList := fServer.Model.TableProps[t].Props.Fields;
    fields.Clear;
    fields.Init;
    hasRecord := false;
    for f := 0 to nfoList.Count - 1 do
    begin
      nfo := nfoList.List[f];
      nfoOrmFieldRttiTypeName := nfo.SqlFieldRttiTypeName;
      if nfo.InheritsFrom(TOrmPropInfoRtti) then
        field := ContextFromRtti(TYPES_ORM[nfo.OrmFieldType],
          TOrmPropInfoRtti(nfo).PropRtti, nfoOrmFieldRttiTypeName)
      else if nfo.InheritsFrom(TOrmPropInfoRecordTyped) then
      begin
        hasRecord := true;
        fHasAnyRecord := true;
        field := ContextFromRtti(wRecord,
          Rtti.RegisterType(TOrmPropInfoRecordTyped(nfo).TypeInfo),
          nfoOrmFieldRttiTypeName);
      end
      else
        EWrapperContext.RaiseUtf8('Unexpected type % for %.%',
          [nfo, fServer.Model.Tables[t], nfo.Name]);
      kind := CROSSPLATFORM_KIND[nfo.OrmFieldType];
      _ObjAddProps(['index',        f + 1,
                    'name',         nfo.Name,
                    'camelName',    LowerCamelCase(nfo.Name),
                    'snakeName',    SnakeCase(nfo.Name),
                    'sql',          ord(nfo.OrmFieldType),
                    'sqlName',      nfo.OrmFieldTypeName^,
                    'typeKind',     ord(kind),
                    'typeKindName', CROSSPLATFORMKIND_TEXT[kind],
                    'attr',         byte(nfo.Attributes)], field);
      if aIsUnique in nfo.Attributes then
        _ObjAddProp('unique', true, field);
      if nfo.FieldWidth > 0 then
        _ObjAddProp('width', nfo.FieldWidth, field);
      if f < nfoList.Count - 1 then
        _ObjAddPropU('comma', ',', field)
      else
        // may conflict with rec.comma otherwise
        _ObjAddProp('comma', null, field);
      fields.AddItem(field);
    end;
    with fServer.Model.TableProps[t] do
      rec := _JsonFastFmt('{tableName:?,className:?,classParent:?,' +
        'fields:?,isInMormotPas:%,unitName:?,comma:%}',
        [NULL_OR_TRUE[(Props.Table = TAuthGroup) or
         (Props.Table = TAuthUser)],
         NULL_OR_COMMA[t < fServer.Model.TablesMax]],
         [Props.SqlTableName, ClassNameShort(Props.Table)^,
          ClassNameShort(Props.Table.ClassParent)^,
          Variant(fields),
          Props.TableRtti.Info.RttiClass^.UnitName]);
    if hasRecord then
      rec.hasRecords := true;
    fORM.AddItem(rec);
  end;
  // compute SOA information
  if fServer.Services.Count > 0 then
  begin
    for s := 0 to fServer.Services.Count - 1 do
    begin
      srv := fServer.Services.Index(s) as TServiceFactoryServer;
      if fServer.Services.ExpectMangledUri then
        uri := srv.InterfaceMangledUri
      else
        uri := srv.InterfaceUri;
      with srv do
        rec := _ObjFast([
          'uri', uri,
          'interfaceUri',         InterfaceUri,
          'interfaceMangledUri',  InterfaceMangledUri,
          'interfaceName',        InterfaceFactory.InterfaceRtti.Name,
          'camelName',            LowerCamelCase(InterfaceFactory.InterfaceUri),
          'snakeName',            SnakeCase(InterfaceFactory.InterfaceUri),
          'GUID',                 GuidToRawUtf8(InterfaceFactory.InterfaceGuid^),
          'contractExpected',     UnQuoteSqlString(ContractExpected),
          'instanceCreation',     ord(InstanceCreation),
          'instanceCreationName', GetEnumNameTrimed(
            TypeInfo(TServiceInstanceImplementation), ord(InstanceCreation)),
          'methods',              ContextFromMethods(InterfaceFactory),
          'bypassAuthentication', ByPassAuthentication,
          'resultAsJsonObject',   ResultAsJsonObject,
          'resultAsJsonObjectWithoutResult',
            ResultAsJsonObjectWithoutResult and
            (InstanceCreation in SERVICE_IMPLEMENTATION_NOID),
          'resultAsXMLObject',    ResultAsXMLObject,
          'timeoutSec',           TimeoutSec,
          'serviceDescription',
            fDescriptions.GetValueOrNull(InterfaceFactory.InterfaceName)
        ]);
      if srv.InstanceCreation = sicClientDriven then
        rec.isClientDriven := true;
      services.AddItem(rec);
    end;
    fSOA.InitObject(['enabled',          true,
                     'services',         variant(services),
                     'expectMangledUri', fServer.Services.ExpectMangledUri], JSON_FAST);
  end;
end;

function TWrapperContextRest.CustomType(rtti: TRttiCustom): TWrapperType;
begin
  result := TYPES_ORM[GetOrmFieldType(rtti.Info)];
end;

function TWrapperContextRest.Context: variant;
var
  s: PtrInt;
  authClass: TClass;
begin
  result := inherited Context;
  // append TRestServer specific information
  if fServer = nil then
    exit;
  if fHasAnyRecord then
    _ObjAddProp('ORMWithRecords', true, result);
  // add the first supported authentication class type as default
  for s := 0 to fServer.AuthenticationSchemesCount - 1 do
  begin
    authClass := PClass(fServer.AuthenticationSchemes[s])^;
    if (authClass = TRestServerAuthenticationDefault) or
       (authClass = TRestServerAuthenticationNone) then
    begin
      _ObjAddProp('authClass', ToText(authClass), result);
      break;
    end;
  end;
end;


function ContextFromModel(aServer: TRestServer;
  const aSourcePath, aDescriptions: TFileName): variant;
begin
  with TWrapperContextRest.CreateFromModel(aServer, aSourcePath, aDescriptions) do
  try
    result := Context;
  finally
    Free;
  end;
end;


{ ************ Doc/CodeGen wrapper Functions on Server Side }

procedure WrapperMethod(Ctxt: TRestServerUriContext;
  const Path: array of TFileName; const SourcePath, Descriptions: TFileName);
var
  root, templateName, templateTitle, savedName,
  templateExt, unitName, template, result, host, uri, head: RawUtf8;
  context: variant;
  SR: TSearchRec;
  i, templateFound, port: PtrInt;
begin
  // URI is e.g. GET http://localhost:888/root/wrapper/Delphi/UnitName.pas
  if (Ctxt.Method <> mGET) or
     (high(Path) < 0) then
    exit;
  templateFound := -1;
  for i := 0 to high(Path) do
    if FindFirst(MakePath([Path[i], '*.mustache']), faAnyFile, SR) = 0 then
    begin
      templateFound := i;
      break;
    end;
  if templateFound < 0 then
    Ctxt.Error(
      'Please copy some .mustache files in the expected folder (e.g. %)',
      [Path[0]])
  else
  try
    context := ContextFromModel(Ctxt.Server, SourcePath, Descriptions);
    context.uri := Ctxt.UriWithoutSignature;
    if llfHttps in Ctxt.Call^.LowLevelConnectionFlags then
      _ObjAddProps(['protocol', 'https',
                    'https',    true], context)
    else
      _ObjAddPropU('protocol', 'http', context);
    host := Ctxt.InHeader['host'];
    if host <> '' then
      _ObjAddPropU('host', host, context);
    port := GetInteger(pointer(split(host, ':', host)));
    if port = 0 then
      port := 80;
    _ObjAddProp('port', port, context);
    if PropNameEquals(Ctxt.UriMethodPath, 'context') then
    begin
      Ctxt.ReturnsJson(context, 200, {304=}true, twNone, {humanreadable=}true);
      exit;
    end;
    root := Ctxt.Server.Model.Root;
    if Ctxt.UriMethodPath = '' then
    begin
      result := '<!DOCTYPE html><html><title>mORMot Wrappers</title>' +
        '<body style="font-family:verdana;"><h1>Generated Code/Doc Wrappers</h1>' +
        '<hr><h2>Available Templates:</h2><ul>';
      repeat
        Split(StringToUtf8(SR.Name), '.', templateName, templateExt);
        templateTitle := templateName;
        i := PosExChar('-', templateName);
        if i > 0 then
        begin
          SetLength(templateTitle, i - 1);
          savedName := copy(templateName, i + 1, maxInt);
        end
        else
          savedName := 'mORMotClient';
        Split(templateExt, '.', templateExt);
        uri := FormatUtf8('<a href=/%/wrapper/%/%.%',
          [root, templateName, savedName, templateExt]);
        result := FormatUtf8(
          '%<li><b>%</b><br><i>%.%</i>  -  %>download as file</a>  -  ' +
          '%.txt>see as text</a> - %.mustache>see template</a></li><br>',
          [result, templateTitle, savedName, templateExt, uri, uri, uri]);
      until FindNext(SR) <> 0;
      result := FormatUtf8('%</ul><p>You can also retrieve the corresponding ' +
        '<a href=/%/wrapper/context>template context</a>.<hr><p>Generated by a ' +
        '<a href=http://mormot.net>Synopse <i>mORMot</i> ' +
        SYNOPSE_FRAMEWORK_VERSION + '</a> server.', [result, root]);
      Ctxt.Returns(result, HTTP_SUCCESS, HTML_CONTENT_TYPE_HEADER);
      exit;
    end;
  finally
    FindClose(SR);
  end;
  Split(Ctxt.UriMethodPath, '/', templateName, unitName);
  Split(unitName, '.', unitName, templateExt);
  if PosExChar('.', templateExt) > 0 then
  begin
    // see as text
    if PropNameEquals(Split(templateExt, '.', templateExt), 'mustache') then
      // force return .mustache
      unitName := '';
    head := TEXT_CONTENT_TYPE_HEADER;
  end
  else
    // download as file
    head := HEADER_CONTENT_TYPE + 'application/' + LowerCase(templateExt);
  templateName := templateName + '.' + templateExt + '.mustache';
  template := RawUtf8FromFile(MakePath([Path[templateFound], templateName]));
  if template = '' then
  begin
    Ctxt.Error(templateName, HTTP_NOTFOUND);
    exit;
  end;
  if unitName = '' then
    result := template // asked for .mustache template
  else
  begin
    _ObjAddProps(['templateName', templateName,
                  'filename',     unitName], context);
    result := TSynMustache.Parse(template).Render(
      context, nil, TSynMustache.HelpersGetStandardList, nil, true);
  end;
  Ctxt.Returns(result, HTTP_SUCCESS, head);
end;

function WrapperFromModel(aServer: TRestServer;
  const aMustacheTemplate, aFileName: RawUtf8; aPort: integer;
  aHelpers: TSynMustacheHelpers; aContext: PVariant;
  const aDescriptions: TFileName): RawUtf8;
var
  context: variant;
begin
  // no context.uri nor context.host here
  context := ContextFromModel(aServer, '', aDescriptions);
  with _Safe(context)^ do
  begin
    if aPort <> 0 then
      i['port'] := aPort;
    U['filename'] := aFileName;
    if aContext <> nil then
    begin
      AddFrom(aContext^);
      aContext^ := context;
    end;
  end;
  if aHelpers = nil then
    aHelpers := TSynMustache.HelpersGetStandardList;
  result := TSynMustache.Parse(aMustacheTemplate).Render(
    context, nil, aHelpers, nil, true);
end;

function WrapperFakeServer(const aTables: array of TOrmClass;
  const aRoot: RawUtf8; const aSharedServices: array of TGuid;
  const aSharedServicesContract: array of RawUtf8;
  aResultAsJsonObjectWithoutResult: boolean): TRestServerFullMemory;
var
  contract: RawUtf8;
  fake: IInterface;
  i: PtrInt;
begin
  result := TRestServerFullMemory.CreateWithOwnModel(aTables, false, aRoot);
  for i := 0 to high(aSharedServices) do
  begin
    if i <= high(aSharedServicesContract) then
      contract := aSharedServicesContract[i]
    else
      contract := '';
    result.ServiceDefine(
       TInterfaceStub.Create(aSharedServices[i], fake).LastInterfacedObjectFake,
       [aSharedServices[i]], contract).
      ResultAsJsonObjectWithoutResult := aResultAsJsonObjectWithoutResult;
  end;
end;

function WrapperForPublicAPI(const aTables: array of TOrmClass;
  const aRoot, aMustacheTemplate, aFileName: RawUtf8;
  const aSharedServices: array of TGuid;
  const aSharedServicesContract: array of RawUtf8;
  aResultAsJsonObjectWithoutResult: boolean; aPort: integer;
  aHelpers: TSynMustacheHelpers; aContext: PVariant;
  const aDescriptions: TFileName): RawUtf8;
var
  server: TRestServer;
begin
  server := WrapperFakeServer(aTables, aRoot, aSharedServices,
    aSharedServicesContract, aResultAsJsonObjectWithoutResult);
  try
    result := WrapperFromModel(server, aMustacheTemplate, aFileName, aPort,
      aHelpers, aContext, aDescriptions);
  finally
    server.Free;
  end;
end;


{ TWrapperMethodHook }

type
  TWrapperMethodHook = class(TPersistent)
  public
    SearchPath: TFileNameDynArray;
    SourcePath: TFileName;
  published
    procedure Wrapper(Ctxt: TRestServerUriContext);
  end;

procedure TWrapperMethodHook.Wrapper(Ctxt: TRestServerUriContext);
begin
  WrapperMethod(Ctxt, SearchPath, SourcePath);
end;

procedure ComputeSearchPath(const Path: array of TFileName;
  out SearchPath: TFileNameDynArray);
var
  i: PtrInt;
begin
  if length(Path) = 0 then
  begin
    // use .exe path
    SetLength(SearchPath, 1);
    SearchPath[0] := Executable.ProgramFilePath;
  end
  else
  begin
    SetLength(SearchPath, length(Path));
    for i := 0 to high(Path) do
      // also convert \ if needed on FPC
      SearchPath[i] := ExpandFileName(Path[i]);
  end;
end;

procedure AddToServerWrapperMethod(Server: TRestServer;
  const Path: array of TFileName; const SourcePath: TFileName);
var
  hook: TWrapperMethodHook;
begin
  if Server = nil then
    exit;
  hook := TWrapperMethodHook.Create;
  Server.PrivateGarbageCollector.Add(hook); // Server.Free will call hook.Free
  ComputeSearchPath(Path, hook.SearchPath);
  hook.SourcePath := SourcePath;
  Server.ServiceMethodRegisterPublishedMethods('', hook);
  Server.ServiceMethodByPassAuthentication('wrapper');
end;

function FindTemplate(const TemplateName: TFileName;
  const Path: array of TFileName): TFileName;
var
  SearchPath: TFileNameDynArray;
  i: PtrInt;
begin
  ComputeSearchPath(Path, SearchPath);
  for i := 0 to High(SearchPath) do
  begin
    result := MakePath([SearchPath[i], TemplateName]);
    if FileExists(result) then
      exit;
  end;
  result := '';
end;


{ ************ FPC Dedicated Generators }

procedure ComputeFPCServerUnit(Server: TRestServer;
  const Path: array of TFileName; DestFileName: TFileName);
var
  TemplateName: TFileName;
begin
  TemplateName := FindTemplate('FPCServer-mORMotServer.pas.mustache', Path);
  if TemplateName = '' then
    exit;
  if DestFileName = '' then
    DestFileName := 'mORMotServer.pas'
  else if DestFileName[1] = PathDelim then
    DestFileName := ExtractFilePath(TemplateName) + DestFileName;
  FileFromString(WrapperFromModel(Server, RawUtf8FromFile(TemplateName),
    StringToUtf8(ExtractFileName(DestFileName)), 0), DestFileName);
end;

procedure ComputeFPCInterfacesUnit(const Path: array of TFileName;
  DestFileName: TFileName);
const
  TEMPLATE_NAME = 'FPC-mORMotInterfaces.pas.mustache';
var
  TemplateName: TFileName;
  ctxt: variant;
begin
  TemplateName := FindTemplate(TEMPLATE_NAME, Path);
  if TemplateName = '' then
    exit;
  if DestFileName = '' then
    DestFileName := 'mORMotInterfaces.pas'
  else if DestFileName[1] = PathDelim then
    DestFileName := ExtractFilePath(TemplateName) + DestFileName;
  with TWrapperContext.CreateFromUsedInterfaces('', '') do
  try
    ctxt := context;
  finally
    Free;
  end;
  ctxt.fileName := GetFileNameWithoutExtOrPath(DestFileName);
  FileFromString(TSynMustache.Parse(RawUtf8FromFile(TemplateName)).
    Render(ctxt, nil, nil, nil, true), DestFileName);
end;


{ ************ Compute Asynchronous Code from Synchronous Interface }

{$ifdef ISDELPHI20062007}
  {$WARNINGS OFF} // circumvent Delphi 2007 false positive warning
{$endif}

function GenerateAsynchServices(const services: array of TGuid;
  const queries: array of TClass; const units: array of const;
  const additionalcontext: array of const;
  Template, FileName, ProjectName, CallType, CallFunction, Key,
  KeyType, ExceptionType: RawUtf8;
  DefaultDelay: integer; const CustomDelays: array of const): RawUtf8;
var
  server: TRestServerFullMemory;
  stub: IInvokable;
  context: variant;
  service, method: PDocVariantData;
  pas, intf, meth: RawUtf8;
  delay: Int64;
  i: PtrInt;
begin
  result := '';
  if high(services) < 0 then
    exit;
  if FileName = '' then
    FileName := 'ServicesAsynch';
  if CallType = '' then
    CallType := 'TBlockingProcessPoolCall';
  if ExceptionType = '' then
    ExceptionType := 'EServiceException';
  server := TRestServerFullMemory.CreateWithOwnModel([]);
  try
    for i := 0 to high(services) do
      server.ServiceDefine(
        TInterfaceStub.Create(services[i], stub).LastInterfacedObjectFake,
        [services[i]]);
    context := ContextFromModel(server);
    _ObjAddProps([
      'filename',     FileName,
      'projectname',  ProjectName,
      'exeName',      Executable.ProgramName,
      'User',         Executable.User,
      'calltype',     CallType,
      'callfunction', CallFunction,
      'exception',    ExceptionType,
      'defaultdelay', DefaultDelay], context);
    if high(units) >= 0 then
      _Safe(context)^.O['units']^.AddItems(units);
    if Key <> '' then
      _ObjAddProps(['asynchkey',     Key,
                    'asynchkeytype', KeyType], context);
    _ObjAddProps(additionalcontext, context);
    for i := 0 to high(services) do
      if i < length(queries) then
      begin
        intf := ToUtf8(TInterfaceFactory.Guid2TypeInfo(services[i])^.RawName);
        if _Safe(context.soa.services)^.
            GetDocVariantByProp('interfaceName', intf, false, service) then
          service^.AddValue('query', ClassNameShort(queries[i])^)
        else
          EWrapperContext.RaiseUtf8('CustomDelays: unknown %', [intf]);
      end;
    i := 0;
    while i + 2 <= high(CustomDelays) do
    begin
      if VarRecToUtf8IsString(CustomDelays[i], intf) and
         VarRecToUtf8IsString(CustomDelays[i + 1], meth) and
         VarRecToInt64(@CustomDelays[i + 2], delay) then
        if _Safe(context.soa.services)^.
            GetDocVariantByProp('interfaceName', intf, false, service) and
           service^.GetAsDocVariantSafe('methods')^.
             GetDocVariantByProp('methodName', meth, false, method) then
          method^.I['asynchdelay'] := delay
        else
          EWrapperContext.RaiseUtf8('CustomDelays: unknown %.%', [intf, meth]);
      inc(i, 3);
    end;
    pas := TSynMustache.Parse(Template).
      Render(context, nil, TSynMustache.HelpersGetStandardList);
    result := StringReplaceAll(pas, ['();', ';', '():', ':']);
//FileFromString(_Safe(context)^.ToJson('','',jsonUnquotedPropName),FileName+'.json');
  finally
    server.Free;
  end;
end;

{$ifdef ISDELPHI20062007}
  {$WARNINGS ON} // circumvent Delphi 2007 false positive warning
{$endif}


{ ************ Generate Code and Doc from Command-Line }

{ TServiceClientCommandLine }

type
  /// a class implementing ExecuteFromCommandLine()
  TServiceClientCommandLine = class(TSynPersistent)
  protected
    fExe: RawUtf8;
    fOptions: TServiceClientCommandLineOptions;
    fServices: array of TInterfaceFactory;
    fDescriptions: TDocVariantData;
    fOnCall: TOnCommandLineCall;
    procedure ToConsole(const Fmt: RawUtf8; const Args: array of const;
      Color: TConsoleColor = ccLightGray; NoLineFeed: boolean = false);
    function Find(const name: RawUtf8; out service: TInterfaceFactory): boolean;
    procedure WriteDescription(desc: RawUtf8; color: TConsoleColor;
      firstline: boolean);
    procedure ShowHelp;
    procedure ShowAllServices;
    procedure ShowService(service: TInterfaceFactory);
    procedure ShowMethod(service: TInterfaceFactory; method: PInterfaceMethod);
    procedure ExecuteMethod(service: TInterfaceFactory;
      method: PInterfaceMethod; firstparam: integer);
  public
    constructor Create(const aServices: array of TGuid;
      const aOnCall: TOnCommandLineCall;
      const aDescriptions: TFileName); reintroduce;
    procedure Execute;
  end;

procedure TServiceClientCommandLine.ToConsole(const Fmt: RawUtf8;
  const Args: array of const; Color: TConsoleColor; NoLineFeed: boolean);
var
  txt: RawUtf8;
begin
  FormatUtf8(Fmt, Args, txt);
  ConsoleWrite(txt, Color, NoLineFeed, cloNoColor in fOptions);
end;

function TServiceClientCommandLine.Find(const name: RawUtf8;
  out service: TInterfaceFactory): boolean;
var
  s: PtrInt;
begin
  for s := 0 to high(fServices) do
    if IdemPropNameU(fServices[s].InterfaceUri, name) then // good FPC inlining
    begin
      service := fServices[s];
      result := true;
      exit;
    end;
  result := false;
end;

procedure TServiceClientCommandLine.WriteDescription(desc: RawUtf8;
  color: TConsoleColor; firstline: boolean);
var
  line: RawUtf8;
  P: PUtf8Char;
  i, j, k, l: PtrInt;
begin
  if not (cloNoColor in fOptions) then
    TextColor(color);
  if firstline then
    SetLength(desc, PosExChar(#13, desc) - 1);
  if desc = '' then
    exit;
  P := pointer(desc);
  repeat
    line := GetNextLine(P, P);
    if line = '' then
      continue;
    if line = '----' then
    begin
      if not (cloNoColor in fOptions) then
        TextColor(ccBrown);
    end
    else
    begin
      line := StringReplaceAll(line, ['`', '', '<<', '', '>>', '']);
      i := 1;
      repeat
        j := PosEx('[', line, i);
        if j = 0 then
          break;
        k := PosEx('](', line, j + 1);
        if k = 0 then
          break;
        l := PosEx(')', line, k + 2);
        if l = 0 then
          break;
        delete(line, k, l - k + 1);
        delete(line, j, 1);
        i := k;
      until false;
      ConsoleWriteRaw(line);
    end;
  until P = nil;
end;

procedure TServiceClientCommandLine.ShowHelp;
begin
  ToConsole('% %'#13#10, [fExe, Executable.Version.DetailedOrVoid], ccLightGreen);
  ToConsole(EXECUTEFROMCOMMANDLINEHELP, [fExe, fExe, fExe, fExe]);
end;

procedure TServiceClientCommandLine.ShowAllServices;
var
  i: PtrInt;
begin
  for i := 0 to high(fServices) do
  begin
    ToConsole('% %', [fExe, fServices[i].InterfaceUri], ccWhite);
    WriteDescription(
      fDescriptions.U[fServices[i].interfaceName], ccLightGray, true);
  end;
end;

procedure TServiceClientCommandLine.ShowService(service: TInterfaceFactory);
var
  m: PtrInt;
begin
  ToConsole('% %', [fExe, service.InterfaceUri], ccWhite);
  WriteDescription(fDescriptions.U[service.InterfaceName], ccLightGray, false);
  for m := 0 to service.MethodsCount - 1 do
    with service.Methods[m] do
    begin
      ToConsole('% % % [parameters]',
        [fExe, service.InterfaceUri, uri], ccWhite);
      WriteDescription(
        fDescriptions.U[InterfaceDotMethodName], ccLightGray, true);
    end;
end;

procedure TServiceClientCommandLine.ShowMethod(service: TInterfaceFactory;
  method: PInterfaceMethod);

  procedure Arguments(input: boolean);
  const
    IN_OUT: array[boolean] of RawUtf8 = ('OUT', ' IN');
  var
    arg: integer; // should be integer, not PtrInt
    i: PtrInt;
    line, typ: RawUtf8;
  begin
    ToConsole('%', [IN_OUT[input]], ccDarkGray, {nolinefeed=}true);
    if (not input) and
       (imfResultIsServiceCustomAnswer in method^.Flags) then
      line := ' is undefined'
    else
    begin
      line := ' { ';
      arg := 0;
      while method^.ArgNext(arg, input) do
        with method^.Args[arg] do
        begin
          typ := TYPES_LANG[lngCS, TYPES_SOA[ValueType]];
          if typ = '' then
            typ := ArgRtti.Name;
          Append(line, ['"', ParamName^, '":', typ, ', ']);
        end;
      i := length(line);
      line[i - 1] := ' ';
      line[i] := '}';
    end;
    ToConsole('%', [line], ccDarkGray);
  end;

begin
  ToConsole('% % % [parameters]',
    [fExe, service.InterfaceUri, method.Uri], ccWhite);
  WriteDescription(
    fDescriptions.U[method.InterfaceDotMethodName], ccLightGray, false);
  if method.ArgsInputValuesCount <> 0 then
    Arguments({input=}true);
  if method.ArgsOutputValuesCount <> 0 then
    Arguments({input=}false);
end;

procedure TServiceClientCommandLine.ExecuteMethod(service: TInterfaceFactory;
  method: PInterfaceMethod; firstparam: integer);
var
  params, result: RawUtf8;
  i: PtrInt;
  cc: TConsoleColor;
  call: TRestUriParams;
begin
  // prepare the input parameters
  call.Init;
  if cloPipe in fOptions then
    call.InBody := ConsoleReadBody
  else
  begin
    for i := firstparam to ParamCount do
      Append(params, [' ', ParamStr(i)]);
    //writeln(params); // for debugging
    call.InBody := method^.ArgsCommandLineToObject(
      pointer(params), {input=}true, {raiseexcep=}true);
  end;
  // writeln(call.InBody); exit;
  if [cloVerbose, cloHeaders] * fOptions <> [] then
    ToConsole('POST %', [method.InterfaceDotMethodName], ccLightGray);
  if cloVerbose in fOptions then
    ToConsole('%', [call.InBody], ccLightBlue);
  // execute the OnCall event handler to actually run the process
  if not Assigned(fOnCall) then
    EServiceException.RaiseUtf8(
      'No Client available to call %', [method.InterfaceDotMethodName]);
  fOnCall(fOptions, service, method, call); // will set URI + Bearer
  // send output to Console
  if [cloVerbose, cloHeaders] * fOptions <> [] then
    ToConsole('HTTP %'#13#10'%', [call.OutStatus, call.OutHead], ccLightGray);
  if (call.OutBody <> '') and
     (call.OutBody[1] = '[') then
    call.OutBody := method^.ArgsArrayToObject(pointer(call.OutBody), false);
  if cloNoBody in fOptions then
    Make([length(call.OutBody), ' bytes received'], result)
  else if (cloNoExpand in fOptions) or
          not call.OutBodyTypeIsJson then
    result := call.OutBody
  else
    JsonBufferReformat(pointer(call.OutBody), result);
  cc := ccWhite;
  if not StatusCodeIsSuccess(call.OutStatus) then
    cc := ccLightRed;
  ToConsole('%', [result], cc, {nofeed=}true);
end;

constructor TServiceClientCommandLine.Create(const aServices: array of TGuid;
  const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName);
var
  desc: RawByteString;
  n, s, i: PtrInt;
begin
  inherited Create; // may have been overriden
  fExe := {$ifdef OSPOSIX} './' + {$endif} Executable.ProgramName;
  n := length(aServices);
  SetLength(fServices, n);
  s := 0;
  for i := 0 to n - 1 do
  begin
    fServices[s] := TInterfaceFactory.Get(aServices[i]);
    if fServices[s] <> nil then
      inc(s);
  end;
  if s = 0 then
    raise EServiceException.Create(
      'ExecuteFromCommandLine: no service - did you call RegisterInterfaces()?');
  if s <> n then
    SetLength(fServices, s);
  fOnCall := aOnCall;
  TDocVariant.NewFast([@fDescriptions]);
  if aDescriptions <> '' then
    desc := StringFromFile(aDescriptions);
  if {%H-}desc = '' then
    ResourceSynLZToRawByteString(WRAPPER_RESOURCENAME, desc);
  if desc <> '' then
    fDescriptions.InitJsonInPlace(pointer(desc), JSON_FAST);
end;

procedure TServiceClientCommandLine.Execute;
var
  p: array[0..3] of RawUtf8;
  a: PUtf8Char;
  i, j, n, first: PtrInt;
  s: TInterfaceFactory;
  m: PInterfaceMethod;
begin
  first := 3;
  n := 0;
  for i := 1 to ParamCount do
  begin
    StringToUtf8(ParamStr(i), {%H-}p[n]);
    a := pointer(p[n]);
    if a^ in ['-', '/'] then
    begin
      inc(a);
      if a^ = '-' then
        inc(a);
      j := PRttiInfo(TypeInfo(TServiceClientCommandLineOptions))^.
             SetEnumType^.GetEnumNameTrimedValue(a);
      if j >= 0 then
      begin
        SetBitPtr(@fOptions, j);
        if n < high(p) then
          inc(first);
        continue;
      end;
      EServiceException.RaiseUtf8(
        '%.Execute: unknown option [%]', [self, p[n]]);
    end;
    if n < high(p) then
      inc(n);
  end;
  case n of
    0:
      ShowHelp;
    1:
      if Find(p[0], s) then
        ShowService(s)
      else
        ShowAllServices;
  else
    if Find(p[0], s) then
    begin
      m := s.FindMethod(p[1]);
      if m = nil then
        ShowService(s)
      else if PropNameEquals(p[2], 'help') or
              ((m^.ArgsInputValuesCount <> 0) and
               (PosExChar('=', p[2]) = 0)) then
        ShowMethod(s, m)
      else
        ExecuteMethod(s, m, first);
    end
    else
      ShowAllServices;
  end;
  ToConsole('', [], ccDarkGray);
end;


procedure ExecuteFromCommandLine(const aServices: array of TGuid;
  const aOnCall: TOnCommandLineCall; const aDescriptions: TFileName);
begin
  with TServiceClientCommandLine.Create(aServices, aOnCall, aDescriptions) do
  try
    try
      Execute;
    except
      on E: Exception do
        ConsoleShowFatalException(E, {waitforkey=}false);
    end;
  finally
    Free;
  end;
end;


end.