The server hosting your application responded with code ~a.
") (response-code response)) xml->sxml))))) (let ((json-data (stubs:json-string->scm response-body))) (let ((new-client-id (assq-ref json-data 'client_id)) (redirect-uris (assq-ref json-data 'redirect_uris))) (unless (string? new-client-id) (raise-exception (make-exception (make-exception-with-message (G_ "the client manifest does not have a client_id field")) (make-user-message (call-with-input-string (format #f (W_ "
The server hosting your application does not behave correctly, because it lacks the client_id field.
")) xml->sxml))))) (set! redirect-uris (let fix-redirect-uris ((redirect-uris redirect-uris)) (match redirect-uris ((? vector? (= vector->list redirect-uris)) redirect-uris) ((? list? redirect-uris) (map fix-redirect-uris redirect-uris)) ((? string? (= string->uri (? uri? uri))) uri) (anything anything)))) (set! new-client-id (match new-client-id ((? string? (= string->uri (? uri? uri))) uri) (anything anything))) (unless redirect-uris (raise-exception (make-exception (make-exception-with-message (G_ "the client manifest does not have a redirect_uris field")) (make-user-message (call-with-input-string (format #f (W_ "
The server hosting your application does not behave correctly, because it lacks the redirect_uris field.
")) xml->sxml))))) (unless new-client-id (raise-exception (make-exception (make-exception-with-message (G_ "the client manifest does not have a client_id field")) (make-user-message (call-with-input-string (format #f (W_ "
The server hosting your application does not behave correctly, because it lacks the client_id field.
")) xml->sxml))))) (unless (equal? client-id new-client-id) (raise-exception (make-exception (make-inconsistent-client-manifest) (make-exception-with-message (format #f (G_ "the client manifest under ~s has a client_id of ~s") (uri->string client-id) (uri->string new-client-id))) (make-user-message (call-with-input-string (format #f (W_ "
The application you want to use does not control the domain name it appears to represent.
")) xml->sxml))))) (do-initialize new-client-id redirect-uris))))))) (else (unless (uri? client-id) (scm-error 'wrong-type-arg "make" (G_ "#:client-id should be an URI") '() (list client-id))) (unless (let check-redirect-uris ((redirect-uris redirect-uris)) (match redirect-uris (() #t) (((? uri?) redirect-uris ...) (check-redirect-uris redirect-uris)))) (scm-error 'wrong-type-arg "make" (G_ "#:redirect-uris should be a list of URIs") '() (list redirect-uri))) (slot-set! client 'client-id client-id) (slot-set! client 'redirect-uris redirect-uris)))))) (define (check-redirect mf uris redir) (match uris (() (let ((final-message (format #f (G_ "the client manifest does not allow ~s as a redirection uri") (uri->string redir))) (final-user-message (call-with-input-string (format #f (W_ "The application wants to get your authorization through ~a, which is not approved.
") (call-with-output-string (cute sxml->xml `(*TOP* ,(uri->string redir)) <>))) xml->sxml))) (raise-exception (make-exception (make-unauthorized-redirect-uri) (make-exception-with-message final-message) (make-user-message final-user-message))))) (((? (cute equal? <> redir) redir) _ ...) #t) ((_ uris ...) (check-redirect mf uris redir)))) (define-method (check-redirect-uri (mf