authenticateBasicAsync gives a 500 Internal Server Error for malformed tokens

[njlr]

Using this server:

#r "nuget: Suave, 2.6.2"

open Suave
open Suave.Successful

let app : WebPart =
  authenticateBasicAsync
    (fun (_, _) -> async { return true })
    (OK "Hello, world")

startWebServer defaultConfig app

And this curl command:

$ curl -H 'Authorization: thisistotallyinvalid' http://localhost:8080
<h1>Index was outside the bounds of the array.</h1><br/>System.IndexOutOfRangeException: Index was outside the bounds of the array.
   at Suave.Authentication.parseAuthenticationToken(String token) in c:\Work\suave\src\Suave\Authentication.fs:line 16
   at [email protected](Unit unitVar) in c:\Work\suave\src\Suave\Authentication.fs:line 34
   at Microsoft.FSharp.Control.AsyncPrimitives.CallThenInvoke[T,TResult](AsyncActivation`1 ctxt, TResult result1, FSharpFunc`2 part2) in /build/dotnet8-ctKhIe/dotnet8-8.0.102-8.0.2/src/fsharp/artifacts/source-build/self/src/src/FSharp.Core/async.fs:line 510

The server returns a 500.

I think instead it should return a 401?

Potential fix:

#r "nuget: Suave, 2.6.2"

open Suave
open Suave.Successful
open Suave.RequestErrors
open Suave.Operators

[<Literal>]
let UserNameKey = "userName"

open System

[<RequireQualifiedAccess>]
module ASCII =

  open System.Text

  let tryDecodeBase64 (s : string) =
    try
      let bytes = Convert.FromBase64String s
      let str = Encoding.ASCII.GetString bytes
      ValueSome str
    with
    | :? FormatException
    | :? ArgumentException ->
      ValueNone

let tryParseBasicAuthenticationToken (rawHeader : string) =
  match rawHeader.Split(' ') with
  | [| basic; tokenBase64 |] when String.equalsOrdinalCI "basic" basic ->
    match ASCII.tryDecodeBase64 tokenBase64 with
    | ValueSome token ->
      match token.IndexOf(':') with
      | -1 ->
        ValueNone
      | i ->
        let username = token.Substring(0, i)
        let password = token.Substring(i + 1)
        ValueSome (username, password)
    | ValueNone ->
      ValueNone
  | _ ->
    ValueNone

let authenticateBasicAsyncFixed f (protectedPart : WebPart) ctx =
  async {
    let p = ctx.request
    match p.header "authorization" with
    | Choice1Of2 header ->
      match tryParseBasicAuthenticationToken header with
      | ValueSome (username, password) ->
        let! authenticated = f (username, password)
        if authenticated then
          return! (Writers.setUserData UserNameKey username >=> protectedPart) ctx
        else
          return! challenge ctx
      | ValueNone ->
        return! challenge ctx
    | Choice2Of2 _ ->
      return! challenge ctx
  }

let app : WebPart =
  authenticateBasicAsyncFixed
    (fun (_, _) -> async { return true })
    (OK "Hello, world")

startWebServer defaultConfig app

[njlr]

PR: #781

The tests pass on GitHub but is there a trick to running them locally?