;; disfluid, implementation of the Solid specification
;; Copyright (C) 2021  Vivien Kraus

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.

;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(define-module (webid-oidc client gui accounts-widget)
  #:use-module (gi)
  #:use-module (gi types)
  #:use-module (gi util)
  #:use-module (ice-9 match)
  #:use-module (ice-9 exceptions)
  #:use-module (ice-9 i18n)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 pretty-print)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-19)
  #:use-module (srfi srfi-26)
  #:use-module (webid-oidc errors)
  #:use-module ((webid-oidc stubs) #:prefix stubs:)
  #:use-module ((webid-oidc config) #:prefix config:)
  #:use-module (webid-oidc web-i18n)
  #:use-module (webid-oidc client client)
  #:use-module (webid-oidc client accounts)
  #:use-module (webid-oidc client gui account-widget)
  #:use-module ((webid-oidc client gui settings) #:prefix settings:)
  #:use-module (webid-oidc client gui application-hooks)
  #:use-module (webid-oidc jwk)
  #:use-module (webid-oidc oidc-id-token)
  #:use-module (web uri)
  #:use-module (web response)
  #:use-module (rnrs bytevectors)
  #:use-module (oop goops)
  #:declarative? #t
  #:duplicates (merge-generics)
  #:export
  (
   accounts-widget
   ))

(push-duplicate-handler! 'merge-generics)

;; This avoids a crash when compiling the module
(use-typelibs ("GdkPixbuf" "2.0")
              ("Gtk" "3.0"))

(define builder #f)
(define accounts-widget #f)

(define current-main-child '())
(define current-other-children '())

(define (build-accounts-widget app)
  (unless accounts-widget
    (set! builder
          (builder:new-from-file (string-append config:uidir "/accounts-widget.glade")))
    (set! accounts-widget
          (builder:get-object builder "accounts_widget"))
    (let ((main-account-box
           (builder:get-object builder "main_account_box"))
          (other-accounts-box
           (builder:get-object builder "other_accounts_box"))
          (identity-provider-entry
           (builder:get-object builder "identity_provider_entry"))
          (add-account-button
           (builder:get-object builder "add_account_button")))
      (define (set-accounts main other)
        (for-each
         (match-lambda
           ((_ widget)
            (container:remove main-account-box widget)))
         current-main-child)
        (set! current-main-child '())
        (for-each
         (match-lambda
           ((_ widget)
            (container:remove other-accounts-box widget)))
         current-other-children)
        (set! current-other-children '())
        (receive (main-builder main-widget discard-button use-button)
            (make-account-widget main)
          (set! current-main-child
                `((,main-builder ,main-widget)))
          (when discard-button
            ((@ (gi) connect) discard-button clicked
             (lambda _
               (match other
                 ((new-main new-other ...)
                  (settings:main-account new-main)
                  (settings:other-accounts new-other))
                 (()
                  (settings:main-account #f))))))
          (when use-button
            (widget:set-sensitive use-button #f))
          (box:pack-end main-account-box main-widget #t #t 0))
        (for-each
         (lambda (other-account)
           (let ((not-represented (filter (lambda (a) (not (eq? a other-account)))
                                          other)))
             ;; We’re packing a widget for other-account, and if the
             ;; discard button is clicked, replace the list of other
             ;; accounts with not-represented.
             (receive (builder widget discard-button use-button)
                 (make-account-widget other-account)
               (set! current-other-children
                     `((,builder ,widget) ,@current-other-children))
               ((@ (gi) connect) discard-button clicked
                (lambda _
                  (settings:other-accounts not-represented)))
               ((@ (gi) connect) use-button clicked
                (lambda _
                  (settings:main-account other-account)
                  (settings:other-accounts `(,main ,@not-represented))))
               (box:pack-end main-account-box widget #t #t 0))))
         other)
        ((@ (gi) connect) add-account-button clicked
         (lambda _
           (define (as-host-name host)
             (false-if-exception
              (build-uri 'https #:host host)))
           (match (entry:get-text identity-provider-entry)
             ((or (? string? (= string->uri (? uri? uri)))
                  (? string? (= as-host-name (? uri? uri))))
              ((@ (ice-9 format) format) (current-error-port) (G_ "Stub: adding an account with identity provider ~s...\n")
                      (uri->string uri))
              (entry:set-text identity-provider-entry ""))
             (else
              ((@ (ice-9 format) format) (current-error-port) (G_ "Stub: please enter an URI or a host name...\n"))))))
        ((@ (gi) connect) identity-provider-entry activate
         (lambda _
           (button:clicked add-account-button))))
      (set-accounts (settings:main-account) (settings:other-accounts))
      (add-hook! settings:accounts-changed-hook set-accounts))))

(add-hook! application-activated-hook build-accounts-widget)