Suave is a simple web development F# library providing a lightweight web server and a set of combinators to manipulate route flow and task composition.
#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 Suave.Authentication.authenticateBasicAsync@31-1.Invoke(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
Using this server:
And this
curl
command:The server returns a
500
.I think instead it should return a
401
?Potential fix: