unit package;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, ButtonPanel, ExtCtrls, fpjson, types;

type
  TPackageRelease = record
    Version: String;
    Download: String;
    Notes: String;
    Time: String;
  end;

  TPackageReleases = array of TPackageRelease;

  TPackageData = class
  protected
    FReleases: TPackageReleases;
    FName: String;
    FOwner: String;
    FVersion: String;
    FPath: String;
    FAutoUpdate: Boolean;
    FURL: String;
  public
    property Releases: TPackageReleases read FReleases write FReleases;
    property Name: String read FName write FName;
    property Owner: String read FOwner write FOwner;
    property Version: String read FVersion write FVersion;
    property Path: String read FPath write FPath;
    property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate;
    property URL: String read FURL write FURL;

    procedure SaveToSettings;
    procedure Delete;

    function LoadFromSettings(Key: String): Boolean;
    function LoadFromURL(Force: Boolean = False): Boolean;

    function Install(Release: Int32): Boolean;
  end;

  TPackageForm = class(TForm)
    btnInstall: TButton;
    btnPanel: TButtonPanel;
    cbAutoUpdate: TCheckBox;
    comboVersions: TComboBox;
    editPath: TEdit;
    lblStatus: TLabel;
    lblSelectVersion: TLabel;
    lblVersion: TLabel;
    lblPath: TLabel;
    lbPackages: TListBox;
    memoReleaseNotes: TMemo;
    pnlTop: TPanel;
    pnlBottom: TPanel;
    btnAdd: TSpeedButton;
    btnRefresh: TSpeedButton;
    btnRemove: TSpeedButton;

    procedure packagedChanged(Sender: TObject; User: boolean);
    procedure comboVersionsChange(Sender: TObject);
    procedure comboVersionsDrawItem(Control: TWinControl; Index: Integer; R: TRect; State: TOwnerDrawState);
    procedure btnInstallClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
  protected
    FStatus: String;

    procedure __UpdateStatus;

    procedure Clear;
    procedure SetState(Enable: Boolean; Skip: array of TControl);

    function GetPackage(var Package: TPackageData): Boolean;
  public
    procedure UpdateStatus(Status: String);
    procedure UpdateDownloadStatus(Sender: TObject; const Size, Progress: Int64);
    procedure UpdateExtractStatus(Sender: TObject; const FilePath: String);

    constructor Create(TheOwner: TComponent); override;
  end;

var
  PackageForm: TPackageForm;

implementation

uses
  LCLType, newsimbasettings, dateutils, MufasaTypes, httpd, zipper,
  {$IFDEF VER3_0} fphttpclient {$warn we can delete the package internet files now!} {$ELSE} package_fphttpclient {$ENDIF};

type
  TDownloader = class(TThread)
  protected
    FURL: String;
    FData: TMemoryStream;
    FExtract: String;
    FResponseCode: Int32;

    procedure GetZipperStream(Sender: TObject; var Stream: TStream);

    function GetData: String;
    function GetResponseCode: Int32;

    procedure Execute; override;
  public
    property Data: String read GetData;
    property ResponseCode: Int32 read GetResponseCode;

    constructor Create(URL: String; Extract: String = '');
    destructor Destroy; override;
  end;

function TDownloader.GetData: String;
begin
  SetString(Result, PAnsiChar(FData.Memory), FData.Size);
end;

procedure TDownloader.Execute;
var
  Zipper: TUnZipper;
  Client: TFPHTTPClient;
  Archive, Disk: String;
