;; 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 application)
  #: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
  (
   ->widget
   ))

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

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

(define-method (->widget (client <client>))
  (let ((builder
         (builder:new-from-file (string-append config:uidir "/client-widget.glade"))))
    (let ((whole-widget
           (builder:get-object builder "client_widget"))
          (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 (undo)
        (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)))))
      (define (disable)
        (widget:set-sensitive client-id-entry #f)
        (widget:set-sensitive redirect-uri-entry #f)
        (widget:set-sensitive key-pair-entry #f)
        (widget:set-sensitive generate-key-pair-button #f)
        (widget:set-sensitive undo-button #f)
        (widget:set-sensitive update-button #f))
      (undo)
      (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))))))
      (connect undo-button clicked (lambda _ (undo)))
      (connect update-button clicked
               (lambda _
                 (disable)
                 (let ((new-client
                        ((@ (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))))))
                   (settings:application-state
                    (set-client (settings:application-state) new-client)))))
      (values builder whole-widget))))