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