;; 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 client-widget)
  #:use-module (gi)
  #:use-module (gi types)
  #:use-module (gi util)
  #:use-module (gi repository)
  #: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 (ice-9 control)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-19)
  #:use-module (webid-oidc errors)
  #:use-module (webid-oidc web-i18n)
  #:use-module ((webid-oidc parameters) #:prefix p:)
  #:use-module ((webid-oidc stubs) #:prefix stubs:)
  #:use-module ((webid-oidc oidc-id-token) #:prefix id:)
  #:use-module ((webid-oidc jwk) #:prefix jwk:)
  #:use-module ((webid-oidc config) #:prefix config:)
  #:use-module (webid-oidc client)
  #:use-module (webid-oidc client accounts)
  #:use-module ((webid-oidc client gui settings) #:prefix settings:)
  #:use-module (webid-oidc client gui application-hooks)
  #:use-module (web uri)
  #:use-module (web response)
  #:use-module (rnrs bytevectors)
  #:use-module (oop goops)
  #:duplicates (merge-generics)
  #:export
  (
   client-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 client-widget #f)

(define (build-client-widget app)
  (unless client-widget
    (set! builder
          (builder:new-from-file (string-append config:uidir "/client-widget.glade")))
    (set! client-widget
          (builder:get-object builder "client_widget"))
    (let ((client-id-entry
           (builder:get-object builder "client_id_entry"))
          (redirect-uri-entry
           (builder:get-object builder "redirect_uri_entry"))
          (key-pair-entry
           (builder:get-object builder "key_pair_entry"))
          (generate-key-pair-button
           (builder:get-object builder "generate_key_pair_button"))
          (undo-button
           (builder:get-object builder "undo_button"))
          (update-button
           (builder:get-object builder "update_button")))
      (define (current-edition)
        ;; Return the client based on the edited fields
        (let/ec return
          (with-exception-handler
              (lambda (exn)
                ((@ (ice-9 format) format)
                 (current-error-port)
                 (G_ "The client cannot be constructed: ~a\n")
                 (if (exception-with-message? exn)
                     (exception-message exn)
                     exn))
                (return #f))
            (lambda ()
              ((@ (oop goops) make) <client>
                #:client-id (entry:get-text client-id-entry)
                #:redirect-uri (entry:get-text redirect-uri-entry)
                #:key-pair
                (jwk:jwk->key (stubs:json-string->scm (entry:get-text key-pair-entry))))))))
      (define (on-entry-changed . _)
        (let ((current-client (settings:client))
              (edited (current-edition)))
          (receive (can-undo? can-update?)
              (cond
               ((and edited (equal? edited current-client))
                ;; The undo button is disabled and the update button too
                (values #f #f))
               (edited
                ;; We have changed something and it’s valid
                (values #t #t))
               (else
                ;; We have changed something, but it’s invalid
                (values #t #f)))
            (widget:set-sensitive undo-button can-undo?)
            (widget:set-sensitive update-button can-update?))))
      (define (set-client client)
        (entry:set-text client-id-entry (uri->string (client-id client)))
        (entry:set-text redirect-uri-entry (uri->string (redirect-uri client)))
        (entry:set-text key-pair-entry
                        (stubs:scm->json-string
                         (jwk:key->jwk (key-pair client))))
        (on-entry-changed))
      ((@ (gi) connect) client-id-entry activate on-entry-changed)
      ((@ (gi) connect) redirect-uri-entry activate on-entry-changed)
      ((@ (gi) connect) key-pair-entry activate on-entry-changed)
      ((@ (gi) connect)
       generate-key-pair-button clicked
       (lambda _
         (entry:set-text key-pair-entry
                         (stubs:scm->json-string
                          (jwk:key->jwk
                           (jwk:generate-key #:n-size 2048))))
         (on-entry-changed)))
      ((@ (gi) connect) undo-button clicked
       (lambda _
         (set-client (settings:client))
         (on-entry-changed)))
      ((@ (gi) connect) update-button clicked
       (lambda _
         (settings:client (current-edition))
         (widget:set-sensitive undo-button #f)
         (widget:set-sensitive update-button #f)))
      (set-client (settings:client))
      (add-hook! settings:client-changed-hook
                 (lambda (c)
                   (unless (widget:get-sensitive? undo-button)
                     ;; If we were doing an edition, ignore
                     (set-client c)))))))

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