;; 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)))))