Update to current project system

- Add F# driver project
- Replace async with task (both RethinkDB and ASP.NET Core are task-based)
- Add cancellation token support (F# RethinkDB driver does not support them yet)
This commit is contained in:
Daniel J. Summers 2022-04-19 12:12:27 -04:00
parent b46f2a83f0
commit 21ef9bac02
4 changed files with 242 additions and 228 deletions

View File

@ -3,39 +3,30 @@ namespace RethinkDB.DistributedCache
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open Microsoft.Extensions.Options open Microsoft.Extensions.Options
open Newtonsoft.Json
open RethinkDb.Driver open RethinkDb.Driver
open RethinkDb.Driver.Net open RethinkDb.Driver.FSharp
open System open System
open System.Text open System.Text
open System.Threading
open System.Threading.Tasks open System.Threading.Tasks
// H/T: Suave
[<AutoOpen>]
module AsyncExtensions =
type Microsoft.FSharp.Control.AsyncBuilder with
/// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
/// a standard .NET task
member x.Bind(t : Task<'T>, f:'T -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
/// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
/// a standard .NET task which does not commpute a value
member x.Bind(t : Task, f : unit -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
/// Persistence object for a cache entry /// Persistence object for a cache entry
type CacheEntry = { [<CLIMutable; NoComparison; NoEquality>]
/// The Id for the cache entry type CacheEntry =
[<JsonProperty("id")>] { /// The ID for the cache entry
Id : string id : string
/// The payload for the cache entry (as a UTF-8 string) /// The payload for the cache entry (as a UTF-8 string)
Payload : string payload : string
/// The ticks at which this entry expires /// The ticks at which this entry expires
ExpiresAt : int64 expiresAt : int64
/// The number of seconds in the sliding expiration /// The number of seconds in the sliding expiration
SlidingExpiration : int slidingExpiration : int
} }
/// Record to update sliding expiration for an entry
type SlidingExpirationUpdate = { ExpiresAt : int64 }
/// IDistributedCache implementation utilizing RethinkDB /// IDistributedCache implementation utilizing RethinkDB
[<AllowNullLiteral>] [<AllowNullLiteral>]
@ -57,158 +48,190 @@ type DistributedRethinkDBCache(options : IOptions<DistributedRethinkDBCacheOptio
/// Options /// Options
let opts = options.Value let opts = options.Value
/// Shorthand to get the database /// The database name (blank uses connection default)
let database = match String.IsNullOrEmpty opts.Database with true -> r.Db() | db -> r.Db(db) let db = defaultArg (Option.ofObj opts.Database) ""
/// Default the table name to "Cache" if it is not provided /// The table name; default to "Cache" if not provided
let tableName = match String.IsNullOrEmpty opts.Database with true -> "Cache" | _ -> opts.TableName let table = match defaultArg (Option.ofObj opts.TableName) "" with "" -> "Cache" | tbl -> tbl
/// Shorthand to get the table
let table = database.Table tableName
/// The name of the cache /// The name of the cache
let cacheName = let cacheName =
seq { seq {
match String.IsNullOrEmpty opts.Database with true -> () | _ -> yield opts.Database; yield "." match db with "" -> () | _ -> $"{db}."
yield tableName table
} }
|> Seq.reduce (+) |> Seq.reduce (+)
/// Debug message /// Debug message
let dbug text = let dbug text =
match log.IsEnabled LogLevel.Debug with if log.IsEnabled LogLevel.Debug then log.LogDebug $"[{cacheName}] %s{text ()}"
| true -> text () |> sprintf "[%s] %s" cacheName |> log.LogDebug
| _ -> ()
/// Make sure the RethinkDB database, table, expiration index exist /// Make sure the RethinkDB database, table, expiration index exist
let checkEnvironment () = let checkEnvironment (_ : CancellationToken) =
async { backgroundTask {
match environmentChecked with if environmentChecked then
| true -> dbug <| fun () -> "Skipping environment check because it has already been performed" dbug <| fun () -> "Skipping environment check because it has already been performed"
| _ -> return ()
dbug <| fun () -> "|> Checking for proper RethinkDB cache environment" dbug <| fun () -> "|> Checking for proper RethinkDB cache environment"
// Database // Database
match opts.Database with match db with
| "" -> dbug <| fun () -> " Skipping database check because it was not specified" | "" -> dbug <| fun () -> " Skipping database check because it was not specified"
| db -> dbug <| fun () -> sprintf " Checking for database %s existence..." db | _ ->
let! dbs = r.DbList().RunResultAsync<string list>(opts.Connection) dbug <| fun () -> $" Checking for database {db} existence..."
match dbs |> List.contains db with let! dbs = rethink<string list> { dbList; result; withRetryDefault opts.Connection }
| true -> () if not (dbs |> List.contains db) then
| _ -> dbug <| fun () -> sprintf " ...creating database %s..." db dbug <| fun () -> sprintf $" ...creating database {db}..."
do! r.DbCreate(db).RunResultAsync(opts.Connection) do! rethink { dbCreate db; write; withRetryDefault; ignoreResult opts.Connection }
dbug <| fun () -> " ...done" dbug <| fun () -> " ...done"
// Table // Table
dbug <| fun () -> sprintf " Checking for table %s existence..." tableName dbug <| fun () -> sprintf $" Checking for table {table} existence..."
let! tables = database.TableList().RunResultAsync<string list>(opts.Connection) let! tables = rethink<string list> { tableList db; result; withRetryDefault opts.Connection }
match tables |> List.contains tableName with if not (tables |> List.contains table) then
| true -> () dbug <| fun () -> sprintf $" ...creating table {table}..."
| _ -> dbug <| fun () -> sprintf " ...creating table %s..." tableName do! rethink { withDb db; tableCreate table; write; withRetryDefault; ignoreResult opts.Connection }
do! database.TableCreate(tableName).RunResultAsync(opts.Connection)
dbug <| fun () -> " ...done" dbug <| fun () -> " ...done"
// Index // Index
dbug <| fun () -> sprintf " Checking for index %s.ExpiresAt..." tableName dbug <| fun () -> sprintf $" Checking for index {table}.expiresAt..."
let! indexes = table.IndexList().RunResultAsync<string list>(opts.Connection) let! indexes = rethink<string list> {
match indexes |> List.contains "ExpiresAt" with withDb db; withTable table
| true -> () indexList
| _ -> dbug <| fun () -> sprintf " ...creating index ExpiresAt on table %s..." tableName result; withRetryDefault opts.Connection
do! table.IndexCreate("ExpiresAt").RunResultAsync(opts.Connection) }
if not (indexes |> List.contains "expiresAt") then
dbug <| fun () -> sprintf $" ...creating index expiresAt on table {table}..."
do! rethink {
withDb db; withTable table
indexCreate "expiresAt"
write; withRetryDefault; ignoreResult opts.Connection
}
dbug <| fun () -> " ...done" dbug <| fun () -> " ...done"
dbug <| fun () -> "|> RethinkDB cache environment check complete. Carry on..." dbug <| fun () -> "|> RethinkDB cache environment check complete. Carry on..."
environmentChecked <- true environmentChecked <- true
} }
/// Remove entries from the cache that are expired /// Remove entries from the cache that are expired
let purgeExpired () = let purgeExpired (_ : CancellationToken) =
async { backgroundTask {
let tix = DateTime.UtcNow.Ticks - 1L let tix = DateTime.UtcNow.Ticks - 1L
dbug <| fun () -> sprintf "Purging expired entries (<= %i)" tix dbug <| fun () -> $"Purging expired entries (<= %i{tix})"
do! table.Between(r.Minval, tix).OptArg("index", "ExpiresAt").Delete().RunResultAsync(opts.Connection) do! rethink {
withDb db; withTable table
between (r.Minval ()) tix [ BetweenOptArg.Index "expiresAt" ]
delete
write; withRetryDefault; ignoreResult opts.Connection
}
} }
/// Calculate ticks from now for the given number of seconds /// Calculate ticks from now for the given number of seconds
let ticksFromNow seconds = DateTime.UtcNow.Ticks + int64 (seconds * 10000000) let ticksFromNow seconds = DateTime.UtcNow.Ticks + int64 (seconds * 10000000)
/// Get the cache entry specified /// Get the cache entry specified
let getCacheEntry (key : string) = let getCacheEntry (key : string) (_ : CancellationToken) =
async { rethink<CacheEntry> {
let! entry = table.Get(key).RunResultAsync<CacheEntry>(opts.Connection) withDb db; withTable table
return entry get key
resultOption; withRetryDefault opts.Connection
} }
/// Refresh (update expiration based on sliding expiration) the cache entry specified /// Refresh (update expiration based on sliding expiration) the cache entry specified
let refreshCacheEntry (entry : CacheEntry) = let refreshCacheEntry (entry : CacheEntry) (_ : CancellationToken) =
async { backgroundTask {
match entry.SlidingExpiration with if entry.slidingExpiration > 0 then
| 0 -> () do! rethink {
| seconds -> do! table.Get(entry.Id) withDb db; withTable table
.Update({ ExpiresAt = ticksFromNow seconds }) get entry.id
.RunResultAsync(opts.Connection) update [ "expiresAt", ticksFromNow entry.slidingExpiration :> obj ]
write; withRetryDefault; ignoreResult opts.Connection
}
} }
/// Get the payload for the cache entry /// Get the payload for the cache entry
let getEntry key = let getEntry key (cnxToken : CancellationToken) =
async { backgroundTask {
do! checkEnvironment () cnxToken.ThrowIfCancellationRequested ()
do! purgeExpired () do! checkEnvironment cnxToken
let! entry = getCacheEntry key do! purgeExpired cnxToken
match box entry with match! getCacheEntry key cnxToken with
| null -> dbug <| fun () -> sprintf "Cache key %s not found" key | None ->
dbug <| fun () -> $"Cache key {key} not found"
return null return null
| _ -> dbug <| fun () -> sprintf "Cache key %s found" key | Some entry ->
do! refreshCacheEntry entry dbug <| fun () -> $"Cache key {key} found"
return UTF8Encoding.UTF8.GetBytes entry.Payload do! refreshCacheEntry entry cnxToken
return UTF8Encoding.UTF8.GetBytes entry.payload
} }
/// Update the sliding expiration for a cache entry /// Update the sliding expiration for a cache entry
let refreshEntry key = let refreshEntry key (cnxToken : CancellationToken) =
async { backgroundTask {
do! checkEnvironment () cnxToken.ThrowIfCancellationRequested ()
let! entry = getCacheEntry key do! checkEnvironment cnxToken
match box entry with null -> () | _ -> do! refreshCacheEntry entry match! getCacheEntry key cnxToken with None -> () | Some entry -> do! refreshCacheEntry entry cnxToken
do! purgeExpired () do! purgeExpired cnxToken
return () return ()
} }
/// Remove the specified cache entry /// Remove the specified cache entry
let removeEntry (key : string) = let removeEntry (key : string) (cnxToken : CancellationToken) =
async { backgroundTask {
do! checkEnvironment () cnxToken.ThrowIfCancellationRequested ()
do! table.Get(key).Delete().RunResultAsync(opts.Connection) do! checkEnvironment cnxToken
do! purgeExpired () do! rethink {
withDb db; withTable table
get key
delete
write; withRetryDefault; ignoreResult opts.Connection
}
do! purgeExpired cnxToken
} }
/// Set the value of a cache entry /// Set the value of a cache entry
let setEntry key payload (options : DistributedCacheEntryOptions) = let setEntry key (payload : byte[]) (options : DistributedCacheEntryOptions) (cnxToken : CancellationToken) =
async { backgroundTask {
do! checkEnvironment () cnxToken.ThrowIfCancellationRequested ()
do! purgeExpired () do! checkEnvironment cnxToken
do! purgeExpired cnxToken
let addExpiration entry = let addExpiration entry =
match true with match true with
| _ when options.SlidingExpiration.HasValue -> | _ when options.SlidingExpiration.HasValue ->
{ entry with ExpiresAt = ticksFromNow options.SlidingExpiration.Value.Seconds { entry with expiresAt = ticksFromNow options.SlidingExpiration.Value.Seconds
SlidingExpiration = options.SlidingExpiration.Value.Seconds } slidingExpiration = options.SlidingExpiration.Value.Seconds }
| _ when options.AbsoluteExpiration.HasValue -> | _ when options.AbsoluteExpiration.HasValue ->
{ entry with ExpiresAt = options.AbsoluteExpiration.Value.UtcTicks } { entry with expiresAt = options.AbsoluteExpiration.Value.UtcTicks }
| _ when options.AbsoluteExpirationRelativeToNow.HasValue -> | _ when options.AbsoluteExpirationRelativeToNow.HasValue ->
{ entry with ExpiresAt = ticksFromNow options.AbsoluteExpirationRelativeToNow.Value.Seconds } { entry with expiresAt = ticksFromNow options.AbsoluteExpirationRelativeToNow.Value.Seconds }
| _ -> entry | _ -> entry
let entry = { Id = key let entry =
Payload = UTF8Encoding.UTF8.GetString payload { id = key
ExpiresAt = Int64.MaxValue payload = UTF8Encoding.UTF8.GetString payload
SlidingExpiration = 0 } expiresAt = Int64.MaxValue
|> addExpiration slidingExpiration = 0
do! match box (getCacheEntry key) with
| null -> table.Insert(entry).RunResultAsync(opts.Connection)
| _ -> table.Get(key).Replace(entry).RunResultAsync(opts.Connection)
return ()
} }
|> addExpiration
match! getCacheEntry key cnxToken with
| None ->
do! rethink {
withDb db; withTable table
insert entry
write; withRetryDefault; ignoreResult opts.Connection
}
| Some _ ->
do! rethink {
withDb db; withTable table
get key
replace entry
write; withRetryDefault; ignoreResult opts.Connection
}
}
let runSync (task : CancellationToken -> Task<'T>) =
task CancellationToken.None |> (Async.AwaitTask >> Async.RunSynchronously)
interface IDistributedCache with interface IDistributedCache with
member this.Get key = getEntry key |> Async.RunSynchronously member this.Get key = getEntry key |> runSync
member this.GetAsync key = getEntry key |> Async.StartAsTask member this.GetAsync (key, cnxToken) = getEntry key cnxToken
member this.Refresh key = refreshEntry key |> Async.RunSynchronously member this.Refresh key = refreshEntry key |> runSync
member this.RefreshAsync key = refreshEntry key |> Async.StartAsTask :> Task member this.RefreshAsync (key, cnxToken) = refreshEntry key cnxToken
member this.Remove key = removeEntry key |> Async.RunSynchronously member this.Remove key = removeEntry key |> runSync
member this.RemoveAsync key = removeEntry key |> Async.StartAsTask :> Task member this.RemoveAsync (key, cnxToken) = removeEntry key cnxToken
member this.Set (key, value, options) = setEntry key value options |> Async.RunSynchronously member this.Set (key, value, options) = setEntry key value options |> runSync
member this.SetAsync (key, value, options) = setEntry key value options |> Async.StartAsTask :> Task member this.SetAsync (key, value, options, cnxToken) = setEntry key value options cnxToken

View File

@ -5,6 +5,7 @@ open RethinkDb.Driver.Net
/// Options to use to configure the RethinkDB cache /// Options to use to configure the RethinkDB cache
[<AllowNullLiteral>] [<AllowNullLiteral>]
type DistributedRethinkDBCacheOptions() = type DistributedRethinkDBCacheOptions() =
/// The RethinkDB connection to use for caching operations /// The RethinkDB connection to use for caching operations
member val Connection : IConnection = null with get, set member val Connection : IConnection = null with get, set
@ -19,3 +20,4 @@ type DistributedRethinkDBCacheOptions() =
seq { seq {
match this.Connection with null -> yield "Connection cannot be null" | _ -> () match this.Connection with null -> yield "Connection cannot be null" | _ -> ()
} }

View File

@ -0,0 +1,21 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFrameworks>net6.0;netstandard2.0</TargetFrameworks>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="6.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="*" />
<PackageReference Include="Microsoft.Extensions.Options" Version="6.0.0" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0002" />
</ItemGroup>
<ItemGroup>
<Compile Include="DistributedRethinkDBCacheOptions.fs" />
<Compile Include="DistributedRethinkDBCache.fs" />
<Compile Include="IServiceCollectionExtensions.fs" />
</ItemGroup>
</Project>

View File

@ -1,32 +0,0 @@
{
"buildOptions": {
"compile": {
"includeFiles": [
"DistributedRethinkDBCacheOptions.fs",
"DistributedRethinkDBCache.fs",
"IServiceCollectionExtensions.fs"
]
},
"compilerName": "fsc",
"debugType": "portable"
},
"dependencies": {
"Microsoft.Extensions.Caching.Abstractions": "1.0.0",
"Microsoft.Extensions.Logging": "1.0.0",
"Microsoft.Extensions.Options": "1.0.0",
"Newtonsoft.Json": "9.0.1",
"RethinkDb.Driver": "2.3.15"
},
"frameworks": {
"netstandard1.6": {
"dependencies": {
"Microsoft.FSharp.Core.netcore": "1.0.0-alpha-160831",
"NETStandard.Library": "1.6.0"
}
}
},
"tools": {
"dotnet-compile-fsc":"1.0.0-preview2-*"
},
"version": "0.9.0"
}