{ *********** Implements User Aggregate CQRS Repository via mORMot's RESTful ORM }

type
  /// implements a User CQRS Repository via mORMot's RESTful ORM
  // - this class will use a supplied TSQLRest instance to persist TUser
  // Aggregate Roots, following the IDomUserCommand CQRS methods
  // - each TUser aggregate will be mapped into a TSQLRecordUser ORM table
  TInfraRepoUser = class(TDDDRepositoryRestCommand,IDomUserCommand)
  public
    function SelectByLogonName(const aLogonName: RawUTF8): TCQRSResult;
    function SelectByEmailValidation(aValidationState: TDomUserEmailValidation): TCQRSResult;
    function SelectByLastName(const aName: TLastName; aStartWith: boolean): TCQRSResult;
    function Get(out aAggregate: TUser): TCQRSResult;
    function GetAll(out aAggregates: TUserObjArray): TCQRSResult;
    function GetNext(out aAggregate: TUser): TCQRSResult;
................................................................................
begin
  inherited Create(IDomUserCommand,TInfraRepoUser,TUser,aRest,TSQLRecordUser,aOwner);
  AddFilterOrValidate(['*'],TSynFilterTrim.Create);
  AddFilterOrValidate(['LogonName'],TSynValidateNonVoidText.Create);
end;

class procedure TInfraRepoUserFactory.RegressionTests(test: TSynTestCase);
var Command: TDDDRepositoryRestFactory;
procedure TestOne;
const MAX=1000;
      MOD_EMAILVALID=ord(high(TDomUserEmailValidation))+1;
var cmd: IDomUserCommand;
    qry: IDomUserQuery;
    user: TUser;
    users: TUserObjArray;
    i: integer;
    itext: RawUTF8;
    v: TDomUserEmailValidation;
    count: array[TDomUserEmailValidation] of integer;
    msg: string;
begin
  test.Check(Command.GetOneInstance(cmd));
  user := TUser.Create;
  try
    for i := 1 to MAX do begin
      UInt32ToUtf8(i,itext);
      user.LogonName := '  '+itext; // left '  ' to test TSynFilterTrim.Create
      user.EmailValidated := TDomUserEmailValidation(i mod MOD_EMAILVALID);
      user.Name.Last := 'Last'+itext;
................................................................................
    end;
    test.check(cmd.Commit=cqrsSuccess);
  finally
    user.Free;
  end; 
  user := TUser.Create;
  try
    test.Check(Command.GetOneInstance(qry));
    test.Check(qry.GetCount=0);
    for i := 1 to MAX do begin
      UInt32ToUtf8(i,itext);
      test.Check(qry.SelectByLogonName(itext)=cqrsSuccess);
      test.Check(qry.GetCount=1);
      test.Check(qry.Get(user)=cqrsSuccess);
      test.Check(qry.GetCount=1);
................................................................................
      test.Check(user.EmailValidated=TDomUserEmailValidation(i mod MOD_EMAILVALID));
      test.Check(user.Name.Last='Last'+itext);
      test.Check(user.Name.First='First'+itext);
      test.Check(user.Address.Street1='Street '+itext);
      test.Check(user.Address.Country.Alpha2='FR');
      test.Check(user.Phone1=itext);
    end;
    test.Check(Command.GetOneInstance(cmd));
    try
      for v := low(TDomUserEmailValidation) to high(TDomUserEmailValidation) do begin
        test.Check(cmd.SelectByEmailValidation(v)=cqrsSuccess);
        ObjArrayClear(users); // should be done, otherwise memory leak
        test.Check(cmd.GetAll(users)=cqrsSuccess);
        test.Check(length(users)>=MAX div MOD_EMAILVALID);
        count[v] := length(users);
................................................................................
        end;
      end;
      test.Check(cmd.DeleteAll=cqrsSuccess,'delete all evFailed');
      test.check(cmd.Commit=cqrsSuccess);
    finally
      ObjArrayClear(users);
    end;
    test.Check(Command.GetOneInstance(cmd));
    for v := low(TDomUserEmailValidation) to high(TDomUserEmailValidation) do begin
      test.Check(cmd.SelectByEmailValidation(v)=cqrsSuccess);
      if v=evFailed then
        test.Check(cmd.GetCount=0) else
        test.Check(cmd.GetCount=count[v]);
      i := 0;
      while cmd.GetNext(user)=cqrsSuccess do begin
................................................................................
    test.check(cmd.GetLastError=cqrsDDDValidationFailed);
    msg := cmd.GetLastErrorInfo.msg;
    test.check(pos('TUser.LogonName',msg)>0,msg);
  finally
    user.Free;
  end;
end;
var Rest: TSQLRest;
begin
  Rest := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordUser]);
  try
    Command := Create(Rest);
    try
      TestOne; // sub function to ensure that all I*Command are released
    finally
      Command.Free;
    end;
  finally
    Rest.Free;
  end;
end;


end.

{ *********** Implements User Aggregate CQRS Repository via mORMot's RESTful ORM }

type
  /// implements a User CQRS Repository via mORMot's RESTful ORM
  // - this class will use a supplied TSQLRest instance to persist TUser
  // Aggregate Roots, following the IDomUserCommand CQRS methods
  // - each TUser aggregate will be mapped into a TSQLRecordUser ORM table
  TInfraRepoUser = class(TDDDRepositoryRestCommand,IDomUserCommand,IDomUserQuery)
  public
    function SelectByLogonName(const aLogonName: RawUTF8): TCQRSResult;
    function SelectByEmailValidation(aValidationState: TDomUserEmailValidation): TCQRSResult;
    function SelectByLastName(const aName: TLastName; aStartWith: boolean): TCQRSResult;
    function Get(out aAggregate: TUser): TCQRSResult;
    function GetAll(out aAggregates: TUserObjArray): TCQRSResult;
    function GetNext(out aAggregate: TUser): TCQRSResult;
................................................................................
begin
  inherited Create(IDomUserCommand,TInfraRepoUser,TUser,aRest,TSQLRecordUser,aOwner);
  AddFilterOrValidate(['*'],TSynFilterTrim.Create);
  AddFilterOrValidate(['LogonName'],TSynValidateNonVoidText.Create);
end;

class procedure TInfraRepoUserFactory.RegressionTests(test: TSynTestCase);
var Rest: TSQLRestServer;
procedure TestOne;
const MAX=1000;
      MOD_EMAILVALID=ord(high(TDomUserEmailValidation))+1;
var cmd: IDomUserCommand;
    qry: IDomUserQuery;
    user: TUser;
    users: TUserObjArray;
    i: integer;
    itext: RawUTF8;
    v: TDomUserEmailValidation;
    count: array[TDomUserEmailValidation] of integer;
    msg: string;
begin
  test.Check(Rest.Services.Resolve(IDomUserCommand,cmd));
  user := TUser.Create;
  try
    for i := 1 to MAX do begin
      UInt32ToUtf8(i,itext);
      user.LogonName := '  '+itext; // left '  ' to test TSynFilterTrim.Create
      user.EmailValidated := TDomUserEmailValidation(i mod MOD_EMAILVALID);
      user.Name.Last := 'Last'+itext;
................................................................................
    end;
    test.check(cmd.Commit=cqrsSuccess);
  finally
    user.Free;
  end; 
  user := TUser.Create;
  try
    test.Check(Rest.Services.Resolve(IDomUserQuery,qry));
    test.Check(qry.GetCount=0);
    for i := 1 to MAX do begin
      UInt32ToUtf8(i,itext);
      test.Check(qry.SelectByLogonName(itext)=cqrsSuccess);
      test.Check(qry.GetCount=1);
      test.Check(qry.Get(user)=cqrsSuccess);
      test.Check(qry.GetCount=1);
................................................................................
      test.Check(user.EmailValidated=TDomUserEmailValidation(i mod MOD_EMAILVALID));
      test.Check(user.Name.Last='Last'+itext);
      test.Check(user.Name.First='First'+itext);
      test.Check(user.Address.Street1='Street '+itext);
      test.Check(user.Address.Country.Alpha2='FR');
      test.Check(user.Phone1=itext);
    end;
    test.Check(Rest.Services.Resolve(IDomUserCommand,cmd));
    try
      for v := low(TDomUserEmailValidation) to high(TDomUserEmailValidation) do begin
        test.Check(cmd.SelectByEmailValidation(v)=cqrsSuccess);
        ObjArrayClear(users); // should be done, otherwise memory leak
        test.Check(cmd.GetAll(users)=cqrsSuccess);
        test.Check(length(users)>=MAX div MOD_EMAILVALID);
        count[v] := length(users);
................................................................................
        end;
      end;
      test.Check(cmd.DeleteAll=cqrsSuccess,'delete all evFailed');
      test.check(cmd.Commit=cqrsSuccess);
    finally
      ObjArrayClear(users);
    end;
    test.Check(Rest.Services.Resolve(IDomUserCommand,cmd));
    for v := low(TDomUserEmailValidation) to high(TDomUserEmailValidation) do begin
      test.Check(cmd.SelectByEmailValidation(v)=cqrsSuccess);
      if v=evFailed then
        test.Check(cmd.GetCount=0) else
        test.Check(cmd.GetCount=count[v]);
      i := 0;
      while cmd.GetNext(user)=cqrsSuccess do begin
................................................................................
    test.check(cmd.GetLastError=cqrsDDDValidationFailed);
    msg := cmd.GetLastErrorInfo.msg;
    test.check(pos('TUser.LogonName',msg)>0,msg);
  finally
    user.Free;
  end;
end;

begin
  Rest := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordUser]);
  try
    Rest.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(Rest)],true);

    TestOne; // sub function to ensure that all I*Command are released



  finally
    Rest.Free;
  end;
end;


end.

!        raise EMyApplicationException.CreateFmt('Commit error: %s',[cmd.GetLastErrorInfo]);
!    // here everything has been written to the database
!  finally
!    user.Free;
!  end;
This {\i dual-phase} commit appears to be a clean way of implement the @100@. Under the hood, when used with our ORM - as we will now explain - {\i @*Unit Of Work@} will be expressed as a {\f1\fs20 I*Command} service, uncoupled from the persistence layer it runs on.
:    Automated Repository using the ORM
As you may have noticed, we did just implemented the {\f1\fs20 interface} types we needed. That is, we have the {\i contract} of our persistence services, but no actual implementation of it. As such, those {\f1\fs20 interface} definitions are useless. Luckily for use, the {\f1\fs20 mORMotDDD.pas} unit offers an easy way to implement those using @3@, with minimal coding.

First we would need to map our domain object (i.e. our {\f1\fs20 TUser} instance and its properties) into a {\f1\fs20 TSQLRecord}. We may do it by hand, but you may find an handy way. Just run the following in the context of your application:
! TDDDRepositoryRestFactory.ComputeSQLRecord(TUser);
This {\f1\fs20 class procedure} would create a {\f1\fs20 ddsqlrecord.inc} file in the executable folder, containing the needed field definition, with one {\f1\fs20 TSQLRecord} type corresponding to each hierarchy level of the original {\f1\fs20 TPersistent} definition. Nested fields would be defined as a single column in the {\f1\fs20 TSQLRecord}, e.g. {\f1\fs20 Address.Country.Iso} would be flattened as a {\f1\fs20 Address_Country} property.
So if we follow the class hierarchy, we would have:
\graph DDDCQRSORMMapping CQRS Class Hierarchy Mapping for ORM and DDD Entities
\TPerson\TPersonContactable
\TPersonContactable\TUser
................................................................................
!    property LogonName: RawUTF8 read fLogonName write fLogonName;
!    property EmailValidated: TDomUserEmailValidation read fEmailValidated write fEmailValidated;
!  end;
In practice, the following property would need to be tuned as such:
!    property LogonName: RawUTF8 read fLogonName write fLogonName
!!      stored AS_UNIQUE;
Take a look at the {\f1\fs20 dddInfraRepoUser.pas} and {\f1\fs20 dddDomUserTypes.pas} units to make a comparison between the DDD objects and their corresponding {\f1\fs20 TSQLRecord*} types.

Since the generated {\f1\fs20 TSQLRecordUser} type follows known conventions, the {\f1\fs20 mORMotDDD.pas} unit is able to do almost all the persistence work in an automated way, by inheriting of two classes:
- Defining a {\i Repository Factory} (i.e. a class able to generate {\f1\fs20 IDomUserQuery} or {\f1\fs20 IDomUserCommand} instances on requests) by inheriting from {\f1\fs20 TDDDRepositoryRestFactory}
- Defining the actual {\f1\fs20 IDomUserCommand} methods by inheriting from {\f1\fs20 TDDDRepositoryRestCommand}, and using high level protected methods to access the {\f1\fs20 TUser} from internal {\f1\fs20 TSQLRecordUser} ORM values.
First of all, we define the Factory:
!type
!  TInfraRepoUserFactory = class(TDDDRepositoryRestFactory)
!  public
................................................................................
- We would like to implement a {\f1\fs20 IDomUserCommand} contract - and, by the way, implement also its parent {\f1\fs20 IDomUserQuery interface};
- The actual implementation class would be {\f1\fs20 TInfraRepoUser} - which would be defined just after;
- The {\i Aggregate/Entity} class is a {\f1\fs20 TUser} kind of object;
- The associated {\f1\fs20 TSQLRest} server would be the one supplied to this class;
- The ORM class, defining the actual SQL table or NoSQL collection which would store the data, is {\f1\fs20 TSQLRecordUser};
- An optional {\f1\fs20 TDDDRepositoryRestManager} instance may be supplied as owner of this factory - but it is not used in most cases.
The {\f1\fs20 AddFilterOrValidate()} method allows to set some @56@ expectations at DDD level. Those rules would be applied before {\f1\fs20 Commit} would take place, without any use of the ORM rules. In the above code, {\f1\fs20 TSynFilterTrim} would remove any space from all text fields of the {\f1\fs20 TUser} instance, and {\f1\fs20 TSynValidateNonVoidText} will ensure that the {\f1\fs20 TUser.LogonName} field would not be {\f1\fs20 ''} - after space trimming. You may consider those rules as the SQL constraints you may be used to. But since they would be defined at DDD level, they would apply on any database back-end, even if it does not support any constraint - e.g. if it is a NoSQL engine, or a third-party persistence service you do not have the hand on.























Then we define the needed methods of {\f1\fs20 IDomUserCommand} and {\f1\fs20 IDomUserQuery} in our custom class:
!type
!  TInfraRepoUser = class(TDDDRepositoryRestCommand,IDomUserCommand)
!  public
!    function SelectByLogonName(const aLogonName: RawUTF8): TCQRSResult;
!    function SelectByEmailValidation(aValidationState: TDomUserEmailValidation): TCQRSResult;
!    function SelectByLastName(const aName: TLastName; aStartWith: boolean): TCQRSResult;
!    function Get(out aAggregate: TUser): TCQRSResult;
!    function GetAll(out aAggregates: TUserObjArray): TCQRSResult;
!    function GetNext(out aAggregate: TUser): TCQRSResult;
!    function Add(const aAggregate: TUser): TCQRSResult;
!    function Update(const aUpdatedAggregate: TUser): TCQRSResult;
!    function HowManyValidatedEmail: integer;
!  end;

