;; This call registers a custom authenticator that expects a token
;; given in the request URI's query string.
(register-authenticator! 
 ;; This is just some identifier which bound to
 ;; (current-authenticator) in case this authenticator detects some
 ;; credentials.
 'token
 ;; This thunk is expected to return a non-#f value which is then
 ;; bound to (current-credentials), i.e. it should inspect the current
 ;; request for credentials and return those.
 (lambda ()
   (alist-ref 'token (uri-query (request-uri (current-request)))))
 ;; This handler procedure is called when an authentication or
 ;; authorization error has occured. 
 (lambda (continue)
   (send-response code: 401
                  reason: "Unauthorized"
                  body: (if (current-credentials)
                            "Invalid authentication token"
                            "Missing authentication token"))))


;; This parameter must be bound to a procedure that called when an
;; authenticator has found some credentials as described above. It
;; should return some non-#f value if the credentials are valid. This
;; return value is then bound to the (current-authentication)
;; parameter. If the credentials were invalid the corresponding
;; authenticator's error handler is called.
(authenticate
 (lambda ()
   (case (current-authenticator)
     ((http-basic http-digest)
      (apply check-user/password (current-credentials)))
     ((token)
      (check-token (current-credentials)))
     (else #f))))

;; This parameter sets up the realm for the stock HTTP authenticators
;; http-basic and http-digest.
(authentication-realm "Members Area")

;; This parameter defines the available authenticators identified by
;; the identifier given as the first argument to
;; register-authenticator! All authenticators will be tried in order
;; until one of them returns non-#f, otherwise the authentication
;; error handler of the first authenticator in this list is called.
;; Maybe this should be handled by another handler which can work out
;; the most appropriate authentication error handler to use depending
;; on the request? E.g. if it's an API client the token handler might
;; be more appropriate whereas for browsers http-digest's would be
;; best suited.
(available-authenticators '(http-basic http-digest token))

;; Finally, with-authentication is used to wrap spiffy handlers for
;; which authentication is required.
(with-authentication
 (lambda (continue)
   (send-response body: (sprintf "You are authenticated as ~A." 
                                 (current-authentication)))))

;; This call registers a custom authenticator that expects a token
;; given in the request URI's query string.
(register-authenticator! 
 ;; This is just some identifier which bound to
 ;; (current-authenticator) in case this authenticator detects some
 ;; credentials.
 'token

 ;; This thunk is expected to return a non-#f value which is then
 ;; bound to (current-credentials), i.e. it should inspect the current
 ;; request for credentials and return those.
 (lambda ()
   (alist-ref 'token (uri-query (request-uri (current-request)))))

 ;; This procedure is called when credentials have been found by the
 ;; authenticator. It should return some non-#f value if the
 ;; credentials are valid. This return value is then bound to the
 ;; (current-authentication) parameter. If the credentials were
 ;; invalid the authenticator's error handler is called (see below).
 (lambda ()
   (check-token (current-credentials)))

 ;; This handler procedure is called when either invalid or no
 ;; credentials at all have been found.
 (lambda (continue)
   (send-response code: 401
                  reason: "Unauthorized"
                  body: (if (current-credentials)
                            "Invalid authentication token"
                            "Missing authentication token"))))


;; This parameter must be bound to a credentials checking procedure in
;; order to use the stock HTTP authenticators http-basic and
;; http-digest. It works just like the third argument given to
;; register-authenticator!
(check-http-credentials
 (lambda ()
   (apply check-user/password (current-credentials))))

;; This parameter sets up the realm for the stock HTTP authenticators
;; http-basic and http-digest.
(authentication-realm "Members Area")

;; This parameter defines the available authenticators identified by
;; the identifier given as the first argument to
;; register-authenticator! All authenticators will be tried in order
;; until one of them returns non-#f, otherwise the authentication
;; error handler of the first authenticator in this list is called.
;; Maybe this should be handled by another handler which can work out
;; the most appropriate authentication error handler to use depending
;; on the request? E.g. if it's an API client the token handler might
;; be more appropriate whereas for browsers http-digest's would be
;; best suited.
(available-authenticators '(http-basic http-digest token))

;; Finally, with-authentication is used to wrap spiffy handlers for
;; which authentication is required.
(with-authentication
 (lambda (continue)
   (send-response body: (sprintf "You are authenticated as ~A." 
                                 (current-authentication)))))

Mandatory paste

another mandatory paste