summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/client/client.scm
diff options
context:
space:
mode:
authorVivien Kraus <vivien@planete-kraus.eu>2021-09-12 22:57:58 +0200
committerVivien Kraus <vivien@planete-kraus.eu>2021-09-14 16:06:43 +0200
commit328b4957d05fc9b0f9ff87f2a4932ae0296ab069 (patch)
tree2d44b7896c91f9934b470fd6bb54141ddc4dc714 /src/scm/webid-oidc/client/client.scm
parent6a83b79c4de5986ad61a552c2612b7cce0105cda (diff)
Restructure the client API
The client API had several problems: - using records instead of GOOPS means that we aren’t flexible enough to introduce accounts protected by a password, for a multi-user application; - saving the user database to disk means we can’t have a proper immutable API; - it was difficult to predict when the users database would change, and inform the user interface about this change; - it had two different ways to negociate an access token, one when we had a refresh token and one when we did not; - it was supposed to either use account objects or a subject / issuer pair, now we only use account objects.
Diffstat (limited to 'src/scm/webid-oidc/client/client.scm')
-rw-r--r--src/scm/webid-oidc/client/client.scm92
1 files changed, 92 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/client/client.scm b/src/scm/webid-oidc/client/client.scm
new file mode 100644
index 0000000..66f8b74
--- /dev/null
+++ b/src/scm/webid-oidc/client/client.scm
@@ -0,0 +1,92 @@
+;; 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 client)
+ #:use-module (webid-oidc errors)
+ #:use-module (webid-oidc provider-confirmation)
+ #:use-module (webid-oidc oidc-configuration)
+ #:use-module (webid-oidc oidc-id-token)
+ #:use-module (webid-oidc dpop-proof)
+ #:use-module (webid-oidc web-i18n)
+ #:use-module ((webid-oidc jwk) #:prefix jwk:)
+ #:use-module ((webid-oidc parameters) #:prefix p:)
+ #:use-module ((webid-oidc stubs) #:prefix stubs:)
+ #:use-module ((webid-oidc config) #:prefix cfg:)
+ #:use-module ((webid-oidc client accounts) #:prefix client:)
+ #:use-module (web uri)
+ #:use-module (web client)
+ #:use-module (web request)
+ #:use-module (web response)
+ #:use-module (web server)
+ #:use-module (web http)
+ #:use-module (ice-9 optargs)
+ #:use-module (ice-9 receive)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-26)
+ #:use-module (rnrs bytevectors)
+ #:use-module (ice-9 i18n)
+ #:use-module (ice-9 getopt-long)
+ #:use-module (ice-9 suspendable-ports)
+ #:use-module (ice-9 match)
+ #:use-module (sxml simple)
+ #:use-module (oop goops)
+ #:export
+ (
+ <client>
+ client-id
+ client-key-pair
+ client-redirect-uri
+
+ client
+ )
+ #:declarative? #t)
+
+(define-class <client> ()
+ (client-id #:init-keyword #:client-id #:getter client-id)
+ (key-pair #:init-keyword #:key-pair #:getter client-key-pair)
+ (redirect-uri #:init-keyword #:redirect-uri #:getter client-redirect-uri))
+
+(define-method (initialize (client <client>) initargs)
+ (next-method)
+ (let-keywords
+ initargs #t
+ ((client-id #f)
+ (key-pair #t) ;; We’ll generate one if not #f
+ (redirect-uri #f))
+ (let convert-args ((client-id client-id)
+ (key-pair key-pair)
+ (redirect-uri redirect-uri))
+ (match `(,client-id ,key-pair ,redirect-uri)
+ (((or (? string? (= string->uri (? uri? client-id)))
+ (? uri? client-id))
+ (? jwk:jwk? client-key)
+ (or (? string? (= string->uri (? uri? redirect-uri)))
+ (? uri? redirect-uri)))
+ (begin
+ (slot-set! client 'client-id client-id)
+ (slot-set! client 'key-pair client-key)
+ (slot-set! client 'redirect-uri redirect-uri)))
+ ((_ #t _)
+ (convert-args client-id (jwk:generate-key #:n-size 2048) redirect-uri))
+ (else
+ (scm-error 'wrong-type-arg "make <account>"
+ (G_ "Client ID and redirect URIs should be URIs, and key pair should be a key pair..")
+ '()
+ (list client-id key-pair redirect-uri)))))))
+
+(define client
+ (make-parameter #f))