As you can see, some methods appear to me missing. There is no {\f1\fs20 Commit}, nor {\f1\fs20 Delete} - which are required by {\f1\fs20 IDomUserCommand}. But in fact, those commands are so generic that they are already implemented for you in {\f1\fs20 TDDDRepositoryRestCommand}!
What we need know is to implement those methods, using the internal protected {\f1\fs20 ORM*()} methods inherited by this parent class:
!function TInfraRepoUser.SelectByLogonName(const aLogonName: RawUTF8): TCQRSResult;
!begin
!  result := ORMSelectOne('LogonName=?',[aLogonName],(aLogonName=''));
!end;
!
................................................................................
!end;
Almost everything is already defined at {\f1\fs20 TDDDRepositoryRestCommand} level. Our {\f1\fs20 TInfraRepoUser} class, implementing a full CQRS service, fully abstracted from the ORM, is implemented by a few internal {\f1\fs20 ORM*()} method calls.
All the error handling, including server-side {\f1\fs20 exception} catching, and conversion into {\f1\fs20 TCQRSResult} / {\f1\fs20 ICQRSService.GetLastErrorInfo} content, is already implemented in {\f1\fs20 TDDDRepositoryRestCommand}.
All the data access via the {\f1\fs20 TSQLRecordUser} REST persistence layer, with any @56@ defined rule, is also incorporated in {\f1\fs20 TDDDRepositoryRestCommand}. The conversion to/from {\f1\fs20 TUser} properties has been optimized, so that fields would be moved {\i by reference}, with no memory allocation nor content modification, for best performance and data safety. The type mapping specified by {\f1\fs20 TInfraRepoUserFactory.Create} is enough to make the whole process as automated as possible.
In fact, our {\f1\fs20 TInfraRepoUser} {\f1\fs20 class} is just a thin wrapper forcing use of strong typing in its methods parameters (i.e. using {\f1\fs20 TUser}/{\f1\fs20 TUserObjArray} whereas the {\f1\fs20 ORM*()} methods are more relaxed about actual typing), and ensuring that the ORM specificities are followed as expected, e.g. a search against the {\f1\fs20 TUser.Name.Last} DDD field would use the {\f1\fs20 TSQLRecordUser.Name_Last} ORM column, with the proper {\f1\fs20 LIKE} operator.
Internally, {\f1\fs20 TDDDRepositoryRestCommand.ORMPrepareForCommit} will call all DDD and ORM {\f1\fs20 TSynFilter} and {\f1\fs20 TSynValidate} rules, as previously defined. It sounds indeed like a real advantage not to wait until the database layer is reached, to have those constraints verified. The sooner an error is notified, the better - especially in a complex @*SOA@ system.
Under the hood, {\f1\fs20 TDDDRepositoryRestCommand} will define a {\f1\fs20 TSqlRestBatch} - see @28@ - for storing all write commands in memory (as JSON) - e.g. {\f1\fs20 cmd.Add} - and will send them to the database engine, with optimized SQL or NoSQL statements, only when {\f1\fs20 cmd.Commit} would be executed.
:   Isolate using DTOs
DDD's {\i @*DTO@} may also be defined as {\f1\fs20 record}, and directly serialized as JSON via text-based serialization. Don't be afraid of writing some translation layers between {\f1\fs20 TSQLRecord} and DTO records or, more generally, between your {\i Application layer} and your {\i Presentation layer}. It will be very fast, on the server side. If your service interfaces are cleaner, do not hesitate.
But defining {\i DTO} types, just for uncoupling, may become time consuming. If you start writing a lot of wrapping code, forget about it, and expose your Domain {\i Value Objects} or even your {\i Entities}, as stated above. Or automate the wrapper coding, using RTTI and code generators. You have to weight the PROs and the CONs, like always... And never forget to write proper unit testing of this marshalling code, since it may induce some unexpected issues.
If you expect your DDD's objects to be {\i schema-less} or with an evolving structure (e.g. for {\i DTO}), depending on each context, you may benefit of not using a fixed {\f1\fs20 type} like {\f1\fs20 class} or {\f1\fs20 record}, but use @80@. This kind of {\f1\fs20 variant} will be serialized as JSON, and allow @*late-binding@ access to its properties (for {\i object} documents) or items (for {\i array} documents). In the context of interface-based services, using {\i per-reference} option at creation (i.e. {\f1\fs20 _ObjFast() _ArrFast() _JsonFast() _JsonFmtFast()} functions) does make sense, in order to spare the server resources.
:  Defining services
In practice, {\i mORMot}'s Client-Server architecture may be used as such:
- {\i @*Service@s via methods} - see @49@ - can be used to publish methods corresponding to your aggregate roots defined as {\f1\fs20 TSQLRecord}.\line This will make it pretty @*REST@ful compatible.
- {\i Services via interfaces} - see @63@ - can be used to publish all your processes.\line Dedicated factories can be used on both Client and Server side, to define your repositories and/or domain operations.

