unit WebModuleUnit1;
interface
uses
  System.SysUtils, System.Classes, Web.HTTPApp, Datasnap.DSHTTPCommon,
  Datasnap.DSHTTPWebBroker, Datasnap.DSServer,
  Datasnap.DSAuth, IndyPeerImpl, DbxSocketChannelNative, DbxCompressionFilter,
  Datasnap.DSCommonServer;

type
  TWebModule1 = class(TWebModule)
    DSHTTPWebDispatcher1: TDSHTTPWebDispatcher;
    DSServer1: TDSServer;
   DSAuthenticationManager1: TDSAuthenticationManager;
    DSServerClass1: TDSServerClass;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DSAuthenticationManager1UserAuthorize(Sender: TObject;
      EventObject: TDSAuthorizeEventObject; var valid: Boolean);
    procedure DSAuthenticationManager1UserAuthenticate(Sender: TObject;
      const Protocol, Context, User, Password: string; var valid: Boolean;
      UserRoles: TStrings);
    procedure WebModule1DefaultHandlerAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModuleClass: TComponentClass = TWebModule1;

implementation
uses
  ServerMethodsUnit1, Web.WebReq,
  CodeSiteLogging;

{$R *.dfm}

procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := '<html><heading/><body>DataSnap Server</body></html>';
end;

procedure TWebModule1.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit1.TMyServerMethods;
end;

procedure TWebModule1.DSAuthenticationManager1UserAuthenticate(
  Sender: TObject; const Protocol, Context, User, Password: string;
  var valid: Boolean; UserRoles: TStrings);
begin
  CodeSite.EnterMethod('OnUserAuthenticate');
  try
    CodeSite.Send('User: ' + User);
    CodeSite.Send('Password: ' + Password);
    CodeSite.Send('Protocol: ' + Protocol);
    CodeSite.Send('Context: ' + Context);

    valid := LowerCase(Protocol) <> 'http'; // don't allow http
    // TODO: check for User and Password

    if LowerCase(User) = 'bob' then
      UserRoles.Add('admin')
    else UserRoles.Add('guest');

  except
    on E: Exception do
      CodeSite.SendException(E);
  end;
  CodeSite.ExitMethod('OnUserAuthenticate ' + BoolToStr(valid));
end;

procedure TWebModule1.DSAuthenticationManager1UserAuthorize(
  Sender: TObject; EventObject: TDSAuthorizeEventObject; 
  var valid: Boolean);
var
  UserRole: String;
begin
  CodeSite.EnterMethod('OnUserAuthorize');

  CodeSite.Send('UserName: ' + EventObject.UserName);
  CodeSite.Send('UserRoles: ' +  EventObject.UserRoles.Text);
  if Assigned(EventObject.DeniedRoles) then
    CodeSite.Send('DeniedRoles: ' + EventObject.DeniedRoles.Text);
  if Assigned(EventObject.AuthorizedRoles) then
    CodeSite.Send('AuthorizedRoles: ' +  EventObject.AuthorizedRoles.Text);

  valid := True;
  if Assigned(EventObject.DeniedRoles) then
    for UserRole in EventObject.UserRoles do
      if EventObject.DeniedRoles.IndexOf(UserRole) >= 0 then valid := False;

  CodeSite.ExitMethod('OnUserAuthorize ' + BoolToStr(valid));
end;

initialization
finalization
  Web.WebReq.FreeWebModules;
end.