begin
  Client := TFPHTTPClient.Create(nil);
  Client.AllowRedirect := True;
  Client.AddHeader('User-Agent', 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/64.0.3282.186 Safari/537.36');
  Client.OnDataReceived := @PackageForm.UpdateDownloadStatus;
  Client.OnDataReceived(nil, 0, 0);

  try
    Client.Get(FURL, FData);

    FResponseCode := Client.ResponseStatusCode;

    if (FResponseCode = HTTP_OK) and (FExtract <> '') then
    begin
      Zipper := TUnZipper.Create();

      try
        Zipper.OnOpenInputStream := @Self.GetZipperStream;
        Zipper.OnStartFile := @PackageForm.UpdateExtractStatus;
        Zipper.OutputPath := IncludeTrailingPathDelimiter(ExtractFilePath(FExtract));
        Zipper.Examine();

        Archive := ExtractFilePath(FExtract) + Zipper.Entries[0].ArchiveFileName;
        Disk := ExtractFilePath(FExtract) + ExtractFileName(FExtract);

        if DirectoryExists(Archive) and (not DeleteDirectory(Archive, False)) then
          WriteLn('TDownloader.Execute: Couldn''t delete archive');

        Zipper.Clear();
        Zipper.UnZipAllFiles();

        if (not RenameFileUTF8(Archive, Disk)) then
          WriteLn('TDownloader.Execute: Didn''t rename "', Archive, '" to "', Disk, '" - [', FileExistsUTF8(Archive), ', ', FileExistsUTF8(Disk), ']');
      finally
        Zipper.Free();
      end;
    end;
  except
    on e: Exception do
    begin
      WriteLn('TDownloader.Execute: ', e.ClassName, '::', e.Message);

      if (e is EHTTPClient) then
        FResponseCode := EHTTPClient(e).StatusCode;
    end;
  end;

  Client.Free();

  Terminate();
end;

function TDownloader.GetResponseCode: Int32;
begin
  while (not Terminated) do
  begin
    if (GetCurrentThreadID() = MainThreadID) then
      Application.ProcessMessages();

    Sleep(1);
  end;

  Result := FResponseCode;
end;

procedure TDownloader.GetZipperStream(Sender: TObject; var Stream: TStream);
begin
  FData.Position := 0;

  // The zipper will free this.
  Stream := TMemoryStream.Create();
  Stream.CopyFrom(FData, FData.Size);
end;

constructor TDownloader.Create(URL: String; Extract: String);
begin
  inherited Create(False);

  FResponseCode := -1;
  FURL := URL;
  FExtract := Extract;
  FData := TMemoryStream.Create();
end;

destructor TDownloader.Destroy;
begin
  FData.Free();

  inherited Destroy();
end;

procedure TPackageData.SaveToSettings;
begin
  SimbaSettings.MMLSettings.SetKeyValue('Packages/' + FName + '/Version', FVersion);
  SimbaSettings.MMLSettings.SetKeyValue('Packages/' + FName + '/URL', FURL);
  SimbaSettings.MMLSettings.SetKeyValue('Packages/' + FName + '/Path', FPath);
  SimbaSettings.MMLSettings.SetKeyValue('Packages/' + FName + '/AutoUpdate', BoolToStr(FAutoUpdate, True));
  SimbaSettings.MMLSettings.SetKeyValue('Packages/' + FName + '/Owner', FOwner);
  SimbaSettings.Save(SimbaSettingsFile);
end;

procedure TPackageData.Delete;
begin
  SimbaSettings.MMLSettings.DeleteKey('Packages/' + FName);
  SimbaSettings.Save(SimbaSettingsFile);
end;

function TPackageData.LoadFromSettings(Key: String): Boolean;
begin
  FName := Key;
  FVersion := SimbaSettings.MMLSettings.GetKeyValueDef('Packages/' + FName + '/Version', 'N/A');
  FURL := SimbaSettings.MMLSettings.GetKeyValue('Packages/' + FName + '/URL');
  FPath := SimbaSettings.MMLSettings.GetKeyValue('Packages/' + FName + '/Path');
  FOwner := SimbaSettings.MMLSettings.GetKeyValue('Packages/' + FName + '/Owner');
  FAutoUpdate := StrToBoolDef(SimbaSettings.MMLSettings.GetKeyValue('Packages/' + FName + '/AutoUpdate'), False);

  Exit(True);
end;

function TPackageData.LoadFromURL(Force: Boolean): Boolean;

   // if (assets <> nil) and (assets is TJSONArray) and (TJSONArray(assets).Count = 1) then
   //   custom := TJSONObject(TJSONArray(assets)[0]).Elements['browser_download_url']

  procedure AddRelease(JSON: TJSONObject);
  var
    Release: TPackageRelease;
  begin
    FillByte(Release, SizeOf(TPackageRelease), 0);

    try
      if (JSON.Elements['body'] <> nil) then
        Release.Notes := JSON.Elements['body'].AsString;
      if (JSON.Elements['tag_name'] <> nil) then
        Release.Version := JSON.Elements['tag_name'].AsString;
      if (JSON.Elements['zipball_url'] <> nil) then
        Release.Download := JSON.Elements['zipball_url'].AsString;
      if (JSON.Elements['created_at'] <> nil) then
      begin
        Release.Time := JSON.Elements['created_at'].AsString;

        System.Delete(Release.Time, Pos('T', Release.Time), 1);
        System.Delete(Release.Time, Pos('Z', Release.Time), 1);
      end;

      if (Release.Version <> '') and (Release.Download <> '') then
      begin
        SetLength(FReleases, Length(FReleases) + 1);
        Self.Releases[High(FReleases)] := Release;
      end;
    except
      on e: Exception do
        WriteLn('TPackageData.LoadFromURL: ', e.ClassName, '::', e.Message);
    end;
 end;

var
  Downloader: TDownloader;
  JSON: TJSONData;
  i: Int32;
begin
  if (Length(Self.Releases) = 0) or Force then
  begin
    Downloader := TDownloader.Create(Self.URL);

    if (Downloader.ResponseCode = HTTP_OK) then
    begin
      JSON := GetJSON(Downloader.Data);

      if (JSON <> nil) and (JSON is TJSONArray) then
      begin
        SetLength(FReleases, 0);

        with TJSONArray(JSON) do
          for i := 0 to Count - 1 do
            AddRelease(Objects[i]);

        if (Length(FReleases) = 0) then
          PackageForm.UpdateStatus('ERROR: No releases found');
      end else
        PackageForm.UpdateStatus('ERROR: Invalid JSON');

      if (JSON <> nil) then
        JSON.Free();
    end else
      PackageForm.UpdateStatus('ERROR: Could not access API: ' + IntToStr(Downloader.ResponseCode));

    Downloader.Free();
  end;

  Result := Length(FReleases) > 0;
end;

function TPackageData.Install(Release: Int32): Boolean;
var
  Downloader: TDownloader;
begin
  if (Release < Length(FReleases)) then
  begin
    if DirectoryExistsUTF8(FPath + FName + '.old') and (not DeleteDirectory(FPath + FName + '.old', False)) then
      PackageForm.UpdateStatus('ERROR: Couldn''t delete old package');
    if DirectoryExistsUTF8(FPath + FName) and (not RenameFileUTF8(FPath + FName, FPath + FName + '.old')) then
      PackageForm.UpdateStatus('ERROR: Couldn''t rename package to old');

    if (not FileExistsUTF8(FPath + FName)) then
    begin
      Downloader := TDownloader.Create(FReleases[Release].Download, FPath + FName);

      try
        if (Downloader.GetResponseCode() = HTTP_OK) then
        begin
          if DirectoryExistsUTF8(FPath + FName) then
          begin
            FVersion := FReleases[Release].Version;

            SaveToSettings();

            PackageForm.UpdateStatus('Succesfully installed package "' + FName + '"');

            Exit(True);
          end else
            PackageForm.UpdateStatus('ERROR: Failed to extract package');
        end;
      finally
        Downloader.Free();
      end;
    end;
  end;

  Exit(False);
end;

procedure TPackageForm.comboVersionsChange(Sender: TObject);
var
  Package: TPackageData;
  i: Int32;
begin
  memoReleaseNotes.Clear();
  memoReleaseNotes.Font.Italic := True;
  memoReleaseNotes.Text := '(no release notes)';

  if GetPackage(Package) then
  begin
    for i := 0 to high(Package.Releases) do
      if (Package.Releases[i].Version = comboVersions.Text) and (Package.Releases[i].Notes <> '') then
      begin
        memoReleaseNotes.Font.Italic := False;
        memoReleaseNotes.Text := package.releases[i].Notes;
      end;
  end;
end;

procedure TPackageForm.comboVersionsDrawItem(Control: TWinControl; Index: Integer; R: TRect; State: TOwnerDrawState);
var
  TimeSpan: String;
begin
  with Control as TComboBox do
  begin
    if (odSelected in State) then
    begin
      Canvas.Pen.Color := clHighlight;
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText;
    end else
    begin
      Canvas.Pen.Color := clWindow;
      Canvas.Brush.Color := clWindow;
      Canvas.Font.Color := clWindowText;

      if (not Control.Enabled) then
        Canvas.Font.Color := clGrayText;
    end;

    Canvas.Rectangle(R);
    Canvas.Font.Italic := False;
    Canvas.TextOut(R.Left + 2, R.Top, Items[Index]);

    if (Items.Objects[Index] <> nil) then
    begin
      TimeSpan := '(' + IntToStr(Int32(Items.Objects[Index])) + ' days ago)';

      case Int32(Items.Objects[Index]) of
        0: TimeSpan := '(today)';
        1: TimeSpan := '(yesterday)';
      end;

      Canvas.Font.Italic := True;
      Canvas.TextOut(R.Left + Canvas.TextWidth(Items[Index] + ' ') + 2, R.Top, TimeSpan);
    end;
  end;
end;

procedure TPackageForm.btnInstallClick(Sender: TObject);
var
  Package: TPackageData;
begin
  if GetPackage(Package) then
  begin
    SetState(False, []);

    try
      if (comboVersions.Items.IndexOf(comboVersions.Text) >= 0) then
      begin
        Package.Path := IncludeTrailingPathDelimiter(editPath.Text);
        Package.Install(comboVersions.Items.IndexOf(comboVersions.Text));

        lbPackages.OnSelectionChange(Self, False);
      end;
    finally
      SetState(True, []);
    end;
  end;
end;

procedure TPackageForm.btnRemoveClick(Sender: TObject);
var
  Package: TPackageData;
begin
  if GetPackage(Package) then
  begin
    Package.Delete();

    lbPackages.Items.Delete(lbPackages.ItemIndex);
    lbPackages.OnSelectionChange(Self, False);
  end;
end;

procedure TPackageForm.packagedChanged(Sender: TObject; User: boolean);
var
  Package: TPackageData;
  i: Int32;
begin
  if GetPackage(Package) then
  begin
    if (Length(Package.Releases) = 0) then
    begin
       SetState(False, []);

       try
         if Package.LoadFromURL() then
           PackageForm.UpdateStatus('');
       finally
         SetState(True, []);
       end;
    end;

    if (Length(Package.Releases) > 0) then
    begin
      comboVersions.Clear();
      comboVersions.Items.BeginUpdate();

      for i := 0 to High(Package.Releases) do
      try
        comboVersions.Items.AddObject(Package.Releases[i].Version, TObject(DaysBetween(Now(),  ScanDateTime('yyyy-mm-ddhh:nn:ss', Package.Releases[i].Time))));
      except
        comboVersions.Items.Add(Package.Releases[i].Version);
      end;

      comboVersions.Text := comboVersions.Items[0];
      comboVersions.OnChange(nil);
      comboVersions.Items.EndUpdate();

      lblVersion.Caption := 'Installed Version: ' + Package.Version;

      editPath.Text := Package.Path;

      SetState(True, []);
    end else
    begin
      memoReleaseNotes.Font.Italic := True;
      memoReleaseNotes.Text := '(unknown)';

      comboVersions.Items.Add('(unknown)');
      comboVersions.Text := comboVersions.Items[0];

      SetState(True, []);
      SetState(False, [btnRefresh, lbPackages]);
    end;
  end else
  begin
    SetState(False, [lbPackages]);

    Clear();
  end;
end;

procedure TPackageForm.btnAddClick(Sender: TObject);
var
  URL: String;
  Path: TStringList;
  Package: TPackageData;
begin
  URL := 'https://github.com/';

  if InputQuery('New Package', 'Git Repository URL:', URL) then
  begin
    Path := TStringList.Create();
    Path.Delimiter := '/';
    Path.DelimitedText := URL;
    while (Path.Count > 2) do
      Path.Delete(0);

    if (Path.Count = 2) then
    begin
      Package := TPackageData.Create();
      Package.Owner := Path[0];
      Package.Name := Path[1];
      Package.URL := Format('https://api.github.com/repos/%s/%s/releases', [Package.Owner, Package.Name]);
      Package.Version := 'N/A';
      Package.Path := IncludeTrailingPathDelimiter(CreateRelativePath(SimbaSettings.Includes.Path.Value, GetCurrentDirUTF8()));

      try
        SetState(False, []);

        if Package.LoadFromURL() then
        begin
          lbPackages.AddItem(Package.Name, Package);
          lbPackages.ItemIndex := lbPackages.Count - 1;

          UpdateStatus('Added package "' + Package.Name + '"');
        end else
          Package.Free();
      finally
        SetState(True, []);
      end;
    end else
      UpdateStatus('ERROR: Invalid URL entered');

    Path.Free();
  end;
end;

procedure TPackageForm.btnRefreshClick(Sender: TObject);
var
  Package: TPackageData;
begin
  if GetPackage(Package) then
  try
    SetState(False, []);

    Package.LoadFromURL(True);
  finally
    SetState(True, []);
  end;
end;

procedure TPackageForm.__UpdateStatus;
begin
  lblStatus.Caption := FStatus;
end;

procedure TPackageForm.Clear;
begin
  memoReleaseNotes.Text := '';
  comboVersions.Text := '';;
  editPath.Text := '';
  lblVersion.Caption:= 'Installed Version:';
  cbAutoUpdate.Checked := False;
end;

procedure TPackageForm.SetState(Enable: Boolean; Skip: array of TControl);

  function isSkip(Control: TControl): Boolean;
  var
    i: Int32;
  begin
    for i := 0 to High(Skip) do
      if Control.Equals(Skip[i]) then
        Exit(True);

    Exit(False);
  end;

  procedure StateSetting(Control: TWinControl);
  var
    i: Int32;
  begin
    if (Control.Tag = 0) and (not isSkip(Control)) then
      Control.Enabled := Enable;

    for i := 0 to Control.ControlCount - 1 do
      if (Control.Controls[i] is TWinControl) and (Control.Controls[i].Tag = 0) then
        StateSetting(Control.Controls[i] as TWinControl);
  end;

begin
  StateSetting(Self);
end;

function TPackageForm.GetPackage(var Package: TPackageData): Boolean;
begin
  if (lbPackages.ItemIndex >= 0) then
  begin
    Package := lbPackages.Items.Objects[lbPackages.ItemIndex] as TPackageData;

    Exit(True);
  end;

  Exit(False);
end;

procedure TPackageForm.UpdateStatus(Status: String);
begin
  if Visible then
  begin
    FStatus := Status;

    TThread.Synchronize(nil, @__UpdateStatus);
  end;
end;

procedure TPackageForm.UpdateDownloadStatus(Sender: TObject; const Size, Progress: Int64);
begin
  if (Size = 0) then
    UpdateStatus('Connecting...')
  else
    UpdateStatus('Downloading... ' + IntToStr(Round((Progress / Size) * 100)) + '%');
end;

procedure TPackageForm.UpdateExtractStatus(Sender: TObject; const FilePath: String);
var
  i, Current, Total: Int32;
begin
  Current := 0;
  Total := 0;

  with Sender as TUnZipper do
  begin
    for i := 0 to Entries.Count - 1 do
    begin
      if (not Entries[i].IsLink) and (not Entries[i].IsDirectory) then
      begin
        Inc(Total);
        if (Entries[i].ArchiveFileName = Copy(FilePath, Length(OutputPath) + 1, $FFFFFF)) then
          Current := Total;
      end;
    end;

    UpdateStatus('Extracting... ' + IntToStr(Current) + '/' + IntToStr(Total));
  end;
end;

constructor TPackageForm.Create(TheOwner: TComponent);
var
  i: Int32;
  Packages: TStringArray;
  Package: TPackageData;
begin
  inherited Create(TheOwner);

  with lbPackages do
  begin
    Font.Size := 10;

    ItemHeight := lbPackages.Canvas.TextHeight('TaylorSwift') + 4;

    TStringList(Items).OwnsObjects := True;
  end;

  SimbaSettings.MMLSettings.ListKeys('Packages', Packages);

  for i := 0 to High(Packages) do
  begin
    Package := TPackageData.Create();
    Package.LoadFromSettings(Packages[i]);

    lbPackages.AddItem(Package.Name, Package);
  end;

  SetState(False, [lbPackages]);
end;

initialization
  {$I package.lrs}

end.