diff --git a/README.md b/README.md index 91bdc3e..7846c41 100644 --- a/README.md +++ b/README.md @@ -69,6 +69,30 @@ chunk framing. Detect it with `chunked?` and decode it with _ ()) ``` +### Authentication + +`Auth` parses and builds the RFC 7235 headers: the credentials a client sends in +`Authorization`, and the challenges a server answers a 401 with in +`WWW-Authenticate`. One `WWW-Authenticate` value may carry several challenges. + +```clojure +(match (Auth.parse "Basic YWxhZGRpbjpvcGVuIHNlc2FtZQ==") + (Result.Success c) + (match (Auth.basic-credentials &c) + (Result.Success up) (println* (Pair.a &up) ":" (Pair.b &up)) + (Result.Error e) (IO.errorln &e)) + (Result.Error e) (IO.errorln &e)) + +(Auth.basic "aladdin" "open sesame") +; => (Success "Basic YWxhZGRpbjpvcGVuIHNlc2FtZQ==") +(Auth.bearer "mF_9.B5f-4.1JqM") ; => "Bearer mF_9.B5f-4.1JqM" + +(let [cs (Auth.parse-challenges "Basic realm=\"a\", Digest realm=\"b\"")] + (println* (Credentials.realm (Array.unsafe-nth &cs 1)))) ; => (Just "b") + +(Response.unauthorized (Auth.basic-challenge "WallyWorld") {} @"go away") +``` + ### Status codes ```clojure @@ -88,6 +112,8 @@ Status.not-found ; => 404 | `Status` | Status code constants and reason phrases | | `Form` | URL-encoded form body parser | | `MediaType` | `Content-Type` / media-type parser (type, subtype, parameters) | +| `Auth` | `Authorization` / `WWW-Authenticate` parser and builder (RFC 7235) | +| `Credentials` | one authentication scheme with its token68 or auth-params | | `Multipart` | `multipart/form-data` body decoder | | `FormPart` | a single decoded multipart part (name, filename, content-type, body) | | `TransferEncoding` | Chunked transfer-encoding decoder | diff --git a/docs/Response.html b/docs/Response.html index 8fdbf8c..b729531 100644 --- a/docs/Response.html +++ b/docs/Response.html @@ -793,6 +793,30 @@

+
+ +

+ unauthorized +

+ +
+ defn +
+

+ (Fn [String, (Map String (Array String)), String] Response) +

+ 
+                        (unauthorized challenge headers body)
+
+

+

builds a 401 Unauthorized response carrying challenge +as its WWW-Authenticate header, which RFC 7235 §3.1 requires of every 401, +with headers and body. A WWW-Authenticate in headers is replaced. Build +challenge with Auth.basic-challenge or +Credentials.str.

+ +

+

