Authentication.fs

[<RequireQualifiedAccess>]
module Authentication

open System
open System.Collections.Generic
open Simple.Web
open Simple.Web.Http
open Simple.Web.Authentication

type Payload = { UserId: Guid; Name: string; Expires: int64 }
let serializer = Newtonsoft.Json.JsonSerializer()

let getAuthHeader (request:IRequest) =
    request.Headers.TryGetValue "Authorization" |> function
    | false, _ -> None
    | true, t -> Some t

let getToken (t:string array option) =
    match t with
    | None -> None
    | Some t ->
        match t.Length with
        | 0 -> None
        | _ -> t.[0] |> Some

let getPayload (secretKey:string) = function
    | None -> None
    | Some t ->
        try
            let value = JWT.JsonWebToken.Decode(t, secretKey)
            Newtonsoft.Json.JsonConvert.DeserializeObject<Payload>(value) |> Some
        with _ -> None

let createUser =
    function
    | None -> null
    | Some { UserId = userId; Name = name; Expires = expires } ->
        try
            if DateTime.UtcNow < DateTime.FromBinary(expires) then null
            else User(userId, name) :> IUser
        with _ -> null

let getProvider secretKey =

    let loadUser = getAuthHeader >> getToken >> getPayload secretKey >> createUser
        
    { new IAuthenticationProvider with
        member __.GetLoggedInUser context =
            context.Request |> loadUser
                                    
        member __.SetLoggedInUser (context, user) =
            let payload = { UserId = user.Guid; Name = user.Name; Expires = DateTime.UtcNow.AddDays(1.).ToBinary() }
            let token = JWT.JsonWebToken.Encode(payload, secretKey, JWT.JwtHashAlgorithm.HS512)
            context.Response.Headers.Add("Authorization", [| token |]) }

AuthorizationStartupTask.fs

open Simple.Web

type AuthorizationStartupTask() =
    interface IStartupTask with
        member __.Run(config, env) =
            // Load your "secret key" from web.config or something
            let secretKey = "GQDstcKsx0NHjPOuXOYg5MbeJ1XT0uFiwDVvVBrk"
            let setProvider p = config.AuthenticationProvider <- p
            Authentication.getProvider secretKey |> setProvider

CreateUser.fs

let createUser =
    function
    | None -> null
    | Some { UserId = userId; Name = name; Expires = expires } -> // Easily decompose the record
        try
            if DateTime.UtcNow > DateTime.FromBinary(expires) then null
            else User(userId, name) :> IUser  // User is baked into Simple.Web-we could create our own
        with _ -> null

GetAuthHeader.fs

open Simple.Web.Http

let getAuthHeader (request:IRequest) =
    request.Headers.TryGetValue "Authorization" |> function
    | false, _ -> None
    | true, t -> Some t

GetPayload.fs

let getPayload (secretKey:string) = function
    | None -> None
    | Some t ->
        try
            let value = JWT.JsonWebToken.Decode(t, secretKey)
            NewtonSoft.Json.JsonConvert.DeserializeObject<Payload>(value) |> Some
        with _ -> None

GetProvider.fs

let getProvider secretKey =

    let loadUser = getAuthHeader >> getToken >> getPayload secretKey >> createUser
        
    { new IAuthenticationProvider with
        member __.GetLoggedInUser context =
            context.Request |> loadUser
                                    
        member __.SetLoggedInUser (context, user) =
            let expires = DateTime.UtcNow.AddDays(1.).ToBinary() // Or whatever your app requires
            let payload = { UserId = user.Guid; Name = user.Name; Expires = expires }
            let token = JWT.JsonWebToken.Encode(payload, secretKey, JWT.JwtHashAlgorithm.HS512)
            context.Response.Headers.Add("Authorization", [| token |]) }

GetToken.fs

let let getToken (t:string array option) =
    match t with
    | None -> None
    | Some t ->
        match t.Length with  // Headers are returned as a string array, we'll just grab the first one
        | 0 -> None
        | _ -> t.[0] |> Some

Payload.fs

module Authorization

type Payload =
    {
        UserId: Guid;
        Name: string;
        Expires: int64 // Using a long because serializing dates sucks
    }