!        raise EMyApplicationException.CreateFmt('Commit error: %s',[cmd.GetLastErrorInfo]);
!    // here everything has been written to the database
!  finally
!    user.Free;
!  end;
This {\i dual-phase} commit appears to be a clean way of implement the @100@. Under the hood, when used with our ORM - as we will now explain - {\i @*Unit Of Work@} will be expressed as a {\f1\fs20 I*Command} service, uncoupled from the persistence layer it runs on.
:    Automated Repository using the ORM
As you may have noticed, we did just defined the {\f1\fs20 interface} types we needed. That is, we have the {\i contract} of our persistence services, but no actual implementation of it. As such, those {\f1\fs20 interface} definitions are useless. Luckily for use, the {\f1\fs20 mORMotDDD.pas} unit offers an easy way to implement those using @3@, with minimal coding.
:     DDD / ORM mapping
First we would need to map our domain object (i.e. our {\f1\fs20 TUser} instance and its properties) into a {\f1\fs20 TSQLRecord}. We may do it by hand, but you may find an handy way. Just run the following in the context of your application:
! TDDDRepositoryRestFactory.ComputeSQLRecord(TUser);
This {\f1\fs20 class procedure} would create a {\f1\fs20 ddsqlrecord.inc} file in the executable folder, containing the needed field definition, with one {\f1\fs20 TSQLRecord} type corresponding to each hierarchy level of the original {\f1\fs20 TPersistent} definition. Nested fields would be defined as a single column in the {\f1\fs20 TSQLRecord}, e.g. {\f1\fs20 Address.Country.Iso} would be flattened as a {\f1\fs20 Address_Country} property.
So if we follow the class hierarchy, we would have:
\graph DDDCQRSORMMapping CQRS Class Hierarchy Mapping for ORM and DDD Entities
\TPerson\TPersonContactable
\TPersonContactable\TUser
................................................................................
!    property LogonName: RawUTF8 read fLogonName write fLogonName;
!    property EmailValidated: TDomUserEmailValidation read fEmailValidated write fEmailValidated;
!  end;
In practice, the following property would need to be tuned as such:
!    property LogonName: RawUTF8 read fLogonName write fLogonName
!!      stored AS_UNIQUE;
Take a look at the {\f1\fs20 dddInfraRepoUser.pas} and {\f1\fs20 dddDomUserTypes.pas} units to make a comparison between the DDD objects and their corresponding {\f1\fs20 TSQLRecord*} types.
:     Define the Factory
Since the generated {\f1\fs20 TSQLRecordUser} type follows known conventions, the {\f1\fs20 mORMotDDD.pas} unit is able to do almost all the persistence work in an automated way, by inheriting of two classes:
- Defining a {\i Repository Factory} (i.e. a class able to generate {\f1\fs20 IDomUserQuery} or {\f1\fs20 IDomUserCommand} instances on requests) by inheriting from {\f1\fs20 TDDDRepositoryRestFactory}
- Defining the actual {\f1\fs20 IDomUserCommand} methods by inheriting from {\f1\fs20 TDDDRepositoryRestCommand}, and using high level protected methods to access the {\f1\fs20 TUser} from internal {\f1\fs20 TSQLRecordUser} ORM values.
First of all, we define the Factory:
!type
!  TInfraRepoUserFactory = class(TDDDRepositoryRestFactory)
!  public
................................................................................
- We would like to implement a {\f1\fs20 IDomUserCommand} contract - and, by the way, implement also its parent {\f1\fs20 IDomUserQuery interface};
- The actual implementation class would be {\f1\fs20 TInfraRepoUser} - which would be defined just after;
- The {\i Aggregate/Entity} class is a {\f1\fs20 TUser} kind of object;
- The associated {\f1\fs20 TSQLRest} server would be the one supplied to this class;
- The ORM class, defining the actual SQL table or NoSQL collection which would store the data, is {\f1\fs20 TSQLRecordUser};
- An optional {\f1\fs20 TDDDRepositoryRestManager} instance may be supplied as owner of this factory - but it is not used in most cases.
The {\f1\fs20 AddFilterOrValidate()} method allows to set some @56@ expectations at DDD level. Those rules would be applied before {\f1\fs20 Commit} would take place, without any use of the ORM rules. In the above code, {\f1\fs20 TSynFilterTrim} would remove any space from all text fields of the {\f1\fs20 TUser} instance, and {\f1\fs20 TSynValidateNonVoidText} will ensure that the {\f1\fs20 TUser.LogonName} field would not be {\f1\fs20 ''} - after space trimming. You may consider those rules as the SQL constraints you may be used to. But since they would be defined at DDD level, they would apply on any database back-end, even if it does not support any constraint - e.g. if it is a NoSQL engine, or a third-party persistence service you do not have the hand on.
You would probably want to use those CQRS interfaces, via usual @*IoC@, at {\f1\fs20 TSQLRest} level, just like any @63@:
!var cmd: IDomUserCommand;
!...
!  aServer.Services.Resolve(IDomUserCommand,cmd);
or, for a {\i Query}:
!var qry: IDomUserQuery;
!...
!  aServer.Services.Resolve(IDomUserQuery,qry);
In order to be able to get a {\f1\fs20 IDomUserCommand} or {\f1\fs20 IDomUserQuery} instance from {\f1\fs20 aServer.Services.Resolve()}, you would need to register the {\f1\fs20 TInfraRepoUserFactory} first:
! aServer.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(aServer)],true);
or if you want to maintain the factory instance life-time (e.g. to share it with other interface resolvers):
!var factory: TInfraRepoUserFactory;
! ...
!  factory := TInfraRepoUserFactory.Create(aServer);
!  try
!    aServer.ServiceContainer.InjectResolver([factory]);
!  ...
!  finally
!    factory.Free;
!  end;
This single {\f1\fs20 TInfraRepoUserFactory} would allow to implement both {\f1\fs20 IDomUserCommand} and {\f1\fs20 IDomUserQuery} contracts.
Of course, having the ability to let {\f1\fs20 aServer} own the factory, via the {\f1\fs20 InjectResolver([...],true)} parameter, sounds easier to work with.
:     Implement the CQRS methods
Then we define the needed methods of {\f1\fs20 IDomUserCommand} and {\f1\fs20 IDomUserQuery} in our custom class:
!type
!  TInfraRepoUser = class(TDDDRepositoryRestCommand,IDomUserCommand,IDomUserQuery)
!  public
!    function SelectByLogonName(const aLogonName: RawUTF8): TCQRSResult;
!    function SelectByEmailValidation(aValidationState: TDomUserEmailValidation): TCQRSResult;
!    function SelectByLastName(const aName: TLastName; aStartWith: boolean): TCQRSResult;
!    function Get(out aAggregate: TUser): TCQRSResult;
!    function GetAll(out aAggregates: TUserObjArray): TCQRSResult;
!    function GetNext(out aAggregate: TUser): TCQRSResult;
!    function Add(const aAggregate: TUser): TCQRSResult;
!    function Update(const aUpdatedAggregate: TUser): TCQRSResult;
!    function HowManyValidatedEmail: integer;
!  end;
Note that we defined the {\f1\fs20 TInfraRepoUser} class as implementing both interface we need, via {\f1\fs20 = class(...,IDomUserCommand,IDomUserQuery}). We need both types to be explicit in the {\f1\fs20 class} type definition, otherwise, @*IoC@ - i.e. {\f1\fs20 aServer.Services.Resolve()} calls - won't work for both.
As you can see, some methods appear to me missing. There is no {\f1\fs20 Commit}, nor {\f1\fs20 Delete} - which are required by {\f1\fs20 IDomUserCommand}. But in fact, those commands are so generic that they are already implemented for you in {\f1\fs20 TDDDRepositoryRestCommand}!
What we need know is to implement those methods, using the internal protected {\f1\fs20 ORM*()} methods inherited by this parent class:
!function TInfraRepoUser.SelectByLogonName(const aLogonName: RawUTF8): TCQRSResult;
!begin
!  result := ORMSelectOne('LogonName=?',[aLogonName],(aLogonName=''));
!end;
!
................................................................................
!end;
Almost everything is already defined at {\f1\fs20 TDDDRepositoryRestCommand} level. Our {\f1\fs20 TInfraRepoUser} class, implementing a full CQRS service, fully abstracted from the ORM, is implemented by a few internal {\f1\fs20 ORM*()} method calls.
All the error handling, including server-side {\f1\fs20 exception} catching, and conversion into {\f1\fs20 TCQRSResult} / {\f1\fs20 ICQRSService.GetLastErrorInfo} content, is already implemented in {\f1\fs20 TDDDRepositoryRestCommand}.
All the data access via the {\f1\fs20 TSQLRecordUser} REST persistence layer, with any @56@ defined rule, is also incorporated in {\f1\fs20 TDDDRepositoryRestCommand}. The conversion to/from {\f1\fs20 TUser} properties has been optimized, so that fields would be moved {\i by reference}, with no memory allocation nor content modification, for best performance and data safety. The type mapping specified by {\f1\fs20 TInfraRepoUserFactory.Create} is enough to make the whole process as automated as possible.
In fact, our {\f1\fs20 TInfraRepoUser} {\f1\fs20 class} is just a thin wrapper forcing use of strong typing in its methods parameters (i.e. using {\f1\fs20 TUser}/{\f1\fs20 TUserObjArray} whereas the {\f1\fs20 ORM*()} methods are more relaxed about actual typing), and ensuring that the ORM specificities are followed as expected, e.g. a search against the {\f1\fs20 TUser.Name.Last} DDD field would use the {\f1\fs20 TSQLRecordUser.Name_Last} ORM column, with the proper {\f1\fs20 LIKE} operator.
Internally, {\f1\fs20 TDDDRepositoryRestCommand.ORMPrepareForCommit} will call all DDD and ORM {\f1\fs20 TSynFilter} and {\f1\fs20 TSynValidate} rules, as previously defined. It sounds indeed like a real advantage not to wait until the database layer is reached, to have those constraints verified. The sooner an error is notified, the better - especially in a complex @*SOA@ system.
Under the hood, {\f1\fs20 TDDDRepositoryRestCommand} will define a {\f1\fs20 TSqlRestBatch} - see @28@ - for storing all write commands in memory (as JSON) - e.g. {\f1\fs20 cmd.Add} - and will send them to the database engine, with optimized SQL or NoSQL statements, only when {\f1\fs20 cmd.Commit} would be executed.
:   Isolate your Domain using DTOs
DDD's {\i @*DTO@} may also be defined as {\f1\fs20 record}, and directly serialized as JSON via text-based serialization. Don't be afraid of writing some translation layers between {\f1\fs20 TSQLRecord} and DTO records or, more generally, between your {\i Application layer} and your {\i Presentation layer}. It will be very fast, on the server side. If your service interfaces are cleaner, do not hesitate.
But defining {\i DTO} types, just for uncoupling, may become time consuming. If you start writing a lot of wrapping code, forget about it, and expose your Domain {\i Value Objects} or even your {\i Entities}, as stated above. Or automate the wrapper coding, using RTTI and code generators. You have to weight the PROs and the CONs, like always... And never forget to write proper unit testing of this marshalling code, since it may induce some unexpected issues.
If you expect your DDD's objects to be {\i schema-less} or with an evolving structure (e.g. for {\i DTO}), depending on each context, you may benefit of not using a fixed {\f1\fs20 type} like {\f1\fs20 class} or {\f1\fs20 record}, but use @80@. This kind of {\f1\fs20 variant} will be serialized as JSON, and allow @*late-binding@ access to its properties (for {\i object} documents) or items (for {\i array} documents). In the context of interface-based services, using {\i per-reference} option at creation (i.e. {\f1\fs20 _ObjFast() _ArrFast() _JsonFast() _JsonFmtFast()} functions) does make sense, in order to spare the server resources.
:  Defining services
In practice, {\i mORMot}'s Client-Server architecture may be used as such:
- {\i @*Service@s via methods} - see @49@ - can be used to publish methods corresponding to your aggregate roots defined as {\f1\fs20 TSQLRecord}.\line This will make it pretty @*REST@ful compatible.
- {\i Services via interfaces} - see @63@ - can be used to publish all your processes.\line Dedicated factories can be used on both Client and Server side, to define your repositories and/or domain operations.

    // - will return the exact code page since Delphi 2009, from RTTI
    // - for non Unicode versions of Delphi, will recognize WinAnsiString as
    // CODEPAGE_US, RawUnicode as CP_UTF16, RawByteString as CP_RAWBYTESTRING,
    // AnsiString as 0, and any other type as RawUTF8
    function AnsiStringCodePage: integer; {$ifdef UNICODE}inline;{$endif}
    /// get the TGUID of a given interface type information
    // - returns nil if this type is not an interface
    function InterfaceGUID: PGUID;
    /// get the unit name of a given interface type information
    // - returns '' if this type is not an interface
    function InterfaceUnitName: PShortString;











  end;

{$ifdef FPC}
{$PACKRECORDS 1}
{$else}
{$A-}
{$endif}
................................................................................
    /// this overriden constructor will release all its nested
    // TPersistent class published properties
    destructor Destroy; override;
  end;

  {$endif LVCL}

  /// class-reference type (metaclass) of a TInterfacedObject kind
  TInterfacedObjectClass = class of TInterfacedObject;

  /// abstract TPersistent class, which will instantiate all its nested TPersistent
  // class published properties, then release them (and any T*ObjArray) when freed
  // - TSynAutoCreateFields is to be preferred in most cases, due to its lower overhead
  // - note that non published (e.g. public) properties won't be instantiated
  // - please take care that you would not create any endless recursion: you
  // should ensure that at one level, nested published properties won't have any
  // class instance matching its parent type
................................................................................
  end;
  {$M-}

  /// abstract factory class targetting a single kind of interface
  TInterfaceResolverForSingleInterface = class(TInterfaceResolver)
  protected
    fInterfaceTypeInfo: PTypeInfo;


    fImplementationEntry: PInterfaceEntry;
    fImplementationClass: TInterfacedObjectClass;
    fImplementationClassIsCustomCreate: boolean;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    function CreateInstance: TInterfacedObject; virtual;
  public
    /// this overriden constructor will check and store the supplied class
................................................................................
  // and doing the instance resolution using the overloaded Resolve*() methods
  // - TServiceContainer will inherit from this class, as the main entry point
  // for interface-based services of the framework (via TSQLRest.Services)
  // - you can use RegisterGlobal() class method to define some process-wide DI
  TInterfaceResolverInjected = class(TInterfaceResolver)
  protected
    fResolvers: TInterfaceResolverObjArray;
    fCreatedInterfaceStub: TInterfaceStubObjArray;
    fDependencies: TInterfacedObjectObjArray;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    class function RegisterGlobalCheck(aInterface: PTypeInfo;
      aImplementationClass: TClass): PInterfaceEntry;
  public
    /// define a global class type for interface resolution
    // - most of the time, you would need a local DI/IoC resolution list; but
................................................................................
    /// prepare and setup interface DI/IoC resolution with some blank
    // TInterfaceStub specified by their TGUID
    procedure InjectStub(const aStubsByGUID: array of TGUID); overload; virtual;
    /// prepare and setup interface DI/IoC resolution with TInterfaceResolver
    // kind of factory
    // - e.g. a customized TInterfaceStub/TInterfaceMock, a TServiceContainer,
    // a TDDDRepositoryRestObjectMapping or any factory class


    procedure InjectResolver(const aOtherResolvers: array of TInterfaceResolver); overload; virtual;

    /// prepare and setup interface DI/IoC resolution from a TInterfacedObject instance
    // - any TInterfacedObject declared as dependency will have its reference
    // count increased, and decreased in Destroy
    procedure InjectInstance(const aDependencies: array of TInterfacedObject); overload; virtual;
    /// can be used to perform an DI/IoC for a given interface
    // - will search for the supplied interface to its internal list of resolvers
    // - returns TRUE and set the Obj variable with a matching instance
................................................................................
    // ! if fServer.Services['Calculator'].Get(Calc)) then
    // !   ...
    // - safer typical use, following the DI/IoC pattern, and which would not
    // trigger any access violation if Services=nil, could be:
    // ! if fServer.Services.Resolve(ICalculator,Calc) then
    // !   ...
    property Services: TServiceContainer read fServices;











    /// the routing classs of the service remote request
    // - by default, will use TSQLRestRoutingREST, i.e. an URI-based
    // layout which is secure (since will use our RESTful authentication scheme),
    // and also very fast
    // - but TSQLRestRoutingJSON_RPC can e.g. be set (on BOTH client and
    // server sides), if the client would rather use JSON/RPC alternative pattern
    // - NEVER set the abstract TSQLRestServerURIContext class on this property
................................................................................
      const aInterfaces: array of TGUID; const aContractExpected: RawUTF8=''): TServiceFactoryServer; overload;
    /// register a remote Service via its interface
    // - this method expects the interface(s) to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    function ServiceDefine(aClient: TSQLRest; const aInterfaces: array of TGUID;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): boolean; overload;











    /// compute the full statistics about this server, as JSON
    // - is a wrapper around the Stats() method-based service, setting withall=1
    function FullStatsAsJson: RawUTF8; virtual;
    /// compute the full statistics about this server, as a TDocVariant document
    // - is a wrapper around the Stats() method-based service, setting withall=1
    function FullStatsAsDocVariant: variant;
................................................................................
      out ResultID: TIDDynArray): boolean; overload; virtual;
    /// search for a field value, according to its SQL content representation
    // - return true on success (i.e. if some values have been added to ResultID)
    // - store the results into the ResultID dynamic array
    // - faster than OneFieldValues method, which creates a temporary JSON content
    function SearchField(const FieldName, FieldValue: RawUTF8;
      out ResultID: TIDDynArray): boolean; overload; virtual; abstract;





    /// read only access to a boolean value set to true if table data was modified
    property Modified: boolean read fModified write fModified;
    /// read only access to the class defining the record type stored in this
    // REST storage
    property StoredClass: TSQLRecordClass read fStoredClass;
    /// read only access to the ORM properties of the associated record type
................................................................................
    /// end a transaction (calls REST END Member)
    // - by default, Client transaction will use here a pseudo session
    procedure Commit(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED;
      RaiseException: boolean=false); override;
    /// abort a transaction (calls REST ABORT Member)
    // - by default, Client transaction will use here a pseudo session
    procedure RollBack(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED); override;










    /// if set to TRUE, all BLOB fields of all tables will be transferred
    // between the Client and the remote Server
    // - i.e. Add() Update() will use Blob-related RESTful PUT/POST request
    // - i.e. Retrieve() will use Blob-related RESTful GET request
    // - note that the Refresh method won't handle BLOB fields, even if this
    // property setting is set to TRUE
................................................................................
function TTypeInfo.InterfaceUnitName: PShortString;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    result := @NULL_SHORTSTRING else
    result := @PInterfaceTypeData(AlignToPtr(@Name[ord(Name[0])+1]))^.IntfUnit;
end;














































{ TClassProp }

function TClassProp.FieldProp(const PropName: shortstring): PPropInfo;
var i: integer;
begin
  if @self<>nil then begin
................................................................................
function TSQLRestClientURI.ServiceRegister(const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
begin
  result := False;
  if (self=nil) or (high(aInterfaces)<0) then
    exit;
  if fServices=nil then
    fServices := TServiceContainerClient.Create(self);
  result := (fServices as TServiceContainerClient).AddInterface(
    aInterfaces,aInstanceCreation,aContractExpected);
end;

function TSQLRestClientURI.ServiceRegister(aInterface: PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactory;
begin
  result := nil;
  if (self=nil) or (aInterface=nil) then begin
    SetLastException;
    exit;
  end;
  if fServices=nil then
    fServices := TServiceContainerClient.Create(self);
  with fServices as TServiceContainerClient do
  try
    result := AddInterface(aInterface,aInstanceCreation,aContractExpected);
  except
    on E: Exception do
      SetLastException(E);
  end;
end;
................................................................................
      ListUpdated.Free;
      ListDeleted.Free;
    end;
  finally
    fAcquireExecution[execORMWrite].Leave;
  end;
end;








function TSQLRestServer.RecordVersionSynchronizeSubscribeMaster(Table: TSQLRecordClass;
  RecordVersion: TRecordVersion; const SlaveCallback: IServiceRecordVersionCallback): boolean;
begin
  if self=nil then begin
    result := false;
    exit;
  end;
  if fServices=nil then
    fServices := TServiceContainerServer.Create(self);
  result := TServiceContainerServer(fServices).
    RecordVersionSynchronizeSubscribeMaster(Model.GetTableIndexExisting(Table),
      RecordVersion,SlaveCallback);
end;

function TSQLRestServer.RecordVersionSynchronizeMasterStart(
  ByPassAuthentication: boolean): boolean;
var factory: TServiceFactory;
begin
  if Services<>nil then begin
................................................................................
end;

function TSQLRestServer.ServiceRegister(
  aImplementationClass: TInterfacedClass; const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactoryServer;
begin
  if fServices=nil then
    fServices := TServiceContainerServer.Create(self);
  if (aImplementationClass=nil) or (high(aInterfaces)<0) then
    result := nil else
    result := (fServices as TServiceContainerServer).
      AddImplementation(aImplementationClass,aInterfaces,aInstanceCreation,nil,aContractExpected);
end;

function TSQLRestServer.ServiceRegister(aSharedImplementation: TInterfacedObject;
  const aInterfaces: array of PTypeInfo; const aContractExpected: RawUTF8): TServiceFactoryServer;
begin
  if fServices=nil then
    fServices := TServiceContainerServer.Create(self);
  if (self=nil) or (aSharedImplementation=nil) or (high(aInterfaces)<0) then
    result := nil else
    result := (fServices as TServiceContainerServer).
      AddImplementation(TInterfacedClass(aSharedImplementation.ClassType),
        aInterfaces,sicShared,aSharedImplementation,aContractExpected);
end;

function TSQLRestServer.ServiceRegister(aClient: TSQLRest;
  const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
begin
  result := False;
  if (self=nil) or (high(aInterfaces)<0) or (aClient=nil) then
    exit;
  if fServices=nil then
    fServices := TServiceContainerServer.Create(self);
  result := (fServices as TServiceContainerServer).AddInterface(
    aInterfaces,aInstanceCreation,aContractExpected);
end;

function TSQLRestServer.ServiceDefine(aImplementationClass: TInterfacedClass;
  const aInterfaces: array of TGUID; aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactoryServer;
begin
................................................................................
  // nothing to do in this basic REST static class
end;

procedure TSQLRestStorage.EndCurrentThread(Sender: TThread);
begin // called by TSQLRestServer.EndCurrentThread
  // nothing to do in this basic REST static class
end;






function TSQLRestStorage.CreateSQLMultiIndex(Table: TSQLRecordClass;
  const FieldNames: array of RawUTF8; Unique: boolean; IndexName: RawUTF8): boolean;
begin
  result := false; // not implemented in this basic REST static class
end;

................................................................................
      exit;
    Res.GetRowValues(0,TInt64DynArray(DataID));
    result := true;
  finally
    Res.Free;
  end;
end;









{ TSQLRecordLog }

destructor TSQLRecordLog.Destroy;
begin
  fLogTableWriter.Free;
................................................................................
  guid := aInterface^.InterfaceGUID;
  if guid=nil then
    raise EInterfaceResolverException.CreateUTF8('%.Create expects an Interface',[self]);
  fImplementationEntry := aImplementation.GetInterfaceEntry(guid^);
  if fImplementationEntry=nil then
    raise EInterfaceResolverException.CreateUTF8('%.Create: % does not implement %',
      [self,aImplementation,fInterfaceTypeInfo^.Name]);


  fImplementationClass := aImplementation;
  fImplementationClassIsCustomCreate :=
    aImplementation.InheritsFrom(TInterfacedObjectWithCustomCreate);
end;

constructor TInterfaceResolverForSingleInterface.Create(const aInterface: TGUID;
  aImplementation: TInterfacedObjectClass);
................................................................................
  if not fImplementationClassIsCustomCreate then
    result := fImplementationClass.Create else
    result := TInterfacedObjectWithCustomCreateClass(fImplementationClass).Create;
end;

function TInterfaceResolverForSingleInterface.GetOneInstance(out Obj): boolean;
begin



  result := GetInterfaceFromEntry(CreateInstance,fImplementationEntry,Obj);
end;

function TInterfaceResolverForSingleInterface.TryResolve(
  aInterface: PTypeInfo; out Obj): boolean;

begin
  if fInterfaceTypeInfo<>aInterface then









    result := false else
    result := GetOneInstance(Obj);

end;


{ TInterfaceResolverInjected }

var
  GlobalInterfaceResolutionLock: TRTLCriticalSection;
................................................................................
var i: integer;
begin
  for i := 0 to high(aStubsByGUID) do
    InjectResolver([TInterfaceStub.Create(aStubsByGUID[i])]);
end;

procedure TInterfaceResolverInjected.InjectResolver(
  const aOtherResolvers: array of TInterfaceResolver);

var i: integer;
begin
  for i := 0 to high(aOtherResolvers) do
  if aOtherResolvers[i]<>nil then begin
    if aOtherResolvers[i].InheritsFrom(TInterfaceStub) then begin
      include(TInterfaceStub(aOtherResolvers[i]).fOptions,
        imoFakeInstanceWontReleaseTInterfaceStub);
      ObjArrayAdd(fCreatedInterfaceStub,aOtherResolvers[i]);
    end;


    ObjArrayAddOnce(fResolvers,aOtherResolvers[i]);
  end;
end;

procedure TInterfaceResolverInjected.InjectInstance(
  const aDependencies: array of TInterfacedObject);
var i: integer;
................................................................................
  end;
end;

destructor TInterfaceResolverInjected.Destroy;
var i: integer;
begin
  try
    ObjArrayClear(fCreatedInterfaceStub);
    for i := 0 to length(fDependencies)-1 do
      IInterface(fDependencies[i])._Release;
  finally
    inherited Destroy;
  end;
end;

    // - will return the exact code page since Delphi 2009, from RTTI
    // - for non Unicode versions of Delphi, will recognize WinAnsiString as
    // CODEPAGE_US, RawUnicode as CP_UTF16, RawByteString as CP_RAWBYTESTRING,
    // AnsiString as 0, and any other type as RawUTF8
    function AnsiStringCodePage: integer; {$ifdef UNICODE}inline;{$endif}
    /// get the TGUID of a given interface type information
    // - returns nil if this type is not an interface
    function InterfaceGUID: PGUID; {$ifdef UNICODE}inline;{$endif}
    /// get the unit name of a given interface type information
    // - returns '' if this type is not an interface
    function InterfaceUnitName: PShortString;
    /// get the ancestor/parent of a given interface type information
    // - returns nil if this type has no parent
    function InterfaceAncestor: PTypeInfo; {$ifdef UNICODE}inline;{$endif}
    /// get all ancestors/parents of a given interface type information
    // - only ancestors with an associated TGUID would be added
    // - if OnlyImplementedBy is not nil, only the interface explicitly
    // implemented by this class would be added, and AncestorsImplementedEntry[]
    // would contain the corresponding PInterfaceEntry values 
    procedure InterfaceAncestors(out Ancestors: PTypeInfoDynArray;
      OnlyImplementedBy: TInterfacedObjectClass;
      out AncestorsImplementedEntry: TPointerDynArray);
  end;

{$ifdef FPC}
{$PACKRECORDS 1}
{$else}
{$A-}
{$endif}
................................................................................
    /// this overriden constructor will release all its nested
    // TPersistent class published properties
    destructor Destroy; override;
  end;

  {$endif LVCL}




  /// abstract TPersistent class, which will instantiate all its nested TPersistent
  // class published properties, then release them (and any T*ObjArray) when freed
  // - TSynAutoCreateFields is to be preferred in most cases, due to its lower overhead
  // - note that non published (e.g. public) properties won't be instantiated
  // - please take care that you would not create any endless recursion: you
  // should ensure that at one level, nested published properties won't have any
  // class instance matching its parent type
................................................................................
  end;
  {$M-}

  /// abstract factory class targetting a single kind of interface
  TInterfaceResolverForSingleInterface = class(TInterfaceResolver)
  protected
    fInterfaceTypeInfo: PTypeInfo;
    fInterfaceAncestors: PTypeInfoDynArray;
    fInterfaceAncestorsImplementationEntry: TPointerDynArray;
    fImplementationEntry: PInterfaceEntry;
    fImplementationClass: TInterfacedObjectClass;
    fImplementationClassIsCustomCreate: boolean;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    function CreateInstance: TInterfacedObject; virtual;
  public
    /// this overriden constructor will check and store the supplied class
................................................................................
  // and doing the instance resolution using the overloaded Resolve*() methods
  // - TServiceContainer will inherit from this class, as the main entry point
  // for interface-based services of the framework (via TSQLRest.Services)
  // - you can use RegisterGlobal() class method to define some process-wide DI
  TInterfaceResolverInjected = class(TInterfaceResolver)
  protected
    fResolvers: TInterfaceResolverObjArray;
    fResolversToBeReleased: TInterfaceResolverObjArray;
    fDependencies: TInterfacedObjectObjArray;
    function TryResolve(aInterface: PTypeInfo; out Obj): boolean; override;
    class function RegisterGlobalCheck(aInterface: PTypeInfo;
      aImplementationClass: TClass): PInterfaceEntry;
  public
    /// define a global class type for interface resolution
    // - most of the time, you would need a local DI/IoC resolution list; but
................................................................................
    /// prepare and setup interface DI/IoC resolution with some blank
    // TInterfaceStub specified by their TGUID
    procedure InjectStub(const aStubsByGUID: array of TGUID); overload; virtual;
    /// prepare and setup interface DI/IoC resolution with TInterfaceResolver
    // kind of factory
    // - e.g. a customized TInterfaceStub/TInterfaceMock, a TServiceContainer,
    // a TDDDRepositoryRestObjectMapping or any factory class
    // - by default, only TInterfaceStub/TInterfaceMock would be owned by this
    // instance, and released by Destroy - unless you set OwnOtherResolvers
    procedure InjectResolver(const aOtherResolvers: array of TInterfaceResolver;
      OwnOtherResolvers: boolean=false); overload; virtual;
    /// prepare and setup interface DI/IoC resolution from a TInterfacedObject instance
    // - any TInterfacedObject declared as dependency will have its reference
    // count increased, and decreased in Destroy
    procedure InjectInstance(const aDependencies: array of TInterfacedObject); overload; virtual;
    /// can be used to perform an DI/IoC for a given interface
    // - will search for the supplied interface to its internal list of resolvers
    // - returns TRUE and set the Obj variable with a matching instance
................................................................................
    // ! if fServer.Services['Calculator'].Get(Calc)) then
    // !   ...
    // - safer typical use, following the DI/IoC pattern, and which would not
    // trigger any access violation if Services=nil, could be:
    // ! if fServer.Services.Resolve(ICalculator,Calc) then
    // !   ...
    property Services: TServiceContainer read fServices;
    /// access or initialize the internal IoC resolver, used for interface-based
    // remote services, and more generaly any Services.Resolve() call
    // - create and initialize the internal TServiceContainer if no service
    // interface has been registered yet
    // - may be used to inject some dependencies, which are not interface-based
    // remote services, but internal IoC, without the ServiceRegister()
    // or ServiceDefine() methods - e.g.
    // ! aRest.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(aRest)],true);
    // - overriden methods would return TServiceContainerClient or
    // TServiceContainerServer instances, on TSQLRestClient or TSQLRestServer
    function ServiceContainer: TServiceContainer; virtual; abstract;
    /// the routing classs of the service remote request
    // - by default, will use TSQLRestRoutingREST, i.e. an URI-based
    // layout which is secure (since will use our RESTful authentication scheme),
    // and also very fast
    // - but TSQLRestRoutingJSON_RPC can e.g. be set (on BOTH client and
    // server sides), if the client would rather use JSON/RPC alternative pattern
    // - NEVER set the abstract TSQLRestServerURIContext class on this property
................................................................................
      const aInterfaces: array of TGUID; const aContractExpected: RawUTF8=''): TServiceFactoryServer; overload;
    /// register a remote Service via its interface
    // - this method expects the interface(s) to have been registered previously:
    // ! TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyInterface),...]);
    function ServiceDefine(aClient: TSQLRest; const aInterfaces: array of TGUID;
      aInstanceCreation: TServiceInstanceImplementation=sicSingle;
      const aContractExpected: RawUTF8=''): boolean; overload;
    /// access or initialize the internal IoC resolver, used for interface-based
    // remote services, and more generaly any Services.Resolve() call
    // - create and initialize the internal TServiceContainerServer if no
    // service interface has been registered yet
    // - may be used to inject some dependencies, which are not interface-based
    // remote services, but internal IoC, without the ServiceRegister()
    // or ServiceDefine() methods - e.g.
    // ! aRest.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(aRest)],true);
    // - this overriden method would return a TServiceContainerServer instance
    function ServiceContainer: TServiceContainer; override;

    /// compute the full statistics about this server, as JSON
    // - is a wrapper around the Stats() method-based service, setting withall=1
    function FullStatsAsJson: RawUTF8; virtual;
    /// compute the full statistics about this server, as a TDocVariant document
    // - is a wrapper around the Stats() method-based service, setting withall=1
    function FullStatsAsDocVariant: variant;
................................................................................
      out ResultID: TIDDynArray): boolean; overload; virtual;
    /// search for a field value, according to its SQL content representation
    // - return true on success (i.e. if some values have been added to ResultID)
    // - store the results into the ResultID dynamic array
    // - faster than OneFieldValues method, which creates a temporary JSON content
    function SearchField(const FieldName, FieldValue: RawUTF8;
      out ResultID: TIDDynArray): boolean; overload; virtual; abstract;
    /// access or initialize the internal IoC resolver
    // - this overriden method would return always nil, since IoC only makes
    // sense at TSQLRestClient and TSQLRestServer level
    function ServiceContainer: TServiceContainer; override;

    /// read only access to a boolean value set to true if table data was modified
    property Modified: boolean read fModified write fModified;
    /// read only access to the class defining the record type stored in this
    // REST storage
    property StoredClass: TSQLRecordClass read fStoredClass;
    /// read only access to the ORM properties of the associated record type
................................................................................
    /// end a transaction (calls REST END Member)
    // - by default, Client transaction will use here a pseudo session
    procedure Commit(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED;
      RaiseException: boolean=false); override;
    /// abort a transaction (calls REST ABORT Member)
    // - by default, Client transaction will use here a pseudo session
    procedure RollBack(SessionID: cardinal=CONST_AUTHENTICATION_NOT_USED); override;
    /// access or initialize the internal IoC resolver, used for interface-based
    // remote services, and more generaly any Services.Resolve() call
    // - create and initialize the internal TServiceContainerClient if no
    // service interface has been registered yet
    // - may be used to inject some dependencies, which are not interface-based
    // remote services, but internal IoC, without the ServiceRegister()
    // or ServiceDefine() methods - e.g.
    // ! aRest.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(aRest)],true);
    function ServiceContainer: TServiceContainer; override;

    /// if set to TRUE, all BLOB fields of all tables will be transferred
    // between the Client and the remote Server
    // - i.e. Add() Update() will use Blob-related RESTful PUT/POST request
    // - i.e. Retrieve() will use Blob-related RESTful GET request
    // - note that the Refresh method won't handle BLOB fields, even if this
    // property setting is set to TRUE
................................................................................
function TTypeInfo.InterfaceUnitName: PShortString;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    result := @NULL_SHORTSTRING else
    result := @PInterfaceTypeData(AlignToPtr(@Name[ord(Name[0])+1]))^.IntfUnit;
end;

function TTypeInfo.InterfaceAncestor: PTypeInfo;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    result := nil else
    with PInterfaceTypeData(AlignToPtr(@Name[ord(Name[0])+1]))^ do
      if IntfParent=nil then
        result := nil else
        result := IntfParent{$ifndef FPC}^{$endif};
end;

procedure TTypeInfo.InterfaceAncestors(out Ancestors: PTypeInfoDynArray;
  OnlyImplementedBy: TInterfacedObjectClass;
  out AncestorsImplementedEntry: TPointerDynArray);
var n: integer;
    nfo: PTypeInfo;
    typ: PInterfaceTypeData;
    entry: pointer;
begin
  if (@self=nil) or (Kind<>tkInterface) then
    exit;
  n := 0;
  typ := AlignToPtr(@Name[ord(Name[0])+1]);
  repeat
    if typ^.IntfParent=nil then
      exit;
    nfo := typ^.IntfParent{$ifndef FPC}^{$endif};
    if nfo=TypeInfo(IInterface) then
      exit;
    typ := AlignToPtr(@nfo^.Name[ord(nfo^.Name[0])+1]);
    if ifHasGuid in typ^.IntfFlags then begin
      if OnlyImplementedBy<>nil then begin
        entry := OnlyImplementedBy.GetInterfaceEntry(typ^.IntfGuid);
        if entry=nil then
          continue;
        Setlength(AncestorsImplementedEntry,n+1);
        AncestorsImplementedEntry[n] := entry;
      end;
      SetLength(Ancestors,n+1);
      Ancestors[n] := nfo;
      inc(n);
    end;
  until false;
end;


{ TClassProp }

function TClassProp.FieldProp(const PropName: shortstring): PPropInfo;
var i: integer;
begin
  if @self<>nil then begin
................................................................................
function TSQLRestClientURI.ServiceRegister(const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
begin
  result := False;
  if (self=nil) or (high(aInterfaces)<0) then
    exit;


  result := (ServiceContainer as TServiceContainerClient).AddInterface(
    aInterfaces,aInstanceCreation,aContractExpected);
end;

function TSQLRestClientURI.ServiceRegister(aInterface: PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactory;
begin
  result := nil;
  if (self=nil) or (aInterface=nil) then begin
    SetLastException;
    exit;
  end;


  with ServiceContainer as TServiceContainerClient do
  try
    result := AddInterface(aInterface,aInstanceCreation,aContractExpected);
  except
    on E: Exception do
      SetLastException(E);
  end;
end;
................................................................................
      ListUpdated.Free;
      ListDeleted.Free;
    end;
  finally
    fAcquireExecution[execORMWrite].Leave;
  end;
end;

function TSQLRestServer.ServiceContainer: TServiceContainer;
begin
  if fServices=nil then
    fServices := TServiceContainerServer.Create(self);
  result := fServices;
end;

function TSQLRestServer.RecordVersionSynchronizeSubscribeMaster(Table: TSQLRecordClass;
  RecordVersion: TRecordVersion; const SlaveCallback: IServiceRecordVersionCallback): boolean;
begin
  if self=nil then
    result := false else




    result := (ServiceContainer as TServiceContainerServer).
      RecordVersionSynchronizeSubscribeMaster(Model.GetTableIndexExisting(Table),
        RecordVersion,SlaveCallback);
end;

function TSQLRestServer.RecordVersionSynchronizeMasterStart(
  ByPassAuthentication: boolean): boolean;
var factory: TServiceFactory;
begin
  if Services<>nil then begin
................................................................................
end;

function TSQLRestServer.ServiceRegister(
  aImplementationClass: TInterfacedClass; const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactoryServer;
begin


  if (aImplementationClass=nil) or (high(aInterfaces)<0) then
    result := nil else
    result := (ServiceContainer as TServiceContainerServer).
      AddImplementation(aImplementationClass,aInterfaces,aInstanceCreation,nil,aContractExpected);
end;

function TSQLRestServer.ServiceRegister(aSharedImplementation: TInterfacedObject;
  const aInterfaces: array of PTypeInfo; const aContractExpected: RawUTF8): TServiceFactoryServer;
begin


  if (self=nil) or (aSharedImplementation=nil) or (high(aInterfaces)<0) then
    result := nil else
    result := (ServiceContainer as TServiceContainerServer).
      AddImplementation(TInterfacedClass(aSharedImplementation.ClassType),
        aInterfaces,sicShared,aSharedImplementation,aContractExpected);
end;

function TSQLRestServer.ServiceRegister(aClient: TSQLRest;
  const aInterfaces: array of PTypeInfo;
  aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): boolean;
begin
  result := False;
  if (self=nil) or (high(aInterfaces)<0) or (aClient=nil) then
    exit;


  result := (ServiceContainer as TServiceContainerServer).AddInterface(
    aInterfaces,aInstanceCreation,aContractExpected);
end;

function TSQLRestServer.ServiceDefine(aImplementationClass: TInterfacedClass;
  const aInterfaces: array of TGUID; aInstanceCreation: TServiceInstanceImplementation;
  const aContractExpected: RawUTF8): TServiceFactoryServer;
begin
................................................................................
  // nothing to do in this basic REST static class
end;

procedure TSQLRestStorage.EndCurrentThread(Sender: TThread);
begin // called by TSQLRestServer.EndCurrentThread
  // nothing to do in this basic REST static class
end;

function TSQLRestStorage.ServiceContainer: TServiceContainer;
begin
  result := nil;
end;

function TSQLRestStorage.CreateSQLMultiIndex(Table: TSQLRecordClass;
  const FieldNames: array of RawUTF8; Unique: boolean; IndexName: RawUTF8): boolean;
begin
  result := false; // not implemented in this basic REST static class
end;

................................................................................
      exit;
    Res.GetRowValues(0,TInt64DynArray(DataID));
    result := true;
  finally
    Res.Free;
  end;
end;

function TSQLRestClient.ServiceContainer: TServiceContainer;
begin
  if fServices=nil then
    fServices := TServiceContainerClient.Create(self);
  result := fServices;
end;


{ TSQLRecordLog }

destructor TSQLRecordLog.Destroy;
begin
  fLogTableWriter.Free;
................................................................................
  guid := aInterface^.InterfaceGUID;
  if guid=nil then
    raise EInterfaceResolverException.CreateUTF8('%.Create expects an Interface',[self]);
  fImplementationEntry := aImplementation.GetInterfaceEntry(guid^);
  if fImplementationEntry=nil then
    raise EInterfaceResolverException.CreateUTF8('%.Create: % does not implement %',
      [self,aImplementation,fInterfaceTypeInfo^.Name]);
  aInterface^.InterfaceAncestors(fInterfaceAncestors,aImplementation,
    fInterfaceAncestorsImplementationEntry);
  fImplementationClass := aImplementation;
  fImplementationClassIsCustomCreate :=
    aImplementation.InheritsFrom(TInterfacedObjectWithCustomCreate);
end;

constructor TInterfaceResolverForSingleInterface.Create(const aInterface: TGUID;
  aImplementation: TInterfacedObjectClass);
................................................................................
  if not fImplementationClassIsCustomCreate then
    result := fImplementationClass.Create else
    result := TInterfacedObjectWithCustomCreateClass(fImplementationClass).Create;
end;

function TInterfaceResolverForSingleInterface.GetOneInstance(out Obj): boolean;
begin
  if self=nil then
    result := false else
    // here we now that CreateInstance will implement the interface 
    result := GetInterfaceFromEntry(CreateInstance,fImplementationEntry,Obj);
end;

function TInterfaceResolverForSingleInterface.TryResolve(
  aInterface: PTypeInfo; out Obj): boolean;
var i: integer;
begin
  if fInterfaceTypeInfo=aInterface then
    result := GetOneInstance(Obj) else begin
    // if not found exact interface, try any parent/ancestor interface
    for i := 0 to length(fInterfaceAncestors)-1 do
      if fInterfaceAncestors[i]=aInterface then begin
        // here we now that CreateInstance will implement fInterfaceAncestors[]
        result := GetInterfaceFromEntry(
          CreateInstance,fInterfaceAncestorsImplementationEntry[i],Obj);
        exit;
      end;
    result := false;

  end;
end;


{ TInterfaceResolverInjected }

var
  GlobalInterfaceResolutionLock: TRTLCriticalSection;
................................................................................
var i: integer;
begin
  for i := 0 to high(aStubsByGUID) do
    InjectResolver([TInterfaceStub.Create(aStubsByGUID[i])]);
end;

procedure TInterfaceResolverInjected.InjectResolver(
  const aOtherResolvers: array of TInterfaceResolver;
  OwnOtherResolvers: boolean);
var i: integer;
begin
  for i := 0 to high(aOtherResolvers) do
  if aOtherResolvers[i]<>nil then begin
    if aOtherResolvers[i].InheritsFrom(TInterfaceStub) then begin
      include(TInterfaceStub(aOtherResolvers[i]).fOptions,
        imoFakeInstanceWontReleaseTInterfaceStub);
      ObjArrayAdd(fResolversToBeReleased,aOtherResolvers[i]);
    end else
    if OwnOtherResolvers then
      ObjArrayAdd(fResolversToBeReleased,aOtherResolvers[i]);
    ObjArrayAddOnce(fResolvers,aOtherResolvers[i]);
  end;
end;

procedure TInterfaceResolverInjected.InjectInstance(
  const aDependencies: array of TInterfacedObject);
var i: integer;
................................................................................
  end;
end;

destructor TInterfaceResolverInjected.Destroy;
var i: integer;
begin
  try
    ObjArrayClear(fResolversToBeReleased);
    for i := 0 to length(fDependencies)-1 do
      IInterface(fDependencies[i])._Release;
  finally
    inherited Destroy;
  end;
end;

class function TSynTestCase.RandomIdentifier(CharCount: Integer): RawByteString;
const CHARS: array[0..36] of AnsiChar =
  'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_';
begin
  SetString(result,nil,CharCount);
  while CharCount>0 do begin
    result[CharCount] := CHARS[Random(High(CHARS))];
    dec(CharCount);

  end;
end;

class function TSynTestCase.RandomUTF8(CharCount: Integer): RawUTF8;
begin
  result := WinAnsiToUtf8(WinAnsiString(RandomString(CharCount)));
end;

class function TSynTestCase.RandomIdentifier(CharCount: Integer): RawByteString;
const CHARS: array[0..36] of AnsiChar =
  'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_';
begin
  SetString(result,nil,CharCount);
  while CharCount>0 do begin

    dec(CharCount);
    PAnsiChar(Pointer(result))[CharCount] := CHARS[Random(High(CHARS)+1)];
  end;
end;

class function TSynTestCase.RandomUTF8(CharCount: Integer): RawUTF8;
begin
  result := WinAnsiToUtf8(WinAnsiString(RandomString(CharCount)));
end;

'1.18.1386'

'1.18.1387'