StackExchange.Redis cache with sliding expiration support, ReadOnlyMemory and RecyclableMemoryStream on input.

DistributedCaching.fs

module DistributedCaching

open System
open StackExchange.Redis
open System.Threading.Tasks
open Microsoft.IO
open System.Buffers

type IDistributedCache =
    abstract GetAsync: key: string -> Task<byte[] voption>
    abstract RemoveAsync: key: string -> Task
    abstract SetAsync: key: string * value: ReadOnlyMemory<byte> * abs: Option<DateTimeOffset> * slid: Option<TimeSpan> -> Task
    abstract SetStreamAsync: key: string * stream: RecyclableMemoryStream * abs: Option<DateTimeOffset> * slid: Option<TimeSpan> -> Task

type RedisCache (conn: ConnectionMultiplexer) =
    let [<Literal>] getScript = "
local r = redis.call('HMGET', KEYS[1], 'sld', 'abs', 'd')

if not r[1] then
  return r[3]
end

local e = tonumber(r[1])

if r[2] then
  local a = r[2] - redis.call('TIME')[1]

  if a < e then
    e = a
  end
end

redis.call('EXPIRE', KEYS[1], e)
return r[3]"

    let db = conn.GetDatabase ()

    interface IDistributedCache with
        override _.GetAsync key = backgroundTask {
            let! res = db.ScriptEvaluateAsync (getScript, [| RedisKey key |])
            
            if res.IsNull then
                return ValueNone
            else
                return ValueSome (RedisResult.op_Explicit res: byte[]) }

        override _.RemoveAsync key =
            db.KeyDeleteAsync key

        override _.SetAsync (key, value, abs, slid) =
            let fields = [|
                if slid.IsSome then
                    yield HashEntry ("sld", int64 slid.Value.TotalSeconds)

                    if abs.IsSome then
                        yield HashEntry ("abs", abs.Value.ToUnixTimeSeconds ())

                yield HashEntry ("d", value)
            |]

            let expirationRelativeToNow =
                match abs, slid with
                | Some abs, Some slid ->
                    let diff = abs - DateTimeOffset.UtcNow
                    if diff < slid then diff else slid
                | Some abs, _ ->
                    abs - DateTimeOffset.UtcNow
                | _, Some slid ->
                    slid
                | _ ->
                    TimeSpan.Zero

            if expirationRelativeToNow.Ticks = 0L then
                db.HashSetAsync (key, fields)
            else
                let batch = db.CreateBatch ()
                batch.HashSetAsync (key, fields) |> ignore
                let last = batch.KeyExpireAsync (key, expirationRelativeToNow)
                batch.Execute ()
                last

        override x.SetStreamAsync (key, stream, abs, slid) =
            let seq = stream.GetReadOnlySequence ()

            if seq.IsSingleSegment then
                (x: IDistributedCache).SetAsync (key, seq.First, abs, slid)
            else
                // RedisValue does not support ReadOnlySequence, only ReadOnlyMemory
                // If the recyclable stream comprises multiple discontiguous segments, they need to be copied out into a single block
                backgroundTask {
                    let pooled = ArrayPool.Shared.Rent (int stream.Length)

                    try
                        seq.CopyTo (pooled.AsSpan ())
                        return! (x: IDistributedCache).SetAsync (key, pooled.AsMemory (0, int stream.Length), abs, slid)
                    finally
                        ArrayPool.Shared.Return pooled }