/// shared DDD Infrastructure: User CQRS Repository via ORM
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit dddInfraRepoUser;

{
    This file is part of Synopse mORMot framework.

    Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2022
  the Initial Developer. All Rights Reserved.

  Contributor(s):

  
  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

}

{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER

interface

uses
  SysUtils,
  Classes,
  SynCommons,
  SynCrypto,
  SynTests,
  SynTable, // for TSynFilter and TSynValidate
  mORMot,
  mORMotDDD,
  dddDomUserTypes,
  dddDomUserCQRS;


{ *********** 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 SelectAll: 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;

  /// implements a Factory of User CQRS Repositories via mORMot's RESTful ORM
  // - this class will associate the TUser Aggregate Root with a TSQLRecordUser
  // ORM table, as managed in a given TSQLRest instance
  TInfraRepoUserFactory = class(TDDDRepositoryRestFactory)
  public
    /// initialize the association with the ORM
    constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager=nil); reintroduce;
  	/// perform some tests on this Factory/Repository implementation
    class procedure RegressionTests(test: TSynTestCase);
  end;


{ *********** Person / User / Customer Persistence ORM classes }

type
  /// ORM class able to store a TPerson object
  // - the TPerson.Name property has been flattened to Name_* columns as
  // expected by TDDDRepositoryRestFactory.ComputeMapping
  TSQLRecordPerson = class(TSQLRecord)
  protected
    fFirst: RawUTF8;
    fMiddle: RawUTF8;
    fLast: RawUTF8;
    fBirthDate: TDateTime;
  published
    property Name_First: RawUTF8 read fFirst write fFirst;
    property Name_Middle: RawUTF8 read fMiddle write fMiddle;
    property Name_Last: RawUTF8 read fLast write fLast;
    property Birth: TDateTime read fBirthDate;
  end;

  /// ORM class able to store a TPersonContactable object
  // - the TPersonContactable.Address property has been flattened to Address_*
  // columns as expected by TDDDRepositoryRestFactory.ComputeMapping
  TSQLRecordPersonContactable = class(TSQLRecordPerson)
  protected
    fStreet1: RawUTF8;
    fStreet2: RawUTF8;
    fCityArea: RawUTF8;
    fCity: RawUTF8;
    fRegion: RawUTF8;
    fCode: RawUTF8;
    fCountry: integer;
    fEmail: RawUTF8;
    fPhone1: RawUTF8;
    fPhone2: RawUTF8;
  published
    property Address_Street1: RawUTF8 read fStreet1 write fStreet1;
    property Address_Street2: RawUTF8 read fStreet2 write fStreet2;
    property Address_CityArea: RawUTF8 read fCityArea write fCityArea;
    property Address_City: RawUTF8 read fCity write fCity;
    property Address_Region: RawUTF8 read fRegion write fRegion;
    property Address_Code: RawUTF8 read fCode write fCode;
    property Address_Country: integer read fCountry;
    property Phone1: RawUTF8 read fPhone1 write fPhone1;
    property Phone2: RawUTF8 read fPhone2 write fPhone2;
    property Email: RawUTF8 read fEmail write fEmail;
  end;

  /// ORM class used to persist a TUser domain aggregate
  TSQLRecordUser = class(TSQLRecordPersonContactable)
  protected
    fLogonName: RawUTF8;
    fEmailValidated: TDomUserEmailValidation;
  published
    property LogonName: RawUTF8 read fLogonName write fLogonName stored AS_UNIQUE;
    property EmailValidated: TDomUserEmailValidation read fEmailValidated write fEmailValidated;
  end;


  
implementation

{ TInfraRepoUser }

{ in practice, implementing a I*Command interface mainly consist in calling
  the various TDDDRepositoryRestCommand.ORM*() methods, which would perform
  all process on the REST instance using the TSQLRecordUser table mapped to
  the TUser aggregate root
  - purpose of this I*Command interface is to use the loosely typed
    TDDDRepositoryRestCommand.ORM*() methods to match the exact needs of
    the DDD Aggregate class
  - it would also hide the persistence details so that we would be able
    to ignore e.g. what a primary key is, and avoid the "anemic domain model"
    anti-pattern, which is basically CRUD in disguise }

function TInfraRepoUser.SelectByLogonName(
  const aLogonName: RawUTF8): TCQRSResult;
begin
  result := ORMSelectOne('LogonName=?',[aLogonName],(aLogonName=''));
end;

function TInfraRepoUser.SelectByEmailValidation(
  aValidationState: TDomUserEmailValidation): TCQRSResult;
begin
  result := ORMSelectAll('EmailValidated=?',[ord(aValidationState)]);
end;

function TInfraRepoUser.SelectByLastName(const aName: TLastName;
  aStartWith: boolean): TCQRSResult;
begin
  if aStartWith then
    result := ORMSelectAll('Name_Last LIKE ?',[aName+'%'],(aName='')) else
    result := ORMSelectAll('Name_Last=?',[aName],(aName=''));
end;

function TInfraRepoUser.SelectAll: TCQRSResult;
begin
  result := ORMSelectAll('',[]);
end;

function TInfraRepoUser.Get(out aAggregate: TUser): TCQRSResult;
begin
  result := ORMGetAggregate(aAggregate);
end;

function TInfraRepoUser.GetAll(
  out aAggregates: TUserObjArray): TCQRSResult;
begin
  result := ORMGetAllAggregates(aAggregates);
end;

function TInfraRepoUser.GetNext(out aAggregate: TUser): TCQRSResult;
begin
  result := ORMGetNextAggregate(aAggregate);
end;

function TInfraRepoUser.Add(const aAggregate: TUser): TCQRSResult;
begin
  result := ORMAdd(aAggregate);
end;

function TInfraRepoUser.Update(
  const aUpdatedAggregate: TUser): TCQRSResult;
begin
  result := ORMUpdate(aUpdatedAggregate);
end;

function TInfraRepoUser.HowManyValidatedEmail: integer;
begin
  if ORMSelectCount('EmailValidated=%',[ord(evValidated)],[],result)<>cqrsSuccess then
    result := 0;
end;


{ TInfraRepoUserFactory }

constructor TInfraRepoUserFactory.Create(aRest: TSQLRest;
  aOwner: TDDDRepositoryRestManager);
begin
  inherited Create(IDomUserCommand,TInfraRepoUser,TUser,aRest,TSQLRecordUser,aOwner);
  AddFilterOrValidate(['*'],TSynFilterTrim.Create);
  AddFilterOrValidate(['LogonName'],TSynValidateNonVoidText.Create);
end;

class procedure TInfraRepoUserFactory.RegressionTests(test: TSynTestCase);

procedure TestOne(Rest: TSQLRest);
const MAX=1000;
      MOD_EMAILVALID=ord(high(TDomUserEmailValidation))+1;
var cmd: IDomUserCommand;
    qry: IDomUserQuery;
    user: TUser;
    users: TUserObjArray;
    i,usersCount: 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;
      user.Name.First := 'First'+itext;
      user.Address.Street1 := 'Street '+itext;
      user.Address.Country.Alpha2 := 'fr';
      user.Phone1 := itext;
      test.check(cmd.Add(user)=cqrsSuccess);
    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.LogonName=itext);
      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
      usersCount := 0;
      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);
        inc(usersCount,length(users));
        for i := 0 to high(users) do begin
          test.Check(users[i].EmailValidated=v);
          test.Check(users[i].LogonName=users[i].Phone1);
          test.Check(users[i].Name.First='First'+users[i].LogonName);
        end;
      end;
      test.Check(cmd.DeleteAll=cqrsSuccess,'delete all evFailed');
      test.check(cmd.Commit=cqrsSuccess);
      ObjArrayClear(users);
      test.Check(cmd.SelectAll=cqrsSuccess);
      test.Check(cmd.GetAll(users)=cqrsSuccess);
      test.Check(length(users)=usersCount-count[evFailed]);
      for i := 0 to high(users) do begin
        test.Check(users[i].LogonName=users[i].Phone1);
        test.Check(users[i].Name.First='First'+users[i].LogonName);
        test.Check(users[i].Address.Country.Iso=250);
      end;
    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(user.EmailValidated=v);
        test.Check(user.Name.First='First'+user.LogonName);
        test.Check(user.Address.Country.Iso=250);
        inc(i);
      end;
      test.Check(i=cmd.GetCount);
    end;
    test.Check(cmd.HowManyValidatedEmail=count[evValidated]);
    user.LogonName := '';
    test.check(cmd.Add(user)=cqrsDDDValidationFailed);
    test.check(cmd.GetLastError=cqrsDDDValidationFailed);
    msg := cmd.GetLastErrorInfo.msg;
    test.check(pos('TUser.LogonName',msg)>0,msg);
  finally
    user.Free;
  end;
end;

var RestServer: TSQLRestServerFullMemory;
    RestClient: TSQLRestClientURI;
begin
  RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordUser]);
  try // first try directly on server side
    RestServer.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(RestServer)],true);
    TestOne(RestServer); // sub function will ensure that all I*Command are released
  finally
    RestServer.Free;
  end;
  RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordUser]);
  try // then try from a client-server process
    RestServer.ServiceContainer.InjectResolver([TInfraRepoUserFactory.Create(RestServer)],true);
    RestServer.ServiceDefine(TInfraRepoUser,[IDomUserCommand,IDomUserQuery],sicClientDriven);
    test.Check(RestServer.ExportServer);
    RestClient := TSQLRestClientURIDll.Create(TSQLModel.Create(RestServer.Model),@URIRequest);
    try
      RestClient.Model.Owner := RestClient;
      RestClient.ServiceDefine([IDomUserCommand],sicClientDriven);
      TestOne(RestServer);
      RestServer.DropDatabase;
      USEFASTMM4ALLOC := true; // for slightly faster process
      TestOne(RestClient);
    finally
      RestClient.Free;
    end;
  finally
    RestServer.Free;
  end;
end;



end.