diff --git a/http.carp b/http.carp index b3f1839..71e72e7 100644 --- a/http.carp +++ b/http.carp @@ -1,3 +1,4 @@ +(load "git@github.com:carpentry-org/base64.carp@0.2.0") (load "git@github.com:carpentry-org/uri@0.1.0") (load "git@github.com:carpentry-org/time@0.5.0") (load "git@github.com:carpentry-org/strbuf@0.1.0") @@ -819,7 +820,18 @@ one adds none.") `Status.found`), a `Location` header of `location`, `headers`, and an empty body. A `Location` in `headers` is replaced.") (defn redirect [code location headers] - (set-header (respond code headers @"") @"Location" location))) + (set-header (respond code headers @"") @"Location" location)) + + (doc unauthorized "builds a `401 Unauthorized` response carrying `challenge` +as its `WWW-Authenticate` header, which RFC 7235 §3.1 requires of every 401, +with `headers` and `body`. A `WWW-Authenticate` in `headers` is replaced. Build +`challenge` with [Auth.basic-challenge](#basic-challenge) or +[Credentials.str](#str).") + (defn unauthorized [challenge headers body] + (set-header + (respond Status.unauthorized headers body) + @"WWW-Authenticate" + challenge))) (doc Form "provides URL-encoded form body parsing and serialization. @@ -1204,6 +1216,301 @@ numeric.") (doc private? "whether the `private` response directive is present.") (defn private? [m] (has? m "private"))) +(doc Credentials "is one RFC 7235 §2.1 `credentials` or `challenge`: an +authentication `scheme` followed by either a `token68` (`token`, e.g. the base64 +blob of a `Basic` credential) or a list of auth-`params`. Both productions have +the same grammar, so this one type models the `Authorization` and the +`WWW-Authenticate` side alike. + +`scheme` is kept as written and compared case-insensitively. Param names are +lower-cased and their values unquoted; `params` holds them in header order.") +(deftype Credentials + [scheme String + token String + params (Array (Pair String String))]) + +(defmodule Credentials + (doc scheme-is? "whether the scheme is `name`, compared case-insensitively as +RFC 7235 §2.1 requires.") + (defn scheme-is? [c name] + (= &(String.ascii-to-lower (scheme c)) &(String.ascii-to-lower name))) + + (doc param "looks up auth-param `name` (case-insensitive), returning +`(Maybe String)`.") + (defn param [c name] + (let-do [lname (String.ascii-to-lower name) + ps (params c) + len (Array.length ps) + i 0 + found (Maybe.Nothing)] + (while (and (< i len) (Maybe.nothing? &found)) + (let-do [p (Array.unsafe-nth ps i)] + (when (= (Pair.a p) &lname) (set! found (Maybe.Just @(Pair.b p)))) + (set! i (Int.inc i)))) + found)) + + (doc realm "the `realm` auth-param, as `(Maybe String)`.") + (defn realm [c] (param c "realm")) + + (hidden quote-value) + (private quote-value) + ; wraps `v` in double quotes, backslash-escaping `"` and `\`. + (defn quote-value [v] + (let-do [bs (String.to-bytes v) + len (Array.length &bs) + out (the (Array Byte) []) + quot (Char.to-byte \") + esc (Char.to-byte \\)] + (Array.push-back! &out quot) + (for [i 0 len] + (let-do [b @(Array.unsafe-nth &bs i)] + (when (or (= b quot) (= b esc)) (Array.push-back! &out esc)) + (Array.push-back! &out b))) + (Array.push-back! &out quot) + (String.from-bytes &out))) + + (doc str "serializes back into a header value, which parses back into an equal +`Credentials`. A `token` takes precedence over `params`, since RFC 7235 allows +only one of the two. Param values are always quoted, which the grammar permits +for any of them.") + (defn str [c] + (let-do [sb (StringBuf.create)] + (StringBuf.append-str &sb (scheme c)) + (if (String.empty? (token c)) + (for [i 0 (Array.length (params c))] + (let-do [p (Array.unsafe-nth (params c) i)] + (if (= i 0) + (StringBuf.append-char &sb \space) + (StringBuf.append-str &sb ", ")) + (StringBuf.append-str &sb (Pair.a p)) + (StringBuf.append-char &sb \=) + (StringBuf.append-str &sb &(quote-value (Pair.b p))))) + (do + (StringBuf.append-char &sb \space) + (StringBuf.append-str &sb (token c)))) + (let-do [s (StringBuf.to-string &sb)] (StringBuf.delete sb) s))) + (implements str Credentials.str)) + +(doc Auth "parses and builds HTTP authentication headers (RFC 7235): the +`Authorization` and `Proxy-Authorization` credentials a client sends, and the +`WWW-Authenticate` and `Proxy-Authenticate` challenges a server answers a 401 or +407 with. The `Basic` (RFC 7617) and `Bearer` (RFC 6750) schemes have dedicated +helpers. + +``` +(match (Auth.parse \"Basic YWxhZGRpbjpvcGVuIHNlc2FtZQ==\") + (Result.Success c) + (match (Auth.basic-credentials &c) + (Result.Success up) (println* (Pair.a &up) \":\" (Pair.b &up)) + (Result.Error e) (IO.errorln &e)) + (Result.Error e) (IO.errorln &e)) +```") +(defmodule Auth + (hidden tchar?) + (private tchar?) + ; whether `c` is an RFC 7230 tchar, i.e. may appear in a bare token. + (defn tchar? [c] + (or (Char.alphanum? c) (> (String.index-of "!#$%&'*+-.^_`|~" c) -1))) + + (hidden token68-char?) + (private token68-char?) + ; whether `c` may appear in an RFC 7235 token68, which allows `/`. + (defn token68-char? [c] (or (tchar? c) (= c \/))) + + (hidden space?) + (private space?) + (defn space? [c] (let [i (Char.to-int c)] (or (= i 32) (= i 9)))) + + (hidden skip-ows) + (private skip-ows) + (defn skip-ows [s i len] + (let-do [j i] + (while (and (< j len) (space? (String.char-at s j))) (set! j (Int.inc j))) + j)) + + (hidden scan-token) + (private scan-token) + (defn scan-token [s i len] + (let-do [j i] + (while (and (< j len) (tchar? (String.char-at s j))) (set! j (Int.inc j))) + j)) + + (hidden scan-token68) + (private scan-token68) + (defn scan-token68 [s i len] + (let-do [j i] + (while (and (< j len) (token68-char? (String.char-at s j))) + (set! j (Int.inc j))) + j)) + + (hidden scan-padding) + (private scan-padding) + (defn scan-padding [s i len] + (let-do [j i] + (while (and (< j len) (= (String.char-at s j) \=)) (set! j (Int.inc j))) + j)) + + (hidden scan-quoted) + (private scan-quoted) + ; scans the quoted-string at `i`, pairing the index just past it with its + ; unescaped contents; an unterminated string runs to the end of `s`. + (defn scan-quoted [s i len] + (let-do [j (Int.inc i) + out (the (Array Byte) []) + done false] + (while (and (< j len) (not done)) + (let [c (String.char-at s j)] + (cond + (= c \") (do (set! done true) (set! j (Int.inc j))) + (and (= c \\) (< (Int.inc j) len)) + (do + (Array.push-back! &out + (Char.to-byte (String.char-at s (Int.inc j)))) + (set! j (+ j 2))) + (do (Array.push-back! &out (Char.to-byte c)) (set! j (Int.inc j)))))) + (Pair.init j (String.from-bytes &out)))) + + (hidden scan) + (private scan) + ; a bare token directly after a scheme is that scheme's token68; anywhere else + ; it opens a new challenge. Bytes that fit nowhere are dropped. + (defn scan [s] + (let-do [len (String.length s) + i 0 + out (the (Array Credentials) []) + scheme @"" + token @"" + ps (the (Array (Pair String String)) []) + open false + token68-ok false] + (while (< i len) + (let [c (String.char-at s i)] + (cond + (space? c) (set! i (Int.inc i)) + (= c \,) (do (set! token68-ok false) (set! i (Int.inc i))) + (not (if token68-ok (token68-char? c) (tchar? c))) + (set! i (Int.inc i)) + (let-do [tend (if token68-ok + (scan-token68 s i len) + (scan-token s i len)) + name (String.byte-slice s i tend) + j (skip-ows s tend len) + eq (and (< j len) (= (String.char-at s j) \=)) + k (if eq (skip-ows s (Int.inc j) len) j) + quoted (and eq (and (< k len) (= (String.char-at s k) \"))) + valued (and eq + (and (< k len) (tchar? (String.char-at s k))))] + (cond + (or quoted valued) + (let-do [v (if quoted + (scan-quoted s k len) + (Pair.init (scan-token s k len) @"")) + vend @(Pair.a &v)] + (when open + (Array.push-back! &ps + (Pair.init (String.ascii-to-lower &name) + (if quoted + @(Pair.b &v) + (String.byte-slice s k vend))))) + (set! token68-ok false) + (set! i vend)) + (and eq token68-ok) + (let-do [pend (scan-padding s j len)] + (set! token (String.byte-slice s i pend)) + (set! token68-ok false) + (set! i pend)) + eq + (do + (when open + (Array.push-back! &ps + (Pair.init (String.ascii-to-lower &name) + @""))) + (set! i (Int.inc j))) + token68-ok + (do (set! token @&name) (set! token68-ok false) (set! i tend)) + (do + (when open + (Array.push-back! &out + (Credentials.init @&scheme @&token @&ps))) + (set! scheme @&name) + (set! token @"") + (set! ps []) + (set! open true) + (set! token68-ok true) + (set! i tend))))))) + (when open + (Array.push-back! &out (Credentials.init @&scheme @&token @&ps))) + out)) + + (doc parse-challenges "parses a `WWW-Authenticate` or `Proxy-Authenticate` +value into its challenges, in header order. One header value may carry several +challenges, and a challenge may carry no params at all. Bytes that fit the +grammar nowhere are dropped rather than rejected, so this never fails.") + (defn parse-challenges [s] (scan s)) + + (doc parse "parses an `Authorization` or `Proxy-Authorization` value into the +one set of credentials it may carry. Fails when there is no scheme, or when more +than one scheme is present.") + (defn parse [s] + (let [cs (scan s)] + (cond + (Array.empty? &cs) (Result.Error (fmt "malformed credentials: '%s'" s)) + (> (Array.length &cs) 1) + (Result.Error (fmt "more than one scheme in credentials: '%s'" s)) + (Result.Success @(Array.unsafe-nth &cs 0))))) + + (doc basic "builds an RFC 7617 `Basic` `Authorization` value from `user` and +`password`. Fails when `user` contains a colon, which the scheme cannot +represent; a `password` may contain any number of them.") + (defn basic [user password] + (if (> (String.index-of user \:) -1) + (Result.Error @"a Basic user-id may not contain a colon") + (Result.Success + (fmt "Basic %s" &(Base64.encode-str &(fmt "%s:%s" user password)))))) + + (doc basic-credentials "decodes RFC 7617 `Basic` credentials into a user and +password `Pair`, splitting on the first colon. Fails when the scheme is not +`Basic`, the base64 does not decode, or the decoded value has no colon.") + (defn basic-credentials [c] + (if (not (Credentials.scheme-is? c "Basic")) + (Result.Error (fmt "not Basic credentials: '%s'" (Credentials.scheme c))) + (match (Base64.decode-str (Credentials.token c)) + (Result.Error e) (Result.Error e) + (Result.Success decoded) + (let [colon (String.index-of &decoded \:)] + (if (< colon 0) + (Result.Error @"Basic credentials have no colon") + (Result.Success + (Pair.init (String.byte-slice &decoded 0 colon) + (String.byte-slice &decoded + (Int.inc colon) + (String.length &decoded))))))))) + + (doc bearer "builds an RFC 6750 `Bearer` `Authorization` value from `token`.") + (defn bearer [token] (fmt "Bearer %s" token)) + + (doc bearer-token "the token of RFC 6750 `Bearer` credentials. Fails when the +scheme is not `Bearer`, or when the token is empty.") + (defn bearer-token [c] + (cond + (not (Credentials.scheme-is? c "Bearer")) + (Result.Error + (fmt "not Bearer credentials: '%s'" (Credentials.scheme c))) + (String.empty? (Credentials.token c)) (Result.Error @"empty Bearer token") + (Result.Success @(Credentials.token c)))) + + (doc basic-challenge "builds a `Basic` `WWW-Authenticate` challenge for +`realm`.") + (defn basic-challenge [realm] + (Credentials.str + &(Credentials.init @"Basic" @"" [(Pair.init @"realm" @realm)]))) + + (doc bearer-challenge "builds a `Bearer` `WWW-Authenticate` challenge for +`realm`.") + (defn bearer-challenge [realm] + (Credentials.str + &(Credentials.init @"Bearer" @"" [(Pair.init @"realm" @realm)])))) + (doc FormPart "is a single part decoded from a `multipart/form-data` body: the field `name`, an optional `filename` (present for file uploads), an optional `content-type`, and the raw `body`.") diff --git a/test/http.carp b/test/http.carp index 6e01cab..c736584 100644 --- a/test/http.carp +++ b/test/http.carp @@ -136,6 +136,82 @@ (defn cookie-roundtrip [c] (Cookie.parse-set &(Cookie.set &c))) +; ---- auth test helpers ---- +; renders parsed challenges as `scheme token/name=value`, joined by `|` +(defn chal-summary [s] + (let-do [cs (Auth.parse-challenges s) + sb (StringBuf.create)] + (for [i 0 (Array.length &cs)] + (let-do [c (Array.unsafe-nth &cs i)] + (when (> i 0) (StringBuf.append-char &sb \|)) + (StringBuf.append-str &sb (Credentials.scheme c)) + (unless-do (String.empty? (Credentials.token c)) + (StringBuf.append-char &sb \space) + (StringBuf.append-str &sb (Credentials.token c))) + (for [j 0 (Array.length (Credentials.params c))] + (let-do [p (Array.unsafe-nth (Credentials.params c) j)] + (StringBuf.append-char &sb \/) + (StringBuf.append-str &sb (Pair.a p)) + (StringBuf.append-char &sb \=) + (StringBuf.append-str &sb (Pair.b p)))))) + (let-do [r (StringBuf.to-string &sb)] (StringBuf.delete sb) r))) + +(defn chal-count [s] (Array.length &(Auth.parse-challenges s))) + +(defn chal-realm [s i] + (let [cs (Auth.parse-challenges s)] + (if (<= (Array.length &cs) i) + @"" + (Maybe.from (Credentials.realm (Array.unsafe-nth &cs i)) @"")))) + +(defn auth-roundtrip [s] + (let-do [cs (Auth.parse-challenges s) + sb (StringBuf.create)] + (for [i 0 (Array.length &cs)] + (do + (when (> i 0) (StringBuf.append-str &sb ", ")) + (StringBuf.append-str &sb &(Credentials.str (Array.unsafe-nth &cs i))))) + (let-do [r (StringBuf.to-string &sb)] (StringBuf.delete sb) r))) + +(defn auth-scheme-is? [s name] + (match (Auth.parse s) + (Result.Success c) (Credentials.scheme-is? &c name) + (Result.Error _) false)) + +(defn basic-parts [s] + (match (Auth.parse s) + (Result.Error e) e + (Result.Success c) + (match (Auth.basic-credentials &c) + (Result.Error e) e + (Result.Success up) (fmt "%s/%s" (Pair.a &up) (Pair.b &up))))) + +(defn bearer-of [s] + (match (Auth.parse s) + (Result.Error e) e + (Result.Success c) + (match (Auth.bearer-token &c) (Result.Error e) e (Result.Success t) t))) + +(defn auth-verdict [s] + (match (Auth.parse s) (Result.Success _) @"" (Result.Error e) e)) + +(defn basic-header [u p] + (match (Auth.basic u p) (Result.Success h) h (Result.Error e) e)) + +(defn basic-header-roundtrip [u p] (basic-parts &(basic-header u p))) + +(defn repeated [s n] + (let-do [sb (StringBuf.create)] + (for [i 0 n] (StringBuf.append-str &sb s)) + (let-do [r (StringBuf.to-string &sb)] (StringBuf.delete sb) r))) + +(defn unauthorized-header [challenge headers] + (Maybe.from + (Response.header + &(Response.unauthorized challenge headers @"") + "WWW-Authenticate") + @"")) + (deftest test (assert-true test (match (Request.parse &simple-get) (Result.Success _) true _ false) @@ -1316,4 +1392,254 @@ &(expiry-verdict-at "id=abc; Expires=Fri, 24 Jul 2026 12:00:00 GMT" &(zoned 2026 7 24 11 @"EST" -18000l)) - "11:00 at UTC-5 is 16:00 GMT, after a 12:00 GMT expiry")) + "11:00 at UTC-5 is 16:00 GMT, after a 12:00 GMT expiry") + (assert-equal test + "Basic dXNlcjpwYXNz" + &(chal-summary "Basic dXNlcjpwYXNz") + "a bare token after a scheme parses as token68") + (assert-equal test + "Basic dXNlcjpwYXNz==" + &(chal-summary "Basic dXNlcjpwYXNz==") + "token68 keeps its trailing padding") + (assert-equal test + "Basic dTphYWE/" + &(chal-summary "Basic dTphYWE/") + "a token68 keeps a slash, which the token grammar excludes") + (assert-equal test + "Digest/realm=a|b" + &(chal-summary "Digest realm=a/b") + "the wider token68 alphabet does not reach an auth-param value") + (assert-equal test + "Digest/realm=a/qop=auth" + &(chal-summary "Digest realm=\"a\", qop=\"auth\"") + "commas between auth-params stay inside one challenge") + (assert-equal test + "Digest/algorithm=MD5/nc=1" + &(chal-summary "Digest algorithm=MD5, nc=1") + "auth-param values may be bare tokens") + (assert-equal test + "Digest/qop=auth,auth-int" + &(chal-summary "Digest qop=\"auth,auth-int\"") + "a comma inside a quoted-string does not split the list") + (assert-equal test + "Newauth/realm=apps/type=1/title=Login to \"apps\"|Basic/realm=simple" + &(chal-summary + "Newauth realm=\"apps\", type=1, title=\"Login to \\\"apps\\\"\", Basic realm=\"simple\"") + "the RFC 7235 §4.1 example splits into two challenges") + (assert-equal test + "Basic/realm=a|Bearer|Digest/realm=b" + &(chal-summary "Basic realm=\"a\", Bearer, Digest realm=\"b\"") + "a challenge with no params survives between two that have them") + (assert-equal test + 3 + (chal-count "Basic realm=\"a\", Bearer, Digest realm=\"b\"") + "three challenges are found where the middle one is bare") + (assert-equal test + "Digest/realm=say \"hi\"/nonce=a\\b" + &(chal-summary "Digest realm=\"say \\\"hi\\\"\", nonce=\"a\\\\b\"") + "backslash escapes resolve inside quoted-strings") + (assert-equal test + "WallyWorld" + &(chal-realm "Basic realm=\"WallyWorld\"" 0) + "realm reads the realm auth-param") + (assert-equal test + "x" + &(chal-realm "Basic REALM=\"x\"" 0) + "auth-param names are matched case-insensitively") + (assert-equal test + "" + &(chal-realm "Bearer" 0) + "realm is Nothing for a challenge without one") + (assert-equal test + "BASIC dXNlcjpwYXNz" + &(chal-summary "BASIC dXNlcjpwYXNz") + "the scheme is preserved exactly as written") + (assert-true test + (auth-scheme-is? "BaSiC dXNlcjpwYXNz" "basic") + "scheme matching is case-insensitive") + (assert-false test + (auth-scheme-is? "Bearer abc" "basic") + "scheme matching rejects a different scheme") + (assert-equal test + "Basic realm=\"WallyWorld\"" + &(auth-roundtrip "Basic realm=\"WallyWorld\"") + "a challenge round-trips through the serializer") + (assert-equal test + "Basic dXNlcjpwYXNz==" + &(auth-roundtrip "Basic dXNlcjpwYXNz==") + "token68 round-trips through the serializer") + (assert-equal test + "Basic realm=\"a\", Bearer, Digest realm=\"b\"" + &(auth-roundtrip "Basic realm=\"a\", Bearer, Digest realm=\"b\"") + "a challenge list round-trips, bare challenge included") + (assert-equal test + "Digest realm=\"say \\\"hi\\\"\"" + &(auth-roundtrip "Digest realm=\"say \\\"hi\\\"\"") + "quotes in a param value are re-escaped on serialization") + (assert-equal test + "Digest algorithm=\"MD5\"" + &(auth-roundtrip "Digest algorithm=MD5") + "an unquoted param value is quoted on serialization") + (assert-equal test + "Basic dXNlcjpwYXNz" + &(basic-header "user" "pass") + "Auth.basic base64-encodes user and password") + (assert-equal test + "user/pass" + &(basic-header-roundtrip "user" "pass") + "Basic credentials round-trip through parse and decode") + (assert-equal test + "Basic dTphYWE/" + &(basic-header "u" "aaa?") + "Auth.basic emits the standard base64 alphabet, slash included") + (assert-equal test + "u/aaa?" + &(basic-header-roundtrip "u" "aaa?") + "Basic credentials whose base64 contains a slash round-trip") + (assert-equal test + "user/pa:ss:word" + &(basic-header-roundtrip "user" "pa:ss:word") + "a password may contain colons, which stay in the password") + (assert-equal test + "user/" + &(basic-header-roundtrip "user" "") + "an empty password round-trips") + (assert-equal test + "a Basic user-id may not contain a colon" + &(basic-header "us:er" "pass") + "Auth.basic rejects a user-id containing a colon") + (assert-equal test + "Basic credentials have no colon" + &(basic-parts "Basic aaaa") + "base64 that decodes without a colon is a clean failure") + (assert-equal test + "Basic credentials have no colon" + &(basic-parts "Basic") + "a lone Basic scheme is a clean failure") + (assert-equal test + "input length must be a multiple of 4" + &(basic-parts "Basic !!!") + "invalid base64 is a clean failure") + (assert-equal test + "not Basic credentials: 'Bearer'" + &(basic-parts "Bearer abc") + "basic-credentials rejects another scheme") + (assert-equal test + "Bearer abc123" + &(Auth.bearer "abc123") + "Auth.bearer builds a Bearer header value") + (assert-equal test + "abc123" + &(bearer-of "Bearer abc123") + "bearer-token reads the token back") + (assert-equal test + "abc123" + &(bearer-of "bearer abc123") + "bearer-token accepts a lower-cased scheme") + (assert-equal test + "ab/cd.ef/gh" + &(bearer-of "Bearer ab/cd.ef/gh") + "a Bearer token may contain slashes") + (assert-equal test + 1 + (chal-count "Bearer ab/cd.ef/gh") + "a slash does not split a Bearer token into two challenges") + (assert-equal test + "/abc" + &(bearer-of "Bearer /abc") + "a token68 may begin with a slash") + (assert-equal test + "empty Bearer token" + &(bearer-of "Bearer") + "bearer-token rejects a scheme with no token") + (assert-equal test + "not Bearer credentials: 'Basic'" + &(bearer-of "Basic dXNlcjpwYXNz") + "bearer-token rejects another scheme") + (assert-equal test + "Basic realm=\"WallyWorld\"" + &(Auth.basic-challenge "WallyWorld") + "basic-challenge builds a WWW-Authenticate value") + (assert-equal test + "Basic realm=\"say \\\"hi\\\"\"" + &(Auth.basic-challenge "say \"hi\"") + "basic-challenge escapes quotes in the realm") + (assert-equal test + "Bearer realm=\"api\"" + &(Auth.bearer-challenge "api") + "bearer-challenge builds a WWW-Authenticate value") + (assert-equal test + "malformed credentials: ''" + &(auth-verdict "") + "Auth.parse rejects an empty value") + (assert-equal test + "malformed credentials: ' '" + &(auth-verdict " ") + "Auth.parse rejects a whitespace-only value") + (assert-equal test + "more than one scheme in credentials: 'Basic abc, Bearer def'" + &(auth-verdict "Basic abc, Bearer def") + "Auth.parse rejects more than one scheme") + (assert-equal test + "" + &(auth-verdict "Basic") + "Auth.parse accepts a scheme with no credentials") + (assert-equal test + 0 + (chal-count "") + "an empty header value yields no challenges") + (assert-equal test + 0 + (chal-count " \t ") + "a whitespace-only header value yields no challenges") + (assert-equal test 0 (chal-count ",,,") "commas alone yield no challenges") + (assert-equal test + 0 + (chal-count "=") + "a stray equals sign yields no challenges") + (assert-equal test + "Basic" + &(chal-summary "Basic ,") + "a trailing comma does not invent a challenge") + (assert-equal test + "Basic/realm=unterminated" + &(chal-summary "Basic realm=\"unterminated") + "an unterminated quoted-string runs to the end of the value") + (assert-equal test + "Basic/realm=a\\" + &(chal-summary "Basic realm=\"a\\") + "a trailing backslash inside a quoted-string is kept literally") + (assert-equal test + "Basic/realm=/foo=" + &(chal-summary "Basic realm=\"\", foo=") + "empty param values parse as empty") + (assert-equal test + "Basic" + &(chal-summary "Basic éé") + "non-ASCII bytes outside a quoted-string are dropped") + (assert-equal test + "Basic/realm=é" + &(chal-summary "Basic realm=\"é\"") + "non-ASCII bytes inside a quoted-string are preserved") + (assert-equal test + 1 + (chal-count &(fmt "Basic realm=\"%s\"" &(repeated "a" 20000))) + "a very long header value parses without crashing") + (assert-equal test + 0 + (chal-count &(repeated "\\\"=," 5000)) + "a long run of delimiters parses without crashing") + (assert-equal test + 401 + @(Response.code + &(Response.unauthorized (Auth.basic-challenge "site") {} @"")) + "Response.unauthorized is a 401") + (assert-equal test + "Basic realm=\"site\"" + &(unauthorized-header (Auth.basic-challenge "site") {}) + "Response.unauthorized attaches the challenge") + (assert-equal test + "Basic realm=\"new\"" + &(unauthorized-header (Auth.basic-challenge "new") + {@"WWW-Authenticate" [@"Basic realm=\"old\""]}) + "Response.unauthorized replaces a WWW-Authenticate in headers"))