From 615c3ea69c483ab46d3fca69d3b0e2e3f8c4f1eb Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 3 Oct 2026 13:09:39 +0200 Subject: [PATCH 1/4] Fixed the validation result cache serving one document's result for another The validation result cache keyed its entries by the 32-bit structural hash codes of the document and of the introspected schema. Different documents share these hash codes (for example `{ f(x: 0) }` and `{ f(x: 4294967297) }`), so an invalid document could pass validation with the cached result of a valid one. - ValidationResultKey now holds the Document, compared structurally, and the IntrospectionSchema instance, compared by reference (breaking change). Its hash code is only used for bucketing. It is computed once per key from every value of the document, mixed with a secret per-process seed, so that clients cannot craft many documents with the same hash code. - MemoryCache stores a Lazy with ExecutionAndPublication in each entry, so concurrent requests for a missing key run the validation once and no global lock is held while validating. A producer that throws leaves no entry behind. - A cache hit now refreshes the last use of the entry, so sliding expiration actually slides. - MemoryValidationResultCache now holds the documents of its keys, so it limits their total size in AST nodes (100 000 by default, about 10-15 MB). Beyond the limit it evicts the least recently used entries, and it does not cache a document larger than the whole limit. - Expired entries are now removed while the cache is used. The previous timer was never stopped, so it kept every cache, including the one each Executor creates, and all its entries alive until the process exited. - Executor reads ISchema.Introspected once, when it is created, instead of computing the structural hash code of the whole introspected schema on every request. Co-Authored-By: Claude Opus 5.5 --- RELEASE_NOTES.md | 6 + .../ProvidedTypesHelper.fs | 2 +- src/FSharp.Data.GraphQL.Server/Executor.fs | 10 +- .../Helpers/MemoryCache.fs | 287 +++++++++------ .../ValidationResultCache.fs | 327 ++++++++++++++++- .../FSharp.Data.GraphQL.Tests.fsproj | 1 + .../ValidationCacheTests.fs | 341 ++++++++++++++++++ 7 files changed, 845 insertions(+), 129 deletions(-) create mode 100644 tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index ec961106..c260d4bd 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -307,6 +307,12 @@ * Added `Microsoft.Bcl.AsyncInterfaces` dependency of `FSharp.Data.GraphQL.Shared` for `netstandard2.0` * Added `Human.friendsStream` field to the Star Wars sample to demonstrate `@stream` * Added the validation rules of incremental delivery: `@stream` only on list fields, no `@defer` or `@stream` in a subscription operation or on a mutation root field unless disabled with `if: false`, and labels must be string literals unique within each operation, counting the fragments it spreads +* **Breaking Change** Fixed the validation result cache serving the result of one document for another: it identified results by the 32-bit structural hash codes of the document and of the introspected schema, which different documents share, such as `{ f(x: 0) }` and `{ f(x: 4294967297) }`, so an invalid document could pass validation with the cached result of a valid one. `ValidationResultKey` now holds the `Document`, compared structurally, and the `IntrospectionSchema` instance, compared by reference, instead of the `DocumentId` and `SchemaId` hash codes; its hash code only buckets keys and is mixed with a secret seed chosen per process, so that clients cannot craft many documents sharing one. `ExecutionPlan.DocumentId` is unchanged +* Fixed `MemoryValidationResultCache` validating a document once per concurrent request for it while it was not cached yet; concurrent requests now share a single validation +* Fixed the sliding expiration of `MemoryValidationResultCache` and of the client provider's design-time caches, which expired an entry 30 seconds after it was added however often it was used, because a cache hit did not refresh its last use +* Fixed every `MemoryValidationResultCache`, including the one an `Executor` creates when given none, starting a timer that was never stopped and kept the cache and all its entries alive until the process exited; expired entries are now removed while the cache is used +* Added a size limit to `MemoryValidationResultCache`, which now holds the documents of its keys: the total size of the cached documents, in nodes counted by `ValidationResultKey.DocumentSize`, is limited to `MemoryValidationResultCache.DefaultSizeLimit` (100 000) or to the `sizeLimit` of the new constructor `MemoryValidationResultCache (slidingExpiration, sizeLimit)`; beyond it the least recently used entries are evicted, and a document larger than the whole limit is validated on every request without being cached +* Changed `Executor` to read `ISchema.Introspected` once, when it is created, instead of computing the structural hash code of the whole introspected schema on every request * Added `GraphQLTransportWS.SubProtocol`, the `graphql-transport-ws` sub-protocol name * Fixed `graphql-transport-ws` delivery of `@defer` and `@stream` results, which are now sent as soon as they are produced instead of after a fixed 5 second delay, followed by a final payload with `hasNext: false` * Changed `graphql-transport-ws` incremental delivery of `@defer` and `@stream` results to the `pending`/`incremental`/`completed`/`hasNext` wire format used by graphql-js 17 and Apollo Client's `GraphQL17Alpha9Handler`, superseding the previous `data`/`path`/`hasNext` shape. Every deferred or streamed field is announced once, in a `pending` entry, and identified afterwards by a short id instead of its path. A deferred field is announced in the same payload as its own value, while a streamed field is announced as soon as the payload exposing its containing data is sent. A `@stream` field's items are always delivered to the client in list order, buffering an item that arrives out of turn until the item before it fills the gap, and a batch of items (grouped by `preferredBatchSize` or `StreamBatching`) is delivered as the `items` of a single `incremental` entry addressed by that id, rather than one payload per item diff --git a/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs b/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs index bb14ebf4..39aaea1b 100644 --- a/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs +++ b/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs @@ -799,9 +799,9 @@ module internal Provider = match validationResult with | ValidationError msgs -> failwith (formatValidationExceptionMessage msgs) | Success -> () - let key = { DocumentId = queryAst.GetHashCode(); SchemaId = schema.GetHashCode() } let refMaker = lazy Validation.Ast.validateDocument schema queryAst if clientQueryValidation then + let key = ValidationResultKey (schema, queryAst) refMaker.Force |> QueryValidationDesignTimeCache.getOrAdd key |> throwExceptionIfValidationFailed diff --git a/src/FSharp.Data.GraphQL.Server/Executor.fs b/src/FSharp.Data.GraphQL.Server/Executor.fs index eb54f0e4..4b40166e 100644 --- a/src/FSharp.Data.GraphQL.Server/Executor.fs +++ b/src/FSharp.Data.GraphQL.Server/Executor.fs @@ -99,6 +99,10 @@ type Executor<'Root>(schema: ISchema<'Root>, middlewares : IExecutorMiddleware s | Success -> () | ValidationError errors -> raise (GQLMessageException (System.String.Join("\n", errors))) + // Read once, after the compile middlewares above have run: documents are validated against this instance, and the + // validation cache identifies the schema by it instead of hashing the whole introspected schema on every request + let introspectedSchema = schema.Introspected + let eval (executionPlan: ExecutionPlan, data: 'Root voption, variables: ImmutableDictionary, getInputContext : InputExecutionContextProvider): Async = let documentId = executionPlan.DocumentId let prepareOutput res = @@ -159,9 +163,9 @@ type Executor<'Root>(schema: ISchema<'Root>, middlewares : IExecutorMiddleware s ErrorKind.Validation )] do! - let schemaId = schema.Introspected.GetHashCode() - let key = { DocumentId = documentId; SchemaId = schemaId } - let producer = fun () -> Validation.Ast.validateDocument schema.Introspected ast + // The document itself is the key, not its documentId: that is a hash code, which another document can share + let key = ValidationResultKey (introspectedSchema, ast) + let producer = fun () -> Validation.Ast.validateDocument introspectedSchema ast validationCache.GetOrAdd producer key let planningCtx = { Schema = schema diff --git a/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs b/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs index 22ca1017..4b6b02ee 100644 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs +++ b/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs @@ -3,123 +3,186 @@ namespace FSharp.Data.GraphQL open System open System.Collections.Concurrent open System.Collections.Generic -open System.Timers +open System.Diagnostics +open System.Threading -// Cache implementation based on http://www.fssnip.net/7UT/title/Threadsafe-Generic-MemoryCache-and-Memoize-Function +// Cache implementation originally based on http://www.fssnip.net/7UT/title/Threadsafe-Generic-MemoryCache-and-Memoize-Function type internal CacheExpirationPolicy = | NoExpiration | AbsoluteExpiration of TimeSpan | SlidingExpiration of TimeSpan -type internal CacheEntryExpiration = - | NeverExpires - | ExpiresAt of DateTime - | ExpiresAfter of TimeSpan - -type internal CacheEntry<'key, 'value> = - { Key: 'key - Value: 'value - Expiration: CacheEntryExpiration - LastUsage: DateTime } - -module internal CacheExpiration = - let isExpired (entry: CacheEntry<_,_>) = - match entry.Expiration with - | NeverExpires -> false - | ExpiresAt date -> DateTime.UtcNow > date - | ExpiresAfter window -> (DateTime.UtcNow - entry.LastUsage) > window - -type internal IMemoryCacheStore<'key, 'value> = - inherit IEnumerable> - abstract member Add: CacheEntry<'key, 'value> -> unit - abstract member GetOrAdd: 'key -> ('key -> CacheEntry<'key, 'value>) -> CacheEntry<'key, 'value> - abstract member Remove: 'key -> unit - abstract member Contains: 'key -> bool - abstract member Update: 'key -> (CacheEntry<'key, 'value> -> CacheEntry<'key, 'value>) -> unit - abstract member TryFind: 'key -> CacheEntry<'key, 'value> option - - -/// An in-memory key/value cache with a customizable expiration time. -type internal MemoryCache<'key, 'value> (?cacheExpirationPolicy) = - let policy = defaultArg cacheExpirationPolicy NoExpiration - let store = - let entries = ConcurrentDictionary<'key, CacheEntry<'key, 'value>>() - let getEnumerator = - let values = entries |> Seq.map (fun kvp -> kvp.Value) - fun () -> values.GetEnumerator() - { new IMemoryCacheStore<'key, 'value> with - member _.Add entry = entries.AddOrUpdate(entry.Key, entry, fun _ _ -> entry) |> ignore - member _.GetOrAdd key getValue = entries.GetOrAdd(key, getValue) - member _.Remove key = entries.TryRemove key |> ignore - member _.Contains key = entries.ContainsKey key - member _.Update key update = - match entries.TryGetValue(key) with - | (true, entry) -> entries.AddOrUpdate(key, entry, fun _ entry -> update entry) |> ignore - | _ -> () - member _.TryFind key = - match entries.TryGetValue(key) with - | (true, entry) -> Some entry - | _ -> None - member _.GetEnumerator () = getEnumerator () - member _.GetEnumerator () = getEnumerator () :> Collections.IEnumerator } - - let checkExpiration () = - store |> Seq.iter (fun entry -> if CacheExpiration.isExpired entry then store.Remove entry.Key) - - let newCacheEntry key value = - { Key = key - Value = value - Expiration = match policy with - | NoExpiration -> NeverExpires - | AbsoluteExpiration time -> ExpiresAt (DateTime.UtcNow + time) - | SlidingExpiration window -> ExpiresAfter window - LastUsage = DateTime.UtcNow } - - let add key value = - if key |> store.Contains - then store.Update key (fun entry -> {entry with Value = value; LastUsage = DateTime.UtcNow}) - else store.Add <| newCacheEntry key value - - let remove key = - store.Remove key - - let get key = - store.TryFind key |> Option.bind (fun entry -> Some entry.Value) - - let getOrAdd key value = - store.GetOrAdd key (fun _ -> newCacheEntry key value) - |> fun entry -> entry.Value - - let getOrAddResult key f = - store.GetOrAdd key (fun _ -> newCacheEntry key <| f()) - |> fun entry -> entry.Value - - let getTimer (expiration: TimeSpan) = - if expiration.TotalSeconds < 1.0 - then TimeSpan.FromMilliseconds 100.0 - elif expiration.TotalMinutes < 1.0 - then TimeSpan.FromSeconds 1.0 - else TimeSpan.FromMinutes 1.0 - |> fun interval -> new Timer(interval.TotalMilliseconds) - - let timer = - match policy with - | NoExpiration -> None - | AbsoluteExpiration time -> time |> getTimer |> Some - | SlidingExpiration time -> time |> getTimer |> Some - - let _observer = - match timer with - | Some t -> - let disposable = t.Elapsed |> Observable.subscribe (fun _ -> checkExpiration()) - t.Start() - Some disposable - | None -> None - - member _.Add key value = add key value - member _.Remove key = remove key - member _.Get key = get key - member _.GetOrAdd key value = getOrAdd key value - member _.GetOrAddResult key f = getOrAddResult key f +module internal CacheClock = + + /// + /// Creates a monotonic clock returning the time elapsed since its creation. + /// + /// + /// Unlike , it is not affected by adjustments of the system time, which would expire + /// entries early or keep them too long. + /// + let create () = + let stopwatch = Stopwatch.StartNew () + fun () -> stopwatch.Elapsed + +/// An entry of a memory cache: its value, produced at most once, its size, and when it was created and last used, in clock ticks. +[] +type internal CacheEntry<'value> (value : Lazy<'value>, size : int64, created : int64) = + // Every cache hit refreshes it from whichever thread hits the entry, so it is read and written atomically + let mutable lastUsage = created + + member _.Value = value + member _.Size = size + member _.Created = created + member _.LastUsage = Interlocked.Read &lastUsage + member _.Touch (now : int64) = Interlocked.Exchange (&lastUsage, now) |> ignore + +/// +/// A thread-safe in-memory key/value cache with an expiration policy and a size limit. +/// +/// +/// +/// Concurrent requests for a key without an entry run the producer once and share its value: the entry holds a lazy value +/// forced by every requester, so no lock is held while the value is produced and requests for other keys are never +/// blocked. A producer that throws leaves no entry behind. +/// +/// +/// A cache hit refreshes the last usage of the entry, which a sliding expiration counts from, and which orders the +/// entries for eviction: when the total size exceeds the limit, the least recently used entries are evicted. +/// +/// +/// Expired entries are removed while the cache is used, at most once per sweep interval, instead of by a timer: a running +/// timer is rooted by the runtime and would keep the cache and all its entries alive after its owner is gone. +/// +/// +type internal MemoryCache<'key, 'value> + /// When the entries expire. + /// The maximum total size of the entries. + /// Gets the size of the entry of a key. + /// Compares the keys. + /// Returns the time elapsed since a fixed point; tests replace it to control expiration. + (policy : CacheExpirationPolicy, sizeLimit : int64, getSize : 'key -> int64, comparer : IEqualityComparer<'key>, clock : unit -> TimeSpan) = + + let entries = ConcurrentDictionary<'key, CacheEntry<'value>> (comparer) + + // Changed only by whoever adds or removes an entry, so that it always matches the entries in the dictionary + let mutable totalSize = 0L + + let mutable lastSweep = (clock ()).Ticks + + // 1 while a thread sweeps or evicts entries, so that only one does at a time and the others never wait for it + let mutable maintaining = 0 + + let sweepInterval = + let intervalOf (window : TimeSpan) = + if window.TotalSeconds < 1.0 then TimeSpan.FromMilliseconds 100.0 + elif window.TotalMinutes < 1.0 then TimeSpan.FromSeconds 1.0 + else TimeSpan.FromMinutes 1.0 + match policy with + | NoExpiration -> ValueNone + | AbsoluteExpiration lifetime -> ValueSome (intervalOf lifetime).Ticks + | SlidingExpiration window -> ValueSome (intervalOf window).Ticks + + let isExpired (now : int64) (entry : CacheEntry<'value>) = + match policy with + | NoExpiration -> false + | AbsoluteExpiration lifetime -> now - entry.Created > lifetime.Ticks + | SlidingExpiration window -> now - entry.LastUsage > window.Ticks + + /// Removes the entry of the key only if it is still this very entry, never a newer one that replaced it + let tryRemove (key : 'key) (entry : CacheEntry<'value>) = + // ConcurrentDictionary removes a pair through ICollection only when the value matches too, atomically; + // entries have reference equality, so a newer entry of the key never matches + if (entries :> ICollection>>).Remove (KeyValuePair (key, entry)) then + Interlocked.Add (&totalSize, -entry.Size) |> ignore + + let removeExpired (now : int64) = + for pair in entries do + if isExpired now pair.Value then + tryRemove pair.Key pair.Value + + let evictLeastRecentlyUsed () = + // Evicting down to 90% of the limit instead of just below it lets many additions pass before the next scan, + // so that a cache kept full by new keys does not sort its entries on every addition + let target = sizeLimit - sizeLimit / 10L + let byLastUsage = entries |> Seq.toArray |> Array.sortBy _.Value.LastUsage + let mutable index = 0 + while Interlocked.Read &totalSize > target && index < byLastUsage.Length do + let pair = byLastUsage[index] + tryRemove pair.Key pair.Value + index <- index + 1 + + let maintain (now : int64) = + let sweepDue = + match sweepInterval with + | ValueSome interval -> now - Interlocked.Read &lastSweep >= interval + | ValueNone -> false + if + (sweepDue || Interlocked.Read &totalSize > sizeLimit) + && Interlocked.CompareExchange (&maintaining, 1, 0) = 0 + then + try + if sweepDue then + Interlocked.Exchange (&lastSweep, now) |> ignore + removeExpired now + if Interlocked.Read &totalSize > sizeLimit then + evictLeastRecentlyUsed () + finally + Volatile.Write (&maintaining, 0) + + let force (key : 'key) (entry : CacheEntry<'value>) = + try + entry.Value.Value + with _ -> + // Lazy rethrows the exception of a failed producer to everyone forcing it later, so the entry is dropped: + // the next request runs the producer again instead of failing until the entry expires + tryRemove key entry + reraise () + + let getOrAdd (key : 'key) (producer : unit -> 'value) = + let now = (clock ()).Ticks + maintain now + let cached = + match entries.TryGetValue key with + | true, entry when not (isExpired now entry) -> ValueSome entry + | true, expired -> + // An expired entry that no sweep has removed yet is replaced, never served + tryRemove key expired + ValueNone + | _ -> ValueNone + match cached with + | ValueSome entry -> + entry.Touch now + force key entry + | ValueNone -> + let size = getSize key + if size > sizeLimit then + // An entry larger than the whole cache would evict all the others, so its value is not cached at all + producer () + else + let added = CacheEntry (Lazy<'value> (Func<'value> producer, LazyThreadSafetyMode.ExecutionAndPublication), size, now) + // Concurrent requests for the key all get the entry added first and force its single lazy value + let entry = entries.GetOrAdd (key, added) + if obj.ReferenceEquals (entry, added) then + if Interlocked.Add (&totalSize, size) > sizeLimit then + maintain now + else + entry.Touch now + force key entry + + /// Creates a cache without a size limit, comparing the keys with their default equality. + new (policy) = MemoryCache (policy, Int64.MaxValue, (fun _ -> 1L), EqualityComparer<'key>.Default, CacheClock.create ()) + + /// The number of entries, including expired ones not removed yet. + member _.Count = entries.Count + + /// The total size of the entries. + member _.Size = Interlocked.Read &totalSize + + /// Returns the value of the key, running the producer when the key has no live entry. + member _.GetOrAddResult key producer = getOrAdd key producer + + /// Removes the expired entries now instead of on a later access. + member _.RemoveExpired () = removeExpired (clock ()).Ticks diff --git a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs index e1690260..0e54c271 100644 --- a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs +++ b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs @@ -1,24 +1,325 @@ namespace FSharp.Data.GraphQL.Validation -open FSharp.Data.GraphQL open System +open System.Collections.Generic +open System.Runtime.CompilerServices +open System.Security.Cryptography + +open FSharp.Data.GraphQL +open FSharp.Data.GraphQL.Ast +open FSharp.Data.GraphQL.Types.Introspection + +/// +/// Computes the hash codes by which validation results are cached, and the size of documents. +/// +/// +/// The structural hash code of a document cannot be used: it is the same in every process and its literals collide +/// trivially, as 0 and 4294967297 do, so a client could send many different documents sharing one hash code +/// and make every cache lookup compare the document with all of them. Here every value is mixed into the hash code in +/// full, together with a secret seed chosen once per process. +/// +module internal DocumentHashing = + + let private seed = + let bytes = Array.zeroCreate 8 + use random = RandomNumberGenerator.Create () + random.GetBytes bytes + BitConverter.ToUInt64 (bytes, 0) + + /// + /// Mixes a value into a hash state. + /// + /// + /// The finalizer of SplitMix64 is a bijection in which every bit of the result depends on every bit of the state and + /// of the value, so which documents share a hash code depends on the secret seed the state starts from. + /// + let mix (state : uint64) (value : uint64) = + let mutable z = (state ^^^ value) * 0x9E3779B97F4A7C15UL + z <- (z ^^^ (z >>> 30)) * 0xBF58476D1CE4E5B9UL + z <- (z ^^^ (z >>> 27)) * 0x94D049BB133111EBUL + z ^^^ (z >>> 31) + + [] + type private Accumulator () = + let mutable state = seed + let mutable size = 0 + + member _.State = state + member _.Size = size + + member _.Add (value : uint64) = state <- mix state value + + // String hash codes are themselves randomized per process on .NET; .NET Framework does not randomize them, but + // only the client provider runs there, hashing documents written by the developer rather than sent by clients + member this.Add (value : string) = this.Add (uint64 (uint32 (StringComparer.Ordinal.GetHashCode value))) + + /// Adds a node of the document, identified by its kind, and counts it + member this.Node (kind : uint64) = + size <- size + 1 + this.Add kind + + let private addOptional (acc : Accumulator) (value : string voption) = + match value with + | ValueSome value -> + acc.Add 1UL + acc.Add value + | ValueNone -> acc.Add 0UL + + let private addList (acc : Accumulator) (add : 'T -> unit) (items : 'T list) = + let mutable count = 0UL + for item in items do + add item + count <- count + 1UL + acc.Add count + + let rec private addType (acc : Accumulator) (inputType : InputType) = + match inputType with + | NamedType name -> + acc.Node 1UL + acc.Add name + | ListType inner -> + acc.Node 2UL + addType acc inner + | NonNullType inner -> + acc.Node 3UL + addType acc inner + + let rec private addValue (acc : Accumulator) (value : InputValue) = + match value with + | IntValue value -> + acc.Node 4UL + acc.Add (uint64 value) + | FloatValue value -> + acc.Node 5UL + // Document equality holds 0.0 equal to -0.0 and every NaN equal to any other, so they must hash alike + let bits = + if value = 0.0 then 0L + elif Double.IsNaN value then BitConverter.DoubleToInt64Bits Double.NaN + else BitConverter.DoubleToInt64Bits value + acc.Add (uint64 bits) + | BooleanValue value -> + acc.Node 6UL + acc.Add (if value then 1UL else 0UL) + | StringValue value -> + acc.Node 7UL + acc.Add value + | NullValue -> acc.Node 8UL + | EnumValue name -> + acc.Node 9UL + acc.Add name + | ListValue items -> + acc.Node 10UL + addList acc (addValue acc) items + | ObjectValue fields -> + acc.Node 11UL + for KeyValue (name, field) in fields do + acc.Add name + addValue acc field + acc.Add (uint64 fields.Count) + | VariableName name -> + acc.Node 12UL + acc.Add name + + let private addArgument (acc : Accumulator) (argument : Argument) = + acc.Node 13UL + acc.Add argument.Name + addValue acc argument.Value + + let private addDirective (acc : Accumulator) (directive : Directive) = + acc.Node 14UL + acc.Add directive.Name + addList acc (addArgument acc) directive.Arguments + + let rec private addSelection (acc : Accumulator) (selection : Selection) = + match selection with + | Field field -> + acc.Node 15UL + addOptional acc field.Alias + acc.Add field.Name + addList acc (addArgument acc) field.Arguments + addList acc (addDirective acc) field.Directives + addList acc (addSelection acc) field.SelectionSet + | FragmentSpread spread -> + acc.Node 16UL + acc.Add spread.Name + addList acc (addDirective acc) spread.Directives + | InlineFragment fragment -> + acc.Node 17UL + addFragment acc fragment + and private addFragment (acc : Accumulator) (fragment : FragmentDefinition) = + addOptional acc fragment.Name + addOptional acc fragment.TypeCondition + addList acc (addDirective acc) fragment.Directives + addList acc (addSelection acc) fragment.SelectionSet + + let private addVariable (acc : Accumulator) (variable : VariableDefinition) = + acc.Node 18UL + acc.Add variable.VariableName + addType acc variable.Type + match variable.DefaultValue with + | Some value -> + acc.Add 1UL + addValue acc value + | None -> acc.Add 0UL + + let private addDefinition (acc : Accumulator) (definition : Definition) = + match definition with + | OperationDefinition operation -> + acc.Node 19UL + acc.Add ( + match operation.OperationType with + | OperationType.Query -> 0UL + | OperationType.Mutation -> 1UL + | OperationType.Subscription -> 2UL + ) + addOptional acc operation.Name + addList acc (addVariable acc) operation.VariableDefinitions + addList acc (addDirective acc) operation.Directives + addList acc (addSelection acc) operation.SelectionSet + | FragmentDefinition fragment -> + acc.Node 20UL + addFragment acc fragment + + /// Returns the hash code of the document, seeded per process, and its size: the number of its nodes + let hashAndMeasure (document : Document) = + let acc = Accumulator () + acc.Node 0UL + addList acc (addDefinition acc) document.Definitions + struct (acc.State, acc.Size) + +/// +/// Identifies the result of validating a GraphQL document against a schema. +/// +/// +/// +/// Two keys are equal only when they hold the same schema instance and structurally equal documents, so a cache never +/// serves the result of one document for another, nor the result for one schema for another. Hash codes only bucket the +/// keys: the hash code of a key is computed once, when the key is created, from every value of the document and a secret +/// seed chosen per process, so that clients cannot craft documents sharing one. +/// +/// +/// A key keeps its document alive for as long as a cache holds the key; +/// measures it, so that a cache can bound the memory it holds. +/// +/// +[] type ValidationResultKey = - { DocumentId : int - SchemaId : int } + /// The schema the document is validated against, identified by reference: hashing or comparing its structure would + /// take time proportional to the size of the whole schema on every request. + val Schema : IntrospectionSchema + + /// The validated document, compared structurally. + val Document : Document + + /// The number of nodes of the document: its definitions, selections, arguments, directives, values, variables and + /// type references. + val DocumentSize : int + + val private hashCode : int + + /// Creates the key of the result of validating the document against the schema. + /// The schema the document is validated against. + /// The validated document. + new (schema : IntrospectionSchema, document : Document) = + let struct (documentHash, documentSize) = DocumentHashing.hashAndMeasure document + let hash = DocumentHashing.mix documentHash (uint64 (RuntimeHelpers.GetHashCode schema)) + { + Schema = schema + Document = document + DocumentSize = documentSize + hashCode = int hash ^^^ int (hash >>> 32) + } + + /// Indicates whether both keys hold the same schema instance and structurally equal documents. + /// The key to compare with. + member key.Equals (other : ValidationResultKey) = + key.hashCode = other.hashCode + && obj.ReferenceEquals (key.Schema, other.Schema) + && (obj.ReferenceEquals (key.Document, other.Document) + || EqualityComparer.Default.Equals (key.Document, other.Document)) -type ValidationResultProducer = - unit -> ValidationResult + /// + override key.Equals (other : obj) = + match other with + | :? ValidationResultKey as other -> key.Equals other + | _ -> false + /// + override key.GetHashCode () = key.hashCode + + interface IEquatable with + /// + member key.Equals other = key.Equals other + +/// Produces the result of a validation for a cache that holds no result for its key. +type ValidationResultProducer = unit -> ValidationResult + +/// +/// A cache of the results of validating documents against schemas. +/// +/// +/// An implementation must serve a result only for a key equal to the one it was produced for, by +/// ; a hash code alone never identifies a document. +/// type IValidationResultCache = - abstract GetOrAdd : ValidationResultProducer -> ValidationResultKey -> ValidationResult + /// Returns the cached result for the key, or caches and returns the result of the producer. + /// Validates the document of the key against its schema. + /// The document and schema to get the validation result for. + abstract GetOrAdd : producer : ValidationResultProducer -> key : ValidationResultKey -> ValidationResult + +/// +/// An in-memory cache of validation results. +/// +/// +/// +/// An entry expires once it was not used for the sliding expiration. Concurrent requests for a key that is not cached +/// yet run the validation once and share its result; a validation that throws leaves no entry behind. +/// +/// +/// The cache holds the documents of its keys, so their total size, counted in nodes +/// (), is limited: beyond the limit the least recently used entries are +/// evicted, and a document larger than the whole limit is validated on every request without being cached. This bounds +/// the memory clients can make the cache hold by sending distinct documents; the validation results are not counted. +/// +/// +/// Expired entries are removed while the cache is used, so an idle cache keeps its entries, within the size limit, until +/// it is used again. +/// +/// +type MemoryValidationResultCache + /// How long an entry stays cached after it was last used. + /// The maximum total size of the cached documents, in nodes. + (slidingExpiration : TimeSpan, sizeLimit : int) = + + do + if slidingExpiration <= TimeSpan.Zero then + raise (ArgumentOutOfRangeException (nameof slidingExpiration, slidingExpiration, "The sliding expiration must be positive.")) + if sizeLimit <= 0 then + raise (ArgumentOutOfRangeException (nameof sizeLimit, sizeLimit, "The size limit must be positive.")) + + let cache = + MemoryCache> ( + SlidingExpiration slidingExpiration, + int64 sizeLimit, + (fun key -> int64 key.DocumentSize), + EqualityComparer.Default, + CacheClock.create () + ) + + /// The sliding expiration of a cache created without arguments: 30 seconds. + static member DefaultSlidingExpiration = TimeSpan.FromSeconds 30.0 + + /// The size limit of a cache created without arguments: 100 000 nodes, a few thousand typical documents, which take + /// roughly 10 to 15 MB of memory once parsed. + static member DefaultSizeLimit = 100_000 + /// + /// Creates a cache with the and the + /// . + /// + new () = MemoryValidationResultCache (MemoryValidationResultCache.DefaultSlidingExpiration, MemoryValidationResultCache.DefaultSizeLimit) -/// An in-memory cache for the results of schema/document validations, with a lifetime of 30 seconds. -type MemoryValidationResultCache () = - let expirationPolicy = CacheExpirationPolicy.SlidingExpiration(TimeSpan.FromSeconds 30.0) - let internalCache = MemoryCache>(expirationPolicy) interface IValidationResultCache with - member _.GetOrAdd producer key = - let internalKey = key.GetHashCode() - internalCache.GetOrAddResult internalKey producer + /// + member _.GetOrAdd producer key = cache.GetOrAddResult key producer diff --git a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj index 7fa78649..911acd59 100644 --- a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj +++ b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj @@ -104,6 +104,7 @@ + diff --git a/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs new file mode 100644 index 00000000..402455bf --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs @@ -0,0 +1,341 @@ +module FSharp.Data.GraphQL.Tests.ValidationCacheTests + +open System +open System.Collections +open System.Collections.Generic +open System.Threading +open System.Threading.Tasks +open Xunit + +open FSharp.Data.GraphQL +open FSharp.Data.GraphQL.Ast +open FSharp.Data.GraphQL.Parser +open FSharp.Data.GraphQL.Types +open FSharp.Data.GraphQL.Validation + +/// A schema with the single field f(x): Int, whose argument x is the given one +let private createSchema (argument : InputFieldDef) = + Schema (Define.Object("Query", [ Define.Field ("f", IntType, "Returns 1", [ argument ], fun _ () -> 1) ])) + +/// A schema with the single field f(x: Int): Int, so that a Boolean literal for x fails validation +let private intArgumentSchema = createSchema (Define.Input ("x", Nullable IntType)) + +let private introspected (schema : ISchema) = schema.Introspected + +let private keyOf (query : string) = ValidationResultKey (introspected intArgumentSchema, parse query) + +let private coercionErrorMessage = + "Argument field or value named 'x' can not be coerced. It does not match a valid literal representation for the type." + +/// +/// A valid and an invalid document of with equal structural hash codes. +/// +/// +/// The structural hash code of IntValue i is a constant plus the hash code of i, so the Int literal below +/// has the hash code of the Boolean literal true. The documents differ in that literal only, so their hash codes +/// are equal whatever the seed of string hash codes. +/// +let private collidingDocuments () = + let collidingInt = + int64 ( + uint32 ( + (BooleanValue true).GetHashCode() + - (IntValue 0L).GetHashCode() + ) + ) + let valid = parse $"{{ f(x: %d{collidingInt}) }}" + let invalid = parse "{ f(x: true) }" + Assert.True ( + (valid.GetHashCode () = invalid.GetHashCode ()), + "The test requires documents with equal structural hash codes, but the hash codes differ" + ) + struct (valid, invalid) + +let private ensureAccepted (description : string) (result : Result) = + match result with + | Ok _ -> () + | Error struct (_, errors) -> fail $"Expected %s{description} to pass validation, but it was rejected with %A{errors}" + +let private ensureRejected (description : string) (result : Result) = + match result with + | Ok _ -> fail $"Expected %s{description} to be rejected by validation, but an execution plan was created" + | Error struct (_, errors) -> hasError coercionErrorMessage errors + +[] +let ``Document whose hash collides with a cached valid document is still rejected`` () = + let struct (valid, invalid) = collidingDocuments () + let executor = Executor (intArgumentSchema) + executor.CreateExecutionPlan valid + |> ensureAccepted "the valid document" + executor.CreateExecutionPlan invalid + |> ensureRejected "the invalid document validated right after a colliding valid one" + executor.CreateExecutionPlan valid + |> ensureAccepted "the valid document validated again" + +[] +let ``Document whose hash collides with a cached invalid document is still accepted`` () = + let struct (valid, invalid) = collidingDocuments () + let executor = Executor (intArgumentSchema) + executor.CreateExecutionPlan invalid + |> ensureRejected "the invalid document" + executor.CreateExecutionPlan valid + |> ensureAccepted "the valid document validated right after a colliding invalid one" + +[] +let ``Same document is validated separately against each schema sharing the cache`` () = + let cache = MemoryValidationResultCache () :> IValidationResultCache + let intExecutor = Executor (intArgumentSchema, [], ValueSome cache) + let booleanExecutor = + Executor (createSchema (Define.Input ("x", Nullable BooleanType)), [], ValueSome cache) + let document = parse "{ f(x: 1) }" + intExecutor.CreateExecutionPlan document + |> ensureAccepted "the document with an Int argument against the Int schema" + booleanExecutor.CreateExecutionPlan document + |> ensureRejected "the document with an Int argument against the Boolean schema" + +[] +let ``Keys of documents with colliding structural hash codes are different`` () = + let zero = parse "{ f(x: 0) }" + let colliding = parse "{ f(x: 4294967297) }" + Assert.True ( + (zero.GetHashCode () = colliding.GetHashCode ()), + "The test requires documents with equal structural hash codes, but the hash codes differ" + ) + let schema = introspected intArgumentSchema + Assert.False ( + (ValidationResultKey (schema, zero)).Equals(ValidationResultKey (schema, colliding)), + "Expected the keys of { f(x: 0) } and { f(x: 4294967297) } to be different, but they are equal" + ) + +[] +let ``Keys of equal documents parsed separately are equal`` () = + let query = + "query Q($v: Int) { a: f(x: $v) @include(if: true) ...F } fragment F on Query { f(x: [1.5, \"s\", { y: null }]) }" + let first = keyOf query + let second = keyOf query + Assert.True (first.Equals second, "Expected the keys of two parses of one query to be equal, but they are different") + Assert.True ( + (first.GetHashCode () = second.GetHashCode ()), + $"Expected the keys of two parses of one query to have equal hash codes, but got %d{first.GetHashCode ()} and %d{second.GetHashCode ()}" + ) + +[] +let ``Keys of one document and two schema instances are different`` () = + let first = introspected (createSchema (Define.Input ("x", Nullable IntType))) + let second = introspected (createSchema (Define.Input ("x", Nullable IntType))) + Assert.True ((first = second), "The test requires structurally equal schemas, but they differ") + let document = parse "{ f(x: 1) }" + Assert.False ( + (ValidationResultKey (first, document)).Equals(ValidationResultKey (second, document)), + "Expected keys of different schema instances to be different, but they are equal" + ) + +[] +let ``Document size counts the nodes of the document`` () = + let simple = keyOf "{ f(x: 1) }" + // The document, the operation, the field, the argument and its value + Assert.True ((simple.DocumentSize = 5), $"Expected {{ f(x: 1) }} to have 5 nodes, but got %d{simple.DocumentSize}") + let complex = + keyOf "query Q($v: [Int!]) { a: f(x: $v) @include(if: true) ...F } fragment F on Query { f }" + // The document; the operation, its variable and the 3 type references of [Int!]; the field, its argument and + // variable value, its directive, the directive's argument and Boolean value; the fragment spread; the fragment + // definition and its field + Assert.True ((complex.DocumentSize = 15), $"Expected the complex document to have 15 nodes, but got %d{complex.DocumentSize}") + +[] +let ``Concurrent requests for one key run the validation once`` () : Task = task { + let cache = MemoryValidationResultCache () :> IValidationResultCache + let key = keyOf "{ f(x: 1) }" + let callers = 8 + let runs = ref 0 + use firstRunStarted = new ManualResetEventSlim false + use release = new ManualResetEventSlim false + use barrier = new Barrier (callers) + let producer () = + Interlocked.Increment runs |> ignore + firstRunStarted.Set () + release.Wait (TimeSpan.FromSeconds 10.0) |> ignore + Success + let requests = + Array.init callers (fun _ -> + Task.Factory.StartNew>( + (fun () -> + barrier.SignalAndWait () + cache.GetOrAdd producer key), + TaskCreationOptions.LongRunning + )) + Assert.True (firstRunStarted.Wait (TimeSpan.FromSeconds 10.0), "No caller started the validation") + // Give the other callers time to request the key while the first validation is still running; the assertion + // below holds however late they come, since a late caller finds the cached result + do! Task.Delay 200 + release.Set () + let! results = Task.WhenAll requests + Assert.All (results, fun result -> Assert.True (result.IsSuccess, $"Expected every caller to get the shared result, but got %A{result}")) + Assert.True ((runs.Value = 1), $"Expected the validation to run once for %d{callers} concurrent callers, but it ran %d{runs.Value} times") +} + +[] +let ``Validation that throws is run again by the next request`` () = + let cache = MemoryValidationResultCache () :> IValidationResultCache + let key = keyOf "{ f(x: 1) }" + let runs = ref 0 + let producer () = + runs.Value <- runs.Value + 1 + if runs.Value = 1 then + failwith "Validation failed" + else + Success + throws(fun () -> cache.GetOrAdd producer key |> ignore) + |> ignore + let result = cache.GetOrAdd producer key + Assert.True ( + (result.IsSuccess && runs.Value = 2), + $"Expected the request after a failed validation to validate again and succeed, but got %A{result} after %d{runs.Value} runs" + ) + +[] +let ``Validation result cache does not keep documents larger than its size limit`` () = + let cache = MemoryValidationResultCache (TimeSpan.FromMinutes 1.0, 4) :> IValidationResultCache + let runs = ref 0 + let producer () = + runs.Value <- runs.Value + 1 + Success + // 3 nodes: the document, the operation and the field + let small = keyOf "{ f }" + cache.GetOrAdd producer small |> ignore + cache.GetOrAdd producer small |> ignore + Assert.True ((runs.Value = 1), $"Expected a document within the size limit to be validated once, but it was validated %d{runs.Value} times") + // 5 nodes + let large = keyOf "{ f(x: 1) }" + cache.GetOrAdd producer large |> ignore + cache.GetOrAdd producer large |> ignore + Assert.True ( + (runs.Value = 3), + $"Expected a document over the size limit to be validated on every request, but it was validated %d{runs.Value - 1} times in 2 requests" + ) + +/// A cache of strings whose size is their length, on a clock the test sets +let private createCache (policy : CacheExpirationPolicy) (sizeLimit : int64) (now : TimeSpan ref) = + MemoryCache(policy, sizeLimit, (fun (key : string) -> int64 key.Length), StringComparer.Ordinal, fun () -> now.Value) + +/// Gets the value of the key from the cache; a value produced for the key is the number of times it was produced +let private getCounting (cache : MemoryCache) (productions : Dictionary) (key : string) = + cache.GetOrAddResult key (fun () -> + let count = + match productions.TryGetValue key with + | true, count -> count + 1 + | false, _ -> 1 + productions[key] <- count + count) + +let private ensureProduction (expected : int) (description : string) (actual : int) = + Assert.True ( + (actual = expected), + $"Expected %s{description} to return the value produced the %d{expected}. time, but got the value produced the %d{actual}. time" + ) + +[] +let ``Cache hit refreshes the sliding expiration of the entry`` () = + let now = ref TimeSpan.Zero + let cache = createCache (SlidingExpiration (TimeSpan.FromSeconds 30.0)) Int64.MaxValue now + let get = getCounting cache (Dictionary StringComparer.Ordinal) + get "key" |> ensureProduction 1 "the first request" + now.Value <- TimeSpan.FromSeconds 20.0 + get "key" + |> ensureProduction 1 "a request 20 s after the first" + // 45 s after the entry was created, but 25 s after it was last used + now.Value <- TimeSpan.FromSeconds 45.0 + cache.RemoveExpired () + Assert.True ((cache.Count = 1), "Expected the entry used 25 s ago to survive removing the expired entries, but it was removed") + get "key" + |> ensureProduction 1 "a request 25 s after the last use" + now.Value <- TimeSpan.FromSeconds 76.0 + get "key" + |> ensureProduction 2 "a request 31 s after the last use" + +[] +let ``Cache hit does not extend an absolute expiration`` () = + let now = ref TimeSpan.Zero + let cache = createCache (AbsoluteExpiration (TimeSpan.FromSeconds 30.0)) Int64.MaxValue now + let get = getCounting cache (Dictionary StringComparer.Ordinal) + get "key" |> ensureProduction 1 "the first request" + now.Value <- TimeSpan.FromSeconds 20.0 + get "key" + |> ensureProduction 1 "a request 20 s after the first" + now.Value <- TimeSpan.FromSeconds 31.0 + get "key" + |> ensureProduction 2 "a request 31 s after the entry was created" + +[] +let ``Cache over its size limit evicts the least recently used entries`` () = + let now = ref TimeSpan.Zero + let cache = createCache NoExpiration 10L now + let get = getCounting cache (Dictionary StringComparer.Ordinal) + get "aaaa" |> ensureProduction 1 "the first request of aaaa" + now.Value <- TimeSpan.FromSeconds 1.0 + get "bbbb" |> ensureProduction 1 "the first request of bbbb" + // Using aaaa makes bbbb the least recently used entry + now.Value <- TimeSpan.FromSeconds 2.0 + get "aaaa" + |> ensureProduction 1 "the second request of aaaa" + now.Value <- TimeSpan.FromSeconds 3.0 + get "cccc" |> ensureProduction 1 "the first request of cccc" + Assert.True ((cache.Size = 8L), $"Expected the cache to evict one entry of size 4 to get under its limit of 10, but its size is %d{cache.Size}") + get "aaaa" + |> ensureProduction 1 "a request of aaaa after the eviction" + get "cccc" + |> ensureProduction 1 "a request of cccc after the eviction" + get "bbbb" + |> ensureProduction 2 "a request of the evicted bbbb" + +[] +let ``Entry larger than the size limit is produced on every request without being cached`` () = + let now = ref TimeSpan.Zero + let cache = createCache NoExpiration 10L now + let get = getCounting cache (Dictionary StringComparer.Ordinal) + get "elevenchars" + |> ensureProduction 1 "the first request of an entry over the limit" + get "elevenchars" + |> ensureProduction 2 "the second request of an entry over the limit" + Assert.True ((cache.Count = 0), $"Expected no entry to be cached, but the cache has %d{cache.Count}") + +/// A schema that counts how often its introspected representation is read +let private countIntrospectedReads (schema : ISchema) (reads : int ref) = { + new ISchema with + member _.Query = schema.Query + member _.Mutation = schema.Mutation + member _.Subscription = schema.Subscription + interface ISchema with + member _.TypeMap = schema.TypeMap + member _.Query = (schema :> ISchema).Query + member _.Mutation = (schema :> ISchema).Mutation + member _.Subscription = (schema :> ISchema).Subscription + member _.Directives = schema.Directives + member _.TryFindType typeName = schema.TryFindType typeName + member _.GetPossibleTypes typeDef = schema.GetPossibleTypes typeDef + member _.IsPossibleType abstractDef objectDef = schema.IsPossibleType abstractDef objectDef + member _.Introspected = + Interlocked.Increment reads |> ignore + schema.Introspected + member _.ParseError path error = schema.ParseError path error + member _.SubscriptionProvider = schema.SubscriptionProvider + member _.LiveFieldSubscriptionProvider = schema.LiveFieldSubscriptionProvider + interface IEnumerable with + member _.GetEnumerator () = (schema :> IEnumerable).GetEnumerator() + interface IEnumerable with + member _.GetEnumerator () = (schema :> IEnumerable).GetEnumerator() +} + +[] +let ``Executor does not read the introspected schema per request`` () = + let reads = ref 0 + let executor = + Executor (countIntrospectedReads (createSchema (Define.Input ("x", Nullable IntType)) :> ISchema) reads) + let readsAfterConstruction = reads.Value + for value in 1..3 do + executor.CreateExecutionPlan $"{{ f(x: %d{value}) }}" + |> ensureAccepted $"the document with x = %d{value}" + Assert.True ( + (reads.Value = readsAfterConstruction), + $"Expected the executor to read the introspected schema only while it is created (%d{readsAfterConstruction} times), but 3 requests made it %d{reads.Value}" + ) From 483fd01f17a80e6ab572ec76699c14d699e7a74a Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 10 Oct 2026 04:09:42 +0200 Subject: [PATCH 2/4] Fixed the review findings of the validation result cache * Eviction copies the entries with ConcurrentDictionary.ToArray, which takes a consistent snapshot; copying them as a collection threw when another thread added an entry meanwhile, failing the request * Requests skip caching while another thread evicts and the cache is over its limit, so that additions cannot outrun the eviction * The size of a key is the estimated memory of its document in bytes, counting the characters of its strings, so that a single large string literal no longer counts as one node; the default limit is 16 MiB * Documented that execution plans must not be cached by DocumentId alone * Tests for keys with equal hash codes, the memory estimate, an oversized document not evicting others and eviction under concurrent additions Co-Authored-By: Claude Opus 5.5 --- RELEASE_NOTES.md | 4 +- docs/execution-pipeline.md | 2 +- src/FSharp.Data.GraphQL.Server/Executor.fs | 18 ++++- .../Helpers/MemoryCache.fs | 8 +- .../ValidationResultCache.fs | 62 ++++++++++----- .../ValidationCacheTests.fs | 76 +++++++++++++++---- 6 files changed, 129 insertions(+), 41 deletions(-) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index c260d4bd..1b2f8ff0 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -309,9 +309,9 @@ * Added the validation rules of incremental delivery: `@stream` only on list fields, no `@defer` or `@stream` in a subscription operation or on a mutation root field unless disabled with `if: false`, and labels must be string literals unique within each operation, counting the fragments it spreads * **Breaking Change** Fixed the validation result cache serving the result of one document for another: it identified results by the 32-bit structural hash codes of the document and of the introspected schema, which different documents share, such as `{ f(x: 0) }` and `{ f(x: 4294967297) }`, so an invalid document could pass validation with the cached result of a valid one. `ValidationResultKey` now holds the `Document`, compared structurally, and the `IntrospectionSchema` instance, compared by reference, instead of the `DocumentId` and `SchemaId` hash codes; its hash code only buckets keys and is mixed with a secret seed chosen per process, so that clients cannot craft many documents sharing one. `ExecutionPlan.DocumentId` is unchanged * Fixed `MemoryValidationResultCache` validating a document once per concurrent request for it while it was not cached yet; concurrent requests now share a single validation -* Fixed the sliding expiration of `MemoryValidationResultCache` and of the client provider's design-time caches, which expired an entry 30 seconds after it was added however often it was used, because a cache hit did not refresh its last use +* Fixed the sliding expiration of `MemoryValidationResultCache` and of the client provider's design-time caches, which expired an entry 30 seconds after it was added however often it was used, because a cache hit did not refresh its last use. A provider used at least every 30 seconds therefore keeps its schema, and picks up a changed introspection file or server only once it has gone unused for 30 seconds * Fixed every `MemoryValidationResultCache`, including the one an `Executor` creates when given none, starting a timer that was never stopped and kept the cache and all its entries alive until the process exited; expired entries are now removed while the cache is used -* Added a size limit to `MemoryValidationResultCache`, which now holds the documents of its keys: the total size of the cached documents, in nodes counted by `ValidationResultKey.DocumentSize`, is limited to `MemoryValidationResultCache.DefaultSizeLimit` (100 000) or to the `sizeLimit` of the new constructor `MemoryValidationResultCache (slidingExpiration, sizeLimit)`; beyond it the least recently used entries are evicted, and a document larger than the whole limit is validated on every request without being cached +* Added a size limit to `MemoryValidationResultCache`, which now holds the documents of its keys: the total size of the cached documents, their estimated memory in bytes as `ValidationResultKey.DocumentSize` counts it (a fixed amount per node, and two bytes per character of names and strings), is limited to `MemoryValidationResultCache.DefaultSizeLimit` (16 MiB) or to the `sizeLimit` of the new constructor `MemoryValidationResultCache (slidingExpiration, sizeLimit)`; beyond it the least recently used entries are evicted, and a document larger than the whole limit is validated on every request without being cached * Changed `Executor` to read `ISchema.Introspected` once, when it is created, instead of computing the structural hash code of the whole introspected schema on every request * Added `GraphQLTransportWS.SubProtocol`, the `graphql-transport-ws` sub-protocol name * Fixed `graphql-transport-ws` delivery of `@defer` and `@stream` results, which are now sent as soon as they are produced instead of after a fixed 5 second delay, followed by a final payload with `hasNext: false` diff --git a/docs/execution-pipeline.md b/docs/execution-pipeline.md index 8b3cab7b..fd4f375d 100644 --- a/docs/execution-pipeline.md +++ b/docs/execution-pipeline.md @@ -29,7 +29,7 @@ As the name suggests, `ExecutionPlan` and its components (a tree of objects know - Combining information from the query AST (resolved fields / aliases) with server-side information about them (field and type definitions); - Preparation of the hooks in the execution chain that will be supplied with potential variables upon execution. -Splitting planning and execution phases is a good idea when you have the same GraphQL query requested many times (with potentially different variables). This way you can compute the execution plan once and cache it. You can use `executionPlan.DocumentId` as a cache identifier. `DocumentId` is also returned as one of the top level fields in the response, so it can be used from the client side. Other GraphQL implementations describe that technique as **persistent queries**. +Splitting planning and execution phases is a good idea when you have the same GraphQL query requested many times (with potentially different variables). This way you can compute the execution plan once and cache it. Key the cache by the query text or the parsed document itself, not by `executionPlan.DocumentId` alone: that is a hash code, which different documents can share, so a cache keyed by it could execute a document that was never validated with the plan of another. `DocumentId` is also returned as one of the top level fields in the response, so it can be used from the client side. Other GraphQL implementations describe that technique as **persistent queries**. ## Execution phase diff --git a/src/FSharp.Data.GraphQL.Server/Executor.fs b/src/FSharp.Data.GraphQL.Server/Executor.fs index 4b40166e..4b4fbfa8 100644 --- a/src/FSharp.Data.GraphQL.Server/Executor.fs +++ b/src/FSharp.Data.GraphQL.Server/Executor.fs @@ -237,10 +237,17 @@ type Executor<'Root>(schema: ISchema<'Root>, middlewares : IExecutorMiddleware s | Ok executionPlan -> execute (executionPlan, data, variables, getInputContext) | Error (documentId, errors) -> async.Return <| GQLExecutionResult.Invalid(documentId, errors, meta) + /// /// Creates an execution plan for provided GraphQL document AST without /// executing it. This is useful in cases when you have the same query executed /// multiple times with different parameters. In that case, query can be used - /// to construct execution plan, which then is cached (using DocumentId as a key) and reused when needed. + /// to construct execution plan, which then is cached and reused when needed. + /// + /// + /// Key a cache of execution plans by the document itself, not by alone: that is + /// a hash code, which different documents can share, so a cache keyed by it could execute a document that was never + /// validated with the plan of another. + /// /// The parsed GraphQL query string. /// The name of the operation that should be executed on the parsed document. /// A plain dictionary of metadata that can be used through execution plan customizations. @@ -248,10 +255,17 @@ type Executor<'Root>(schema: ISchema<'Root>, middlewares : IExecutorMiddleware s let meta = defaultValueArg meta Metadata.Empty createExecutionPlan (ast, operationName, meta) + /// /// Creates an execution plan for provided GraphQL query string without /// executing it. This is useful in cases when you have the same query executed /// multiple times with different parameters. In that case, query can be used - /// to construct execution plan, which then is cached (using DocumentId as a key) and reused when needed. + /// to construct execution plan, which then is cached and reused when needed. + /// + /// + /// Key a cache of execution plans by the query string itself, not by alone: that + /// is a hash code, which different documents can share, so a cache keyed by it could execute a document that was never + /// validated with the plan of another. + /// /// The GraphQL query string. /// The name of the operation that should be executed on the parsed document. /// A plain dictionary of metadata that can be used through execution plan customizations. diff --git a/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs b/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs index 4b6b02ee..657170b0 100644 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs +++ b/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs @@ -107,7 +107,9 @@ type internal MemoryCache<'key, 'value> // Evicting down to 90% of the limit instead of just below it lets many additions pass before the next scan, // so that a cache kept full by new keys does not sort its entries on every addition let target = sizeLimit - sizeLimit / 10L - let byLastUsage = entries |> Seq.toArray |> Array.sortBy _.Value.LastUsage + // ToArray takes a consistent snapshot under the locks of the dictionary; copying it as a collection reads its + // count first and throws when another thread adds an entry before the copy + let byLastUsage = entries.ToArray () |> Array.sortBy _.Value.LastUsage let mutable index = 0 while Interlocked.Read &totalSize > target && index < byLastUsage.Length do let pair = byLastUsage[index] @@ -161,6 +163,10 @@ type internal MemoryCache<'key, 'value> if size > sizeLimit then // An entry larger than the whole cache would evict all the others, so its value is not cached at all producer () + elif Interlocked.Read &totalSize > sizeLimit && Volatile.Read &maintaining = 1 then + // Another thread is evicting and the cache is still over its limit: entries added meanwhile would only + // outrun the eviction, so the value is not cached until it has caught up + producer () else let added = CacheEntry (Lazy<'value> (Func<'value> producer, LazyThreadSafetyMode.ExecutionAndPublication), size, now) // Concurrent requests for the key all get the entry added first and force its single lazy value diff --git a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs index 0e54c271..2732022f 100644 --- a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs +++ b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs @@ -39,10 +39,16 @@ module internal DocumentHashing = z <- (z ^^^ (z >>> 27)) * 0x94D049BB133111EBUL z ^^^ (z >>> 31) + /// The average memory of a node of a parsed document, without the characters of its strings, in bytes. On .NET 10, + /// parsed documents take between 0.6 and 1.2 times the estimate it gives: more for plain fields, less for arguments + /// and directives + [] + let private NodeBytes = 128L + [] type private Accumulator () = let mutable state = seed - let mutable size = 0 + let mutable size = 0L member _.State = state member _.Size = size @@ -50,12 +56,15 @@ module internal DocumentHashing = member _.Add (value : uint64) = state <- mix state value // String hash codes are themselves randomized per process on .NET; .NET Framework does not randomize them, but - // only the client provider runs there, hashing documents written by the developer rather than sent by clients - member this.Add (value : string) = this.Add (uint64 (uint32 (StringComparer.Ordinal.GetHashCode value))) + // only the client provider runs there, hashing documents written by the developer rather than sent by clients. + // A string takes two bytes per character, which the size counts: a single literal can be as large as the document + member this.Add (value : string) = + size <- size + 2L * int64 value.Length + this.Add (uint64 (uint32 (StringComparer.Ordinal.GetHashCode value))) - /// Adds a node of the document, identified by its kind, and counts it + /// Adds a node of the document, identified by its kind, and counts its memory member this.Node (kind : uint64) = - size <- size + 1 + size <- size + NodeBytes this.Add kind let private addOptional (acc : Accumulator) (value : string voption) = @@ -91,7 +100,8 @@ module internal DocumentHashing = acc.Add (uint64 value) | FloatValue value -> acc.Node 5UL - // Document equality holds 0.0 equal to -0.0 and every NaN equal to any other, so they must hash alike + // Document equality holds 0.0 equal to -0.0, so they must hash alike; it never holds a document with a NaN + // equal to any other, so hashing every NaN alike only saves telling their payloads apart let bits = if value = 0.0 then 0L elif Double.IsNaN value then BitConverter.DoubleToInt64Bits Double.NaN @@ -181,7 +191,8 @@ module internal DocumentHashing = acc.Node 20UL addFragment acc fragment - /// Returns the hash code of the document, seeded per process, and its size: the number of its nodes + /// Returns the hash code of the document, seeded per process, and its size: the estimated memory of the parsed + /// document, in bytes let hashAndMeasure (document : Document) = let acc = Accumulator () acc.Node 0UL @@ -212,9 +223,10 @@ type ValidationResultKey = /// The validated document, compared structurally. val Document : Document - /// The number of nodes of the document: its definitions, selections, arguments, directives, values, variables and - /// type references. - val DocumentSize : int + /// The estimated memory of the parsed document, in bytes: a fixed amount for each of its definitions, selections, + /// arguments, directives, values, variables and type references, and two bytes for each character of its names and + /// strings. + val DocumentSize : int64 val private hashCode : int @@ -231,6 +243,19 @@ type ValidationResultKey = hashCode = int hash ^^^ int (hash >>> 32) } + /// Creates a key with the given hash code, so that tests can make the keys of different documents collide. + /// The schema the document is validated against. + /// The validated document. + /// The hash code of the key. + internal new (schema : IntrospectionSchema, document : Document, hashCode : int) = + let struct (_, documentSize) = DocumentHashing.hashAndMeasure document + { + Schema = schema + Document = document + DocumentSize = documentSize + hashCode = hashCode + } + /// Indicates whether both keys hold the same schema instance and structurally equal documents. /// The key to compare with. member key.Equals (other : ValidationResultKey) = @@ -277,7 +302,7 @@ type IValidationResultCache = /// yet run the validation once and share its result; a validation that throws leaves no entry behind. /// /// -/// The cache holds the documents of its keys, so their total size, counted in nodes +/// The cache holds the documents of its keys, so their total size, the estimated memory of the parsed documents in bytes /// (), is limited: beyond the limit the least recently used entries are /// evicted, and a document larger than the whole limit is validated on every request without being cached. This bounds /// the memory clients can make the cache hold by sending distinct documents; the validation results are not counted. @@ -289,20 +314,20 @@ type IValidationResultCache = /// type MemoryValidationResultCache /// How long an entry stays cached after it was last used. - /// The maximum total size of the cached documents, in nodes. - (slidingExpiration : TimeSpan, sizeLimit : int) = + /// The maximum total size of the cached documents, in bytes of estimated memory. + (slidingExpiration : TimeSpan, sizeLimit : int64) = do if slidingExpiration <= TimeSpan.Zero then raise (ArgumentOutOfRangeException (nameof slidingExpiration, slidingExpiration, "The sliding expiration must be positive.")) - if sizeLimit <= 0 then + if sizeLimit <= 0L then raise (ArgumentOutOfRangeException (nameof sizeLimit, sizeLimit, "The size limit must be positive.")) let cache = MemoryCache> ( SlidingExpiration slidingExpiration, - int64 sizeLimit, - (fun key -> int64 key.DocumentSize), + sizeLimit, + (fun key -> key.DocumentSize), EqualityComparer.Default, CacheClock.create () ) @@ -310,9 +335,8 @@ type MemoryValidationResultCache /// The sliding expiration of a cache created without arguments: 30 seconds. static member DefaultSlidingExpiration = TimeSpan.FromSeconds 30.0 - /// The size limit of a cache created without arguments: 100 000 nodes, a few thousand typical documents, which take - /// roughly 10 to 15 MB of memory once parsed. - static member DefaultSizeLimit = 100_000 + /// The size limit of a cache created without arguments: 16 MiB of estimated memory, a few thousand typical documents. + static member DefaultSizeLimit = 16L * 1024L * 1024L /// /// Creates a cache with the and the diff --git a/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs index 402455bf..a92ed387 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs @@ -13,11 +13,11 @@ open FSharp.Data.GraphQL.Parser open FSharp.Data.GraphQL.Types open FSharp.Data.GraphQL.Validation -/// A schema with the single field f(x): Int, whose argument x is the given one +/// A schema with the single field f(x): Int, whose argument x is the given one let private createSchema (argument : InputFieldDef) = Schema (Define.Object("Query", [ Define.Field ("f", IntType, "Returns 1", [ argument ], fun _ () -> 1) ])) -/// A schema with the single field f(x: Int): Int, so that a Boolean literal for x fails validation +/// A schema with the single field f(x: Int): Int, so that a Boolean literal for x fails validation let private intArgumentSchema = createSchema (Define.Input ("x", Nullable IntType)) let private introspected (schema : ISchema) = schema.Introspected @@ -107,6 +107,18 @@ let ``Keys of documents with colliding structural hash codes are different`` () "Expected the keys of { f(x: 0) } and { f(x: 4294967297) } to be different, but they are equal" ) +[] +let ``Keys of different documents with equal hash codes are different`` () = + // A hash code only buckets the keys, and any two keys can share one, so equality must compare the documents + let schema = introspected intArgumentSchema + let first = ValidationResultKey (schema, parse "{ f(x: 1) }", 42) + let second = ValidationResultKey (schema, parse "{ f(x: 2) }", 42) + Assert.True ((first.GetHashCode () = second.GetHashCode ()), "The test requires keys with equal hash codes, but they differ") + Assert.False ( + first.Equals second, + "Expected the keys of { f(x: 1) } and { f(x: 2) } to be different despite their equal hash codes, but they are equal" + ) + [] let ``Keys of equal documents parsed separately are equal`` () = let query = @@ -131,16 +143,22 @@ let ``Keys of one document and two schema instances are different`` () = ) [] -let ``Document size counts the nodes of the document`` () = - let simple = keyOf "{ f(x: 1) }" - // The document, the operation, the field, the argument and its value - Assert.True ((simple.DocumentSize = 5), $"Expected {{ f(x: 1) }} to have 5 nodes, but got %d{simple.DocumentSize}") +let ``Document size estimates the memory of the nodes and strings of the document`` () = + let withInt = keyOf "{ f(x: 1) }" + let characters = String ('s', 100_000) + let withString = keyOf $"{{ f(x: \"%s{characters}\") }}" + // The documents have the same nodes, with an Int and a String value for x, so they differ by the characters of the + // string, two bytes each: a document with a single large literal must count as large + Assert.True ( + (withString.DocumentSize - withInt.DocumentSize = 200_000L), + $"Expected a 100 000-character string to add 200 000 bytes, but it added %d{withString.DocumentSize - withInt.DocumentSize}" + ) let complex = keyOf "query Q($v: [Int!]) { a: f(x: $v) @include(if: true) ...F } fragment F on Query { f }" - // The document; the operation, its variable and the 3 type references of [Int!]; the field, its argument and - // variable value, its directive, the directive's argument and Boolean value; the fragment spread; the fragment - // definition and its field - Assert.True ((complex.DocumentSize = 15), $"Expected the complex document to have 15 nodes, but got %d{complex.DocumentSize}") + Assert.True ( + (complex.DocumentSize > withInt.DocumentSize), + $"Expected a document with more nodes to be larger, but got %d{complex.DocumentSize} and %d{withInt.DocumentSize}" + ) [] let ``Concurrent requests for one key run the validation once`` () : Task = task { @@ -195,24 +213,27 @@ let ``Validation that throws is run again by the next request`` () = [] let ``Validation result cache does not keep documents larger than its size limit`` () = - let cache = MemoryValidationResultCache (TimeSpan.FromMinutes 1.0, 4) :> IValidationResultCache + let small = keyOf "{ f }" + let large = keyOf "{ f(x: 1) }" + // Between the sizes of the two documents, which have 3 and 5 nodes + let cache = + MemoryValidationResultCache (TimeSpan.FromMinutes 1.0, small.DocumentSize + 1L) :> IValidationResultCache let runs = ref 0 let producer () = runs.Value <- runs.Value + 1 Success - // 3 nodes: the document, the operation and the field - let small = keyOf "{ f }" cache.GetOrAdd producer small |> ignore cache.GetOrAdd producer small |> ignore Assert.True ((runs.Value = 1), $"Expected a document within the size limit to be validated once, but it was validated %d{runs.Value} times") - // 5 nodes - let large = keyOf "{ f(x: 1) }" cache.GetOrAdd producer large |> ignore cache.GetOrAdd producer large |> ignore Assert.True ( (runs.Value = 3), $"Expected a document over the size limit to be validated on every request, but it was validated %d{runs.Value - 1} times in 2 requests" ) + // A document over the limit is not cached, so it does not evict the documents within it either + cache.GetOrAdd producer small |> ignore + Assert.True ((runs.Value = 3), "Expected the document within the size limit to stay cached after the ones over it, but it was validated again") /// A cache of strings whose size is their length, on a clock the test sets let private createCache (policy : CacheExpirationPolicy) (sizeLimit : int64) (now : TimeSpan ref) = @@ -293,11 +314,34 @@ let ``Entry larger than the size limit is produced on every request without bein let now = ref TimeSpan.Zero let cache = createCache NoExpiration 10L now let get = getCounting cache (Dictionary StringComparer.Ordinal) + get "small" + |> ensureProduction 1 "the first request of an entry within the limit" get "elevenchars" |> ensureProduction 1 "the first request of an entry over the limit" get "elevenchars" |> ensureProduction 2 "the second request of an entry over the limit" - Assert.True ((cache.Count = 0), $"Expected no entry to be cached, but the cache has %d{cache.Count}") + Assert.True ((cache.Count = 1), $"Expected only the entry within the limit to be cached, but the cache has %d{cache.Count} entries") + get "small" + |> ensureProduction 1 "a request of the entry within the limit after the ones over it" + +[] +let ``Cache evicts while many threads add entries`` () = + let now = ref TimeSpan.Zero + let cache = createCache NoExpiration 1_000L now + let requests = + Array.init 8 (fun thread -> + Task.Factory.StartNew ( + (fun () -> + for i in 0..49_999 do + cache.GetOrAddResult $"%d{thread}-%d{i}" (fun () -> i) + |> ignore), + TaskCreationOptions.LongRunning + )) + // Copying the entries to evict while other threads add entries threw before, failing the requests + Task.WaitAll requests + // A request after the concurrent ones brings the cache back within its limit, whatever they left behind + cache.GetOrAddResult "last" (fun () -> 0) |> ignore + Assert.True ((cache.Size <= 1_000L), $"Expected the cache to be within its size limit of 1000, but its size is %d{cache.Size}") /// A schema that counts how often its introspected representation is read let private countIntrospectedReads (schema : ISchema) (reads : int ref) = { From 941cfd16ae35164dc6c082ea06ede7e215a1aaa8 Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 10 Oct 2026 11:47:06 +0200 Subject: [PATCH 3/4] Asserted with `Assert.Equal` instead of `Assert.True` on a comparison in the cache tests Co-Authored-By: Claude Opus 5.5 --- .../ValidationCacheTests.fs | 159 ++++++++---------- 1 file changed, 71 insertions(+), 88 deletions(-) diff --git a/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs index a92ed387..8d392e04 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs @@ -45,10 +45,8 @@ let private collidingDocuments () = ) let valid = parse $"{{ f(x: %d{collidingInt}) }}" let invalid = parse "{ f(x: true) }" - Assert.True ( - (valid.GetHashCode () = invalid.GetHashCode ()), - "The test requires documents with equal structural hash codes, but the hash codes differ" - ) + // The tests using these documents require them to have equal structural hash codes + Assert.Equal (invalid.GetHashCode (), valid.GetHashCode ()) struct (valid, invalid) let private ensureAccepted (description : string) (result : Result) = @@ -97,15 +95,10 @@ let ``Same document is validated separately against each schema sharing the cach let ``Keys of documents with colliding structural hash codes are different`` () = let zero = parse "{ f(x: 0) }" let colliding = parse "{ f(x: 4294967297) }" - Assert.True ( - (zero.GetHashCode () = colliding.GetHashCode ()), - "The test requires documents with equal structural hash codes, but the hash codes differ" - ) + // The test requires documents with equal structural hash codes + Assert.Equal (zero.GetHashCode (), colliding.GetHashCode ()) let schema = introspected intArgumentSchema - Assert.False ( - (ValidationResultKey (schema, zero)).Equals(ValidationResultKey (schema, colliding)), - "Expected the keys of { f(x: 0) } and { f(x: 4294967297) } to be different, but they are equal" - ) + Assert.NotEqual (ValidationResultKey (schema, zero), ValidationResultKey (schema, colliding)) [] let ``Keys of different documents with equal hash codes are different`` () = @@ -113,11 +106,9 @@ let ``Keys of different documents with equal hash codes are different`` () = let schema = introspected intArgumentSchema let first = ValidationResultKey (schema, parse "{ f(x: 1) }", 42) let second = ValidationResultKey (schema, parse "{ f(x: 2) }", 42) - Assert.True ((first.GetHashCode () = second.GetHashCode ()), "The test requires keys with equal hash codes, but they differ") - Assert.False ( - first.Equals second, - "Expected the keys of { f(x: 1) } and { f(x: 2) } to be different despite their equal hash codes, but they are equal" - ) + // The test requires keys with equal hash codes + Assert.Equal (first.GetHashCode (), second.GetHashCode ()) + Assert.NotEqual (first, second) [] let ``Keys of equal documents parsed separately are equal`` () = @@ -125,22 +116,17 @@ let ``Keys of equal documents parsed separately are equal`` () = "query Q($v: Int) { a: f(x: $v) @include(if: true) ...F } fragment F on Query { f(x: [1.5, \"s\", { y: null }]) }" let first = keyOf query let second = keyOf query - Assert.True (first.Equals second, "Expected the keys of two parses of one query to be equal, but they are different") - Assert.True ( - (first.GetHashCode () = second.GetHashCode ()), - $"Expected the keys of two parses of one query to have equal hash codes, but got %d{first.GetHashCode ()} and %d{second.GetHashCode ()}" - ) + Assert.Equal (first, second) + Assert.Equal (first.GetHashCode (), second.GetHashCode ()) [] let ``Keys of one document and two schema instances are different`` () = let first = introspected (createSchema (Define.Input ("x", Nullable IntType))) let second = introspected (createSchema (Define.Input ("x", Nullable IntType))) - Assert.True ((first = second), "The test requires structurally equal schemas, but they differ") + // The test requires structurally equal schemas + Assert.Equal (first, second) let document = parse "{ f(x: 1) }" - Assert.False ( - (ValidationResultKey (first, document)).Equals(ValidationResultKey (second, document)), - "Expected keys of different schema instances to be different, but they are equal" - ) + Assert.NotEqual (ValidationResultKey (first, document), ValidationResultKey (second, document)) [] let ``Document size estimates the memory of the nodes and strings of the document`` () = @@ -149,14 +135,11 @@ let ``Document size estimates the memory of the nodes and strings of the documen let withString = keyOf $"{{ f(x: \"%s{characters}\") }}" // The documents have the same nodes, with an Int and a String value for x, so they differ by the characters of the // string, two bytes each: a document with a single large literal must count as large - Assert.True ( - (withString.DocumentSize - withInt.DocumentSize = 200_000L), - $"Expected a 100 000-character string to add 200 000 bytes, but it added %d{withString.DocumentSize - withInt.DocumentSize}" - ) + Assert.Equal (200_000L, withString.DocumentSize - withInt.DocumentSize) let complex = keyOf "query Q($v: [Int!]) { a: f(x: $v) @include(if: true) ...F } fragment F on Query { f }" Assert.True ( - (complex.DocumentSize > withInt.DocumentSize), + complex.DocumentSize > withInt.DocumentSize, $"Expected a document with more nodes to be larger, but got %d{complex.DocumentSize} and %d{withInt.DocumentSize}" ) @@ -189,7 +172,8 @@ let ``Concurrent requests for one key run the validation once`` () : Task = task release.Set () let! results = Task.WhenAll requests Assert.All (results, fun result -> Assert.True (result.IsSuccess, $"Expected every caller to get the shared result, but got %A{result}")) - Assert.True ((runs.Value = 1), $"Expected the validation to run once for %d{callers} concurrent callers, but it ran %d{runs.Value} times") + // The validation runs once, however many callers ask for the key at the same time + Assert.Equal (1, runs.Value) } [] @@ -206,10 +190,8 @@ let ``Validation that throws is run again by the next request`` () = throws(fun () -> cache.GetOrAdd producer key |> ignore) |> ignore let result = cache.GetOrAdd producer key - Assert.True ( - (result.IsSuccess && runs.Value = 2), - $"Expected the request after a failed validation to validate again and succeed, but got %A{result} after %d{runs.Value} runs" - ) + Assert.True (result.IsSuccess, $"Expected the request after a failed validation to succeed, but got %A{result}") + Assert.Equal (2, runs.Value) [] let ``Validation result cache does not keep documents larger than its size limit`` () = @@ -224,22 +206,22 @@ let ``Validation result cache does not keep documents larger than its size limit Success cache.GetOrAdd producer small |> ignore cache.GetOrAdd producer small |> ignore - Assert.True ((runs.Value = 1), $"Expected a document within the size limit to be validated once, but it was validated %d{runs.Value} times") + // A document within the size limit is validated once + Assert.Equal (1, runs.Value) cache.GetOrAdd producer large |> ignore cache.GetOrAdd producer large |> ignore - Assert.True ( - (runs.Value = 3), - $"Expected a document over the size limit to be validated on every request, but it was validated %d{runs.Value - 1} times in 2 requests" - ) + // A document over the size limit is validated on every request + Assert.Equal (3, runs.Value) // A document over the limit is not cached, so it does not evict the documents within it either cache.GetOrAdd producer small |> ignore - Assert.True ((runs.Value = 3), "Expected the document within the size limit to stay cached after the ones over it, but it was validated again") + Assert.Equal (3, runs.Value) /// A cache of strings whose size is their length, on a clock the test sets let private createCache (policy : CacheExpirationPolicy) (sizeLimit : int64) (now : TimeSpan ref) = MemoryCache(policy, sizeLimit, (fun (key : string) -> int64 key.Length), StringComparer.Ordinal, fun () -> now.Value) -/// Gets the value of the key from the cache; a value produced for the key is the number of times it was produced +/// Gets the value of the key from the cache; a value produced for the key is the number of times it was produced, so +/// that 1 means the entry is still the one cached first and 2 that it was produced again let private getCounting (cache : MemoryCache) (productions : Dictionary) (key : string) = cache.GetOrAddResult key (fun () -> let count = @@ -249,80 +231,83 @@ let private getCounting (cache : MemoryCache) (productions : Dictio productions[key] <- count count) -let private ensureProduction (expected : int) (description : string) (actual : int) = - Assert.True ( - (actual = expected), - $"Expected %s{description} to return the value produced the %d{expected}. time, but got the value produced the %d{actual}. time" - ) [] let ``Cache hit refreshes the sliding expiration of the entry`` () = let now = ref TimeSpan.Zero let cache = createCache (SlidingExpiration (TimeSpan.FromSeconds 30.0)) Int64.MaxValue now let get = getCounting cache (Dictionary StringComparer.Ordinal) - get "key" |> ensureProduction 1 "the first request" + // The first request + Assert.Equal (1, get "key") now.Value <- TimeSpan.FromSeconds 20.0 - get "key" - |> ensureProduction 1 "a request 20 s after the first" + // A request 20 s after the first + Assert.Equal (1, get "key") // 45 s after the entry was created, but 25 s after it was last used now.Value <- TimeSpan.FromSeconds 45.0 cache.RemoveExpired () - Assert.True ((cache.Count = 1), "Expected the entry used 25 s ago to survive removing the expired entries, but it was removed") - get "key" - |> ensureProduction 1 "a request 25 s after the last use" + // The entry used 25 s ago survives removing the expired entries + Assert.Equal (1, cache.Count) + // A request 25 s after the last use + Assert.Equal (1, get "key") now.Value <- TimeSpan.FromSeconds 76.0 - get "key" - |> ensureProduction 2 "a request 31 s after the last use" + // A request 31 s after the last use + Assert.Equal (2, get "key") [] let ``Cache hit does not extend an absolute expiration`` () = let now = ref TimeSpan.Zero let cache = createCache (AbsoluteExpiration (TimeSpan.FromSeconds 30.0)) Int64.MaxValue now let get = getCounting cache (Dictionary StringComparer.Ordinal) - get "key" |> ensureProduction 1 "the first request" + // The first request + Assert.Equal (1, get "key") now.Value <- TimeSpan.FromSeconds 20.0 - get "key" - |> ensureProduction 1 "a request 20 s after the first" + // A request 20 s after the first + Assert.Equal (1, get "key") now.Value <- TimeSpan.FromSeconds 31.0 - get "key" - |> ensureProduction 2 "a request 31 s after the entry was created" + // A request 31 s after the entry was created + Assert.Equal (2, get "key") [] let ``Cache over its size limit evicts the least recently used entries`` () = let now = ref TimeSpan.Zero let cache = createCache NoExpiration 10L now let get = getCounting cache (Dictionary StringComparer.Ordinal) - get "aaaa" |> ensureProduction 1 "the first request of aaaa" + // The first request of aaaa + Assert.Equal (1, get "aaaa") now.Value <- TimeSpan.FromSeconds 1.0 - get "bbbb" |> ensureProduction 1 "the first request of bbbb" + // The first request of bbbb + Assert.Equal (1, get "bbbb") // Using aaaa makes bbbb the least recently used entry now.Value <- TimeSpan.FromSeconds 2.0 - get "aaaa" - |> ensureProduction 1 "the second request of aaaa" + // The second request of aaaa + Assert.Equal (1, get "aaaa") now.Value <- TimeSpan.FromSeconds 3.0 - get "cccc" |> ensureProduction 1 "the first request of cccc" - Assert.True ((cache.Size = 8L), $"Expected the cache to evict one entry of size 4 to get under its limit of 10, but its size is %d{cache.Size}") - get "aaaa" - |> ensureProduction 1 "a request of aaaa after the eviction" - get "cccc" - |> ensureProduction 1 "a request of cccc after the eviction" - get "bbbb" - |> ensureProduction 2 "a request of the evicted bbbb" + // The first request of cccc + Assert.Equal (1, get "cccc") + // One entry of size 4 is evicted to get under the limit of 10 + Assert.Equal (8L, cache.Size) + // A request of aaaa after the eviction + Assert.Equal (1, get "aaaa") + // A request of cccc after the eviction + Assert.Equal (1, get "cccc") + // A request of the evicted bbbb + Assert.Equal (2, get "bbbb") [] let ``Entry larger than the size limit is produced on every request without being cached`` () = let now = ref TimeSpan.Zero let cache = createCache NoExpiration 10L now let get = getCounting cache (Dictionary StringComparer.Ordinal) - get "small" - |> ensureProduction 1 "the first request of an entry within the limit" - get "elevenchars" - |> ensureProduction 1 "the first request of an entry over the limit" - get "elevenchars" - |> ensureProduction 2 "the second request of an entry over the limit" - Assert.True ((cache.Count = 1), $"Expected only the entry within the limit to be cached, but the cache has %d{cache.Count} entries") - get "small" - |> ensureProduction 1 "a request of the entry within the limit after the ones over it" + // The first request of an entry within the limit + Assert.Equal (1, get "small") + // The first request of an entry over the limit + Assert.Equal (1, get "elevenchars") + // The second request of an entry over the limit + Assert.Equal (2, get "elevenchars") + // Only the entry within the limit is cached + Assert.Equal (1, cache.Count) + // A request of the entry within the limit after the ones over it + Assert.Equal (1, get "small") [] let ``Cache evicts while many threads add entries`` () = @@ -341,7 +326,7 @@ let ``Cache evicts while many threads add entries`` () = Task.WaitAll requests // A request after the concurrent ones brings the cache back within its limit, whatever they left behind cache.GetOrAddResult "last" (fun () -> 0) |> ignore - Assert.True ((cache.Size <= 1_000L), $"Expected the cache to be within its size limit of 1000, but its size is %d{cache.Size}") + Assert.InRange (cache.Size, 0L, 1_000L) /// A schema that counts how often its introspected representation is read let private countIntrospectedReads (schema : ISchema) (reads : int ref) = { @@ -379,7 +364,5 @@ let ``Executor does not read the introspected schema per request`` () = for value in 1..3 do executor.CreateExecutionPlan $"{{ f(x: %d{value}) }}" |> ensureAccepted $"the document with x = %d{value}" - Assert.True ( - (reads.Value = readsAfterConstruction), - $"Expected the executor to read the introspected schema only while it is created (%d{readsAfterConstruction} times), but 3 requests made it %d{reads.Value}" - ) + // The executor reads the introspected schema only while it is created + Assert.Equal (readsAfterConstruction, reads.Value) From 4ec660afaca52a51fe539aa120ab87d60a29a9bb Mon Sep 17 00:00:00 2001 From: XperiAndri Date: Sat, 10 Oct 2026 12:33:42 +0200 Subject: [PATCH 4/4] Held validation results in `Microsoft.Extensions.Caching.Memory` instead of an own cache - `MemoryValidationResultCache` and the design-time cache of provided types hold their entries in a `MemoryCache`. The own `MemoryCache` helper is deleted, and Shared references the package. - New constructors of `MemoryValidationResultCache` take the `IMemoryCache` to use, such as a keyed service. - The validation in flight is shared outside the memory cache: it can neither expire nor be evicted, requests share it even when its result cannot be cached, and the sliding expiration of the result counts from when the validation finished. - The documentation of `AsyncExecute` and of the execution pipeline no longer calls `documentId` unique. Co-Authored-By: Claude Opus 5.5 --- Packages.props | 1 + RELEASE_NOTES.md | 5 +- docs/execution-pipeline.md | 4 +- .../DesignTimeCache.fs | 13 +- src/FSharp.Data.GraphQL.Server/Executor.fs | 8 +- .../FSharp.Data.GraphQL.Shared.fsproj | 2 +- .../Helpers/MemoryCache.fs | 194 -------------- .../ValidationResultCache.fs | 129 +++++++-- .../ValidationCacheTests.fs | 245 ++++++++++-------- 9 files changed, 266 insertions(+), 335 deletions(-) delete mode 100644 src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs diff --git a/Packages.props b/Packages.props index 44c57ab8..829b1af7 100644 --- a/Packages.props +++ b/Packages.props @@ -22,6 +22,7 @@ + diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 1b2f8ff0..277ca8f7 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -308,10 +308,11 @@ * Added `Human.friendsStream` field to the Star Wars sample to demonstrate `@stream` * Added the validation rules of incremental delivery: `@stream` only on list fields, no `@defer` or `@stream` in a subscription operation or on a mutation root field unless disabled with `if: false`, and labels must be string literals unique within each operation, counting the fragments it spreads * **Breaking Change** Fixed the validation result cache serving the result of one document for another: it identified results by the 32-bit structural hash codes of the document and of the introspected schema, which different documents share, such as `{ f(x: 0) }` and `{ f(x: 4294967297) }`, so an invalid document could pass validation with the cached result of a valid one. `ValidationResultKey` now holds the `Document`, compared structurally, and the `IntrospectionSchema` instance, compared by reference, instead of the `DocumentId` and `SchemaId` hash codes; its hash code only buckets keys and is mixed with a secret seed chosen per process, so that clients cannot craft many documents sharing one. `ExecutionPlan.DocumentId` is unchanged -* Fixed `MemoryValidationResultCache` validating a document once per concurrent request for it while it was not cached yet; concurrent requests now share a single validation +* Fixed `MemoryValidationResultCache` validating a document once per concurrent request for it while it was not cached yet; concurrent requests now share a single validation, whether its result ends up cached or not * Fixed the sliding expiration of `MemoryValidationResultCache` and of the client provider's design-time caches, which expired an entry 30 seconds after it was added however often it was used, because a cache hit did not refresh its last use. A provider used at least every 30 seconds therefore keeps its schema, and picks up a changed introspection file or server only once it has gone unused for 30 seconds * Fixed every `MemoryValidationResultCache`, including the one an `Executor` creates when given none, starting a timer that was never stopped and kept the cache and all its entries alive until the process exited; expired entries are now removed while the cache is used -* Added a size limit to `MemoryValidationResultCache`, which now holds the documents of its keys: the total size of the cached documents, their estimated memory in bytes as `ValidationResultKey.DocumentSize` counts it (a fixed amount per node, and two bytes per character of names and strings), is limited to `MemoryValidationResultCache.DefaultSizeLimit` (16 MiB) or to the `sizeLimit` of the new constructor `MemoryValidationResultCache (slidingExpiration, sizeLimit)`; beyond it the least recently used entries are evicted, and a document larger than the whole limit is validated on every request without being cached +* Changed `MemoryValidationResultCache` and the client provider's design-time cache of provided types to hold their entries in a `MemoryCache` of `Microsoft.Extensions.Caching.Memory`, which `FSharp.Data.GraphQL.Shared` now depends on, instead of in a cache of the library's own. The new constructors `MemoryValidationResultCache (cache)` and `MemoryValidationResultCache (cache, slidingExpiration)` take the `IMemoryCache` to use, so that an application can pass one it configures itself, such as a keyed service; it should hold validation results only and have a `SizeLimit` in bytes +* Added a size limit to `MemoryValidationResultCache`, which now holds the documents of its keys: every entry declares the estimated memory of its document in bytes, as `ValidationResultKey.DocumentSize` counts it (a fixed amount per node, and two bytes per character of names and strings), as its size. A cache created without an `IMemoryCache` limits the total to `MemoryValidationResultCache.DefaultSizeLimit` (16 MiB) or to the `sizeLimit` of the new constructor `MemoryValidationResultCache (slidingExpiration, sizeLimit)`: an entry that does not fit is not cached, the least recently used entries are evicted to make room for the next ones, and a document larger than the whole limit is validated on every request without being cached * Changed `Executor` to read `ISchema.Introspected` once, when it is created, instead of computing the structural hash code of the whole introspected schema on every request * Added `GraphQLTransportWS.SubProtocol`, the `graphql-transport-ws` sub-protocol name * Fixed `graphql-transport-ws` delivery of `@defer` and `@stream` results, which are now sent as soon as they are produced instead of after a fixed 5 second delay, followed by a final payload with `hasNext: false` diff --git a/docs/execution-pipeline.md b/docs/execution-pipeline.md index fd4f375d..fffe12d1 100644 --- a/docs/execution-pipeline.md +++ b/docs/execution-pipeline.md @@ -29,7 +29,7 @@ As the name suggests, `ExecutionPlan` and its components (a tree of objects know - Combining information from the query AST (resolved fields / aliases) with server-side information about them (field and type definitions); - Preparation of the hooks in the execution chain that will be supplied with potential variables upon execution. -Splitting planning and execution phases is a good idea when you have the same GraphQL query requested many times (with potentially different variables). This way you can compute the execution plan once and cache it. Key the cache by the query text or the parsed document itself, not by `executionPlan.DocumentId` alone: that is a hash code, which different documents can share, so a cache keyed by it could execute a document that was never validated with the plan of another. `DocumentId` is also returned as one of the top level fields in the response, so it can be used from the client side. Other GraphQL implementations describe that technique as **persistent queries**. +Splitting planning and execution phases is a good idea when you have the same GraphQL query requested many times (with potentially different variables). This way you can compute the execution plan once and cache it. Key the cache by the query text or the parsed document itself, not by `executionPlan.DocumentId` alone: that is a hash code, which different documents can share, so a cache keyed by it could execute a document that was never validated with the plan of another. `DocumentId` is also returned as one of the top level fields in the response, but for the same reason a client must not treat it as the identity of a document. Other GraphQL implementations build **persisted queries** on this technique, and identify a document by a cryptographic hash of its text. ## Execution phase @@ -52,7 +52,7 @@ The execution phase can be performed using one of the two strategies: The result of a GraphQL query execution is a `GQLResponse` object with the following fields: -- `documentId`: which is the hash code of the query's AST document - it can be used to implement execution plan caching (persistent queries). +- `documentId`: which is the hash code of the query's AST document. Different documents can share it, so on its own it identifies neither a document nor its execution plan. - `data`: optional, a formatted GraphQL response matching the requested query (`KeyValuePair seq`). Absent in case of an error that does not allow continuing processing and returning any GraphQL results. - `errors`: optional, contains a list of errors (`GQLProblemDetails`) that occurred during query execution. diff --git a/src/FSharp.Data.GraphQL.Client.DesignTime/DesignTimeCache.fs b/src/FSharp.Data.GraphQL.Client.DesignTime/DesignTimeCache.fs index 41fb2701..adce43f3 100644 --- a/src/FSharp.Data.GraphQL.Client.DesignTime/DesignTimeCache.fs +++ b/src/FSharp.Data.GraphQL.Client.DesignTime/DesignTimeCache.fs @@ -6,6 +6,7 @@ namespace FSharp.Data.GraphQL #if IS_DESIGNTIME open System +open Microsoft.Extensions.Caching.Memory open FSharp.Data.GraphQL.Client open ProviderImplementation.ProvidedTypes open FSharp.Data.GraphQL.Validation @@ -19,10 +20,16 @@ type internal ProviderKey = ExplicitOptionalParameters: bool } module internal ProviderDesignTimeCache = - let private expiration = CacheExpirationPolicy.SlidingExpiration(TimeSpan.FromSeconds 30.0) - let private cache = MemoryCache(expiration) + let private slidingExpiration = TimeSpan.FromSeconds 30.0 + // The keys are the static arguments of the providers of a project, which the developer writes, so the cache needs no size limit + let private cache = new MemoryCache (MemoryCacheOptions ()) let getOrAdd (key : ProviderKey) (defMaker : unit -> ProvidedTypeDefinition) = - cache.GetOrAddResult key defMaker + cache.GetOrCreate ( + key, + fun entry -> + entry.SlidingExpiration <- Nullable slidingExpiration + defMaker () + ) module internal QueryValidationDesignTimeCache = let cache : IValidationResultCache = upcast MemoryValidationResultCache() diff --git a/src/FSharp.Data.GraphQL.Server/Executor.fs b/src/FSharp.Data.GraphQL.Server/Executor.fs index 4b4fbfa8..b42b7470 100644 --- a/src/FSharp.Data.GraphQL.Server/Executor.fs +++ b/src/FSharp.Data.GraphQL.Server/Executor.fs @@ -187,9 +187,9 @@ type Executor<'Root>(schema: ISchema<'Root>, middlewares : IExecutorMiddleware s /// /// Asynchronously executes a provided execution plan. In case of repetitive queries, execution plan may be preprocessed - /// and cached using `documentId` as an identifier. + /// and cached, keyed by the document itself rather than by its `documentId`. /// Returned value is a readonly dictionary consisting of following top level entries: - /// 'documentId' (unique identifier of current document's AST, it can be used as a key/identifier of ExecutionPlan as well), + /// 'documentId' (hash code of current document's AST, which different documents can share, so it identifies neither a document nor its ExecutionPlan), /// 'data' (GraphQL response matching the structure provided in GraphQL query string), and /// 'errors' (optional, contains a list of errors that occurred while executing a GraphQL operation). /// @@ -202,7 +202,7 @@ type Executor<'Root>(schema: ISchema<'Root>, middlewares : IExecutorMiddleware s /// /// Asynchronously executes parsed GraphQL query AST. Returned value is a readonly dictionary consisting of following top level entries: - /// 'documentId' (unique identifier of current document's AST, it can be used as a key/identifier of ExecutionPlan as well), + /// 'documentId' (hash code of current document's AST, which different documents can share, so it identifies neither a document nor its ExecutionPlan), /// 'data' (GraphQL response matching the structure provided in GraphQL query string), and /// 'errors' (optional, contains a list of errors that occurred while executing a GraphQL operation). /// @@ -220,7 +220,7 @@ type Executor<'Root>(schema: ISchema<'Root>, middlewares : IExecutorMiddleware s /// /// Asynchronously executes unparsed GraphQL query AST. Returned value is a readonly dictionary consisting of following top level entries: - /// 'documentId' (unique identifier of current document's AST, it can be used as a key/identifier of ExecutionPlan as well), + /// 'documentId' (hash code of current document's AST, which different documents can share, so it identifies neither a document nor its ExecutionPlan), /// 'data' (GraphQL response matching the structure provided in GraphQL query string), and /// 'errors' (optional, contains a list of errors that occurred while executing a GraphQL operation). /// diff --git a/src/FSharp.Data.GraphQL.Shared/FSharp.Data.GraphQL.Shared.fsproj b/src/FSharp.Data.GraphQL.Shared/FSharp.Data.GraphQL.Shared.fsproj index 3dc6ee7b..e82f69e4 100644 --- a/src/FSharp.Data.GraphQL.Shared/FSharp.Data.GraphQL.Shared.fsproj +++ b/src/FSharp.Data.GraphQL.Shared/FSharp.Data.GraphQL.Shared.fsproj @@ -26,6 +26,7 @@ + @@ -41,7 +42,6 @@ - diff --git a/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs b/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs deleted file mode 100644 index 657170b0..00000000 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs +++ /dev/null @@ -1,194 +0,0 @@ -namespace FSharp.Data.GraphQL - -open System -open System.Collections.Concurrent -open System.Collections.Generic -open System.Diagnostics -open System.Threading - - -// Cache implementation originally based on http://www.fssnip.net/7UT/title/Threadsafe-Generic-MemoryCache-and-Memoize-Function - -type internal CacheExpirationPolicy = - | NoExpiration - | AbsoluteExpiration of TimeSpan - | SlidingExpiration of TimeSpan - -module internal CacheClock = - - /// - /// Creates a monotonic clock returning the time elapsed since its creation. - /// - /// - /// Unlike , it is not affected by adjustments of the system time, which would expire - /// entries early or keep them too long. - /// - let create () = - let stopwatch = Stopwatch.StartNew () - fun () -> stopwatch.Elapsed - -/// An entry of a memory cache: its value, produced at most once, its size, and when it was created and last used, in clock ticks. -[] -type internal CacheEntry<'value> (value : Lazy<'value>, size : int64, created : int64) = - // Every cache hit refreshes it from whichever thread hits the entry, so it is read and written atomically - let mutable lastUsage = created - - member _.Value = value - member _.Size = size - member _.Created = created - member _.LastUsage = Interlocked.Read &lastUsage - member _.Touch (now : int64) = Interlocked.Exchange (&lastUsage, now) |> ignore - -/// -/// A thread-safe in-memory key/value cache with an expiration policy and a size limit. -/// -/// -/// -/// Concurrent requests for a key without an entry run the producer once and share its value: the entry holds a lazy value -/// forced by every requester, so no lock is held while the value is produced and requests for other keys are never -/// blocked. A producer that throws leaves no entry behind. -/// -/// -/// A cache hit refreshes the last usage of the entry, which a sliding expiration counts from, and which orders the -/// entries for eviction: when the total size exceeds the limit, the least recently used entries are evicted. -/// -/// -/// Expired entries are removed while the cache is used, at most once per sweep interval, instead of by a timer: a running -/// timer is rooted by the runtime and would keep the cache and all its entries alive after its owner is gone. -/// -/// -type internal MemoryCache<'key, 'value> - /// When the entries expire. - /// The maximum total size of the entries. - /// Gets the size of the entry of a key. - /// Compares the keys. - /// Returns the time elapsed since a fixed point; tests replace it to control expiration. - (policy : CacheExpirationPolicy, sizeLimit : int64, getSize : 'key -> int64, comparer : IEqualityComparer<'key>, clock : unit -> TimeSpan) = - - let entries = ConcurrentDictionary<'key, CacheEntry<'value>> (comparer) - - // Changed only by whoever adds or removes an entry, so that it always matches the entries in the dictionary - let mutable totalSize = 0L - - let mutable lastSweep = (clock ()).Ticks - - // 1 while a thread sweeps or evicts entries, so that only one does at a time and the others never wait for it - let mutable maintaining = 0 - - let sweepInterval = - let intervalOf (window : TimeSpan) = - if window.TotalSeconds < 1.0 then TimeSpan.FromMilliseconds 100.0 - elif window.TotalMinutes < 1.0 then TimeSpan.FromSeconds 1.0 - else TimeSpan.FromMinutes 1.0 - match policy with - | NoExpiration -> ValueNone - | AbsoluteExpiration lifetime -> ValueSome (intervalOf lifetime).Ticks - | SlidingExpiration window -> ValueSome (intervalOf window).Ticks - - let isExpired (now : int64) (entry : CacheEntry<'value>) = - match policy with - | NoExpiration -> false - | AbsoluteExpiration lifetime -> now - entry.Created > lifetime.Ticks - | SlidingExpiration window -> now - entry.LastUsage > window.Ticks - - /// Removes the entry of the key only if it is still this very entry, never a newer one that replaced it - let tryRemove (key : 'key) (entry : CacheEntry<'value>) = - // ConcurrentDictionary removes a pair through ICollection only when the value matches too, atomically; - // entries have reference equality, so a newer entry of the key never matches - if (entries :> ICollection>>).Remove (KeyValuePair (key, entry)) then - Interlocked.Add (&totalSize, -entry.Size) |> ignore - - let removeExpired (now : int64) = - for pair in entries do - if isExpired now pair.Value then - tryRemove pair.Key pair.Value - - let evictLeastRecentlyUsed () = - // Evicting down to 90% of the limit instead of just below it lets many additions pass before the next scan, - // so that a cache kept full by new keys does not sort its entries on every addition - let target = sizeLimit - sizeLimit / 10L - // ToArray takes a consistent snapshot under the locks of the dictionary; copying it as a collection reads its - // count first and throws when another thread adds an entry before the copy - let byLastUsage = entries.ToArray () |> Array.sortBy _.Value.LastUsage - let mutable index = 0 - while Interlocked.Read &totalSize > target && index < byLastUsage.Length do - let pair = byLastUsage[index] - tryRemove pair.Key pair.Value - index <- index + 1 - - let maintain (now : int64) = - let sweepDue = - match sweepInterval with - | ValueSome interval -> now - Interlocked.Read &lastSweep >= interval - | ValueNone -> false - if - (sweepDue || Interlocked.Read &totalSize > sizeLimit) - && Interlocked.CompareExchange (&maintaining, 1, 0) = 0 - then - try - if sweepDue then - Interlocked.Exchange (&lastSweep, now) |> ignore - removeExpired now - if Interlocked.Read &totalSize > sizeLimit then - evictLeastRecentlyUsed () - finally - Volatile.Write (&maintaining, 0) - - let force (key : 'key) (entry : CacheEntry<'value>) = - try - entry.Value.Value - with _ -> - // Lazy rethrows the exception of a failed producer to everyone forcing it later, so the entry is dropped: - // the next request runs the producer again instead of failing until the entry expires - tryRemove key entry - reraise () - - let getOrAdd (key : 'key) (producer : unit -> 'value) = - let now = (clock ()).Ticks - maintain now - let cached = - match entries.TryGetValue key with - | true, entry when not (isExpired now entry) -> ValueSome entry - | true, expired -> - // An expired entry that no sweep has removed yet is replaced, never served - tryRemove key expired - ValueNone - | _ -> ValueNone - match cached with - | ValueSome entry -> - entry.Touch now - force key entry - | ValueNone -> - let size = getSize key - if size > sizeLimit then - // An entry larger than the whole cache would evict all the others, so its value is not cached at all - producer () - elif Interlocked.Read &totalSize > sizeLimit && Volatile.Read &maintaining = 1 then - // Another thread is evicting and the cache is still over its limit: entries added meanwhile would only - // outrun the eviction, so the value is not cached until it has caught up - producer () - else - let added = CacheEntry (Lazy<'value> (Func<'value> producer, LazyThreadSafetyMode.ExecutionAndPublication), size, now) - // Concurrent requests for the key all get the entry added first and force its single lazy value - let entry = entries.GetOrAdd (key, added) - if obj.ReferenceEquals (entry, added) then - if Interlocked.Add (&totalSize, size) > sizeLimit then - maintain now - else - entry.Touch now - force key entry - - /// Creates a cache without a size limit, comparing the keys with their default equality. - new (policy) = MemoryCache (policy, Int64.MaxValue, (fun _ -> 1L), EqualityComparer<'key>.Default, CacheClock.create ()) - - /// The number of entries, including expired ones not removed yet. - member _.Count = entries.Count - - /// The total size of the entries. - member _.Size = Interlocked.Read &totalSize - - /// Returns the value of the key, running the producer when the key has no live entry. - member _.GetOrAddResult key producer = getOrAdd key producer - - /// Removes the expired entries now instead of on a later access. - member _.RemoveExpired () = removeExpired (clock ()).Ticks diff --git a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs index 2732022f..78d8bfc8 100644 --- a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs +++ b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs @@ -1,9 +1,12 @@ namespace FSharp.Data.GraphQL.Validation open System +open System.Collections.Concurrent open System.Collections.Generic open System.Runtime.CompilerServices open System.Security.Cryptography +open System.Threading +open Microsoft.Extensions.Caching.Memory open FSharp.Data.GraphQL open FSharp.Data.GraphQL.Ast @@ -294,56 +297,126 @@ type IValidationResultCache = abstract GetOrAdd : producer : ValidationResultProducer -> key : ValidationResultKey -> ValidationResult /// -/// An in-memory cache of validation results. +/// A cache of validation results held in an . /// /// /// -/// An entry expires once it was not used for the sliding expiration. Concurrent requests for a key that is not cached -/// yet run the validation once and share its result; a validation that throws leaves no entry behind. +/// An entry expires once it was not used for the sliding expiration, counted from when its validation finished. +/// Concurrent requests for a key that is not cached share a single validation, whether its result ends up cached or not; +/// a validation that throws is run again by the next request. /// /// -/// The cache holds the documents of its keys, so their total size, the estimated memory of the parsed documents in bytes -/// (), is limited: beyond the limit the least recently used entries are -/// evicted, and a document larger than the whole limit is validated on every request without being cached. This bounds -/// the memory clients can make the cache hold by sending distinct documents; the validation results are not counted. +/// The cache holds the documents of its keys, so every entry declares the estimated memory of its document in bytes +/// () as its size. A cache created without an +/// owns one that limits the total of those sizes: an entry that does not fit is not cached, and the least recently used +/// entries are evicted to make room for the next ones. This bounds the memory clients can make the cache hold by sending +/// distinct documents; the validation results are not counted. /// /// -/// Expired entries are removed while the cache is used, so an idle cache keeps its entries, within the size limit, until -/// it is used again. +/// An passed in is used as it is configured, so give it a +/// in bytes: without one it grows with every distinct document clients send. +/// A memory cache with a size limit requires every entry to declare its size, and in the same unit, so pass one that +/// holds validation results only, such as a keyed service, rather than the cache the rest of the application shares. /// /// -type MemoryValidationResultCache - /// How long an entry stays cached after it was last used. - /// The maximum total size of the cached documents, in bytes of estimated memory. - (slidingExpiration : TimeSpan, sizeLimit : int64) = +type MemoryValidationResultCache private (cache : IMemoryCache, slidingExpiration : TimeSpan, ownSizeLimit : int64 voption) = - do - if slidingExpiration <= TimeSpan.Zero then - raise (ArgumentOutOfRangeException (nameof slidingExpiration, slidingExpiration, "The sliding expiration must be positive.")) + static let createOwnCache (sizeLimit : int64) : IMemoryCache = if sizeLimit <= 0L then raise (ArgumentOutOfRangeException (nameof sizeLimit, sizeLimit, "The size limit must be positive.")) + // Evicting a tenth of the limit at a time, instead of the twentieth of the default, lets more additions pass + // before the next compaction of a cache kept full by new documents + new MemoryCache (MemoryCacheOptions (SizeLimit = Nullable sizeLimit, CompactionPercentage = 0.1)) - let cache = - MemoryCache> ( - SlidingExpiration slidingExpiration, - sizeLimit, - (fun key -> key.DocumentSize), - EqualityComparer.Default, - CacheClock.create () - ) + do + match cache with + | null -> nullArg (nameof cache) + | _ -> () + if slidingExpiration <= TimeSpan.Zero then + raise (ArgumentOutOfRangeException (nameof slidingExpiration, slidingExpiration, "The sliding expiration must be positive.")) - /// The sliding expiration of a cache created without arguments: 30 seconds. + // The validations running now. A memory cache does not run the factory of a key once for concurrent requests, so the + // requests for a key share its validation here, and only a finished result is put into the memory cache: a + // validation in flight can neither expire nor be evicted, however long it takes and however full the cache is + let flights = ConcurrentDictionary>> () + + let tryGet (key : obj) = + match cache.TryGetValue key with + | true, (:? ValidationResult as result) -> ValueSome result + | _ -> ValueNone + + let fitsOwnCache (key : ValidationResultKey) = + match ownSizeLimit with + // A memory cache compacts itself whenever an entry does not fit, and a document larger than the whole limit + // never fits, so it is not offered at all: it would evict the other documents on every request + | ValueSome sizeLimit -> key.DocumentSize <= sizeLimit + | ValueNone -> true + + let store (key : ValidationResultKey) (result : ValidationResult) = + if fitsOwnCache key then + // The entry is added when it is disposed + use entry = cache.CreateEntry (box key) + entry.SlidingExpiration <- Nullable slidingExpiration + entry.Size <- Nullable key.DocumentSize + entry.Value <- result + + let validate (producer : ValidationResultProducer) (key : ValidationResultKey) = + let flight = + Lazy> ( + (fun () -> + // A flight that finished after this request looked the key up, and before it started its own, has + // stored the result already + match tryGet (box key) with + | ValueSome result -> result + | ValueNone -> + let result = producer () + store key result + result), + LazyThreadSafetyMode.ExecutionAndPublication + ) + let shared = flights.GetOrAdd (key, flight) + try + shared.Value + finally + // The request that started the flight ends it, after the result is stored, so that a request finding no + // flight finds the result instead. The flight of a validation that threw ends too: the requests sharing it + // get its exception, and the next one validates again + if obj.ReferenceEquals (shared, flight) then + flights.TryRemove key |> ignore + + /// The sliding expiration of a cache created without one: 30 seconds. static member DefaultSlidingExpiration = TimeSpan.FromSeconds 30.0 /// The size limit of a cache created without arguments: 16 MiB of estimated memory, a few thousand typical documents. static member DefaultSizeLimit = 16L * 1024L * 1024L /// - /// Creates a cache with the and the - /// . + /// Creates a cache that owns its memory cache, with the + /// and the . /// new () = MemoryValidationResultCache (MemoryValidationResultCache.DefaultSlidingExpiration, MemoryValidationResultCache.DefaultSizeLimit) + /// Creates a cache that owns its memory cache. + /// How long an entry stays cached after it was last used. + /// The maximum total size of the cached documents, in bytes of estimated memory. + new (slidingExpiration : TimeSpan, sizeLimit : int64) = + MemoryValidationResultCache (createOwnCache sizeLimit, slidingExpiration, ValueSome sizeLimit) + + /// + /// Creates a cache that holds its entries in the given memory cache, with the + /// . + /// + /// The memory cache to hold the validation results in, which should have a size limit in bytes. + new (cache : IMemoryCache) = MemoryValidationResultCache (cache, MemoryValidationResultCache.DefaultSlidingExpiration, ValueNone) + + /// Creates a cache that holds its entries in the given memory cache. + /// The memory cache to hold the validation results in, which should have a size limit in bytes. + /// How long an entry stays cached after it was last used. + new (cache : IMemoryCache, slidingExpiration : TimeSpan) = MemoryValidationResultCache (cache, slidingExpiration, ValueNone) + interface IValidationResultCache with /// - member _.GetOrAdd producer key = cache.GetOrAddResult key producer + member _.GetOrAdd producer key = + match tryGet (box key) with + | ValueSome result -> result + | ValueNone -> validate producer key diff --git a/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs index 8d392e04..1a64e8f2 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs @@ -5,6 +5,9 @@ open System.Collections open System.Collections.Generic open System.Threading open System.Threading.Tasks +open Microsoft.Extensions.Caching.Memory +open Microsoft.Extensions.DependencyInjection +open Microsoft.Extensions.Internal open Xunit open FSharp.Data.GraphQL @@ -24,6 +27,9 @@ let private introspected (schema : ISchema) = schema.Introspected let private keyOf (query : string) = ValidationResultKey (introspected intArgumentSchema, parse query) +/// How long a test waits for another thread before it fails +let private timeout = TimeSpan.FromSeconds 10.0 + let private coercionErrorMessage = "Argument field or value named 'x' can not be coerced. It does not match a valid literal representation for the type." @@ -155,7 +161,7 @@ let ``Concurrent requests for one key run the validation once`` () : Task = task let producer () = Interlocked.Increment runs |> ignore firstRunStarted.Set () - release.Wait (TimeSpan.FromSeconds 10.0) |> ignore + release.Wait timeout |> ignore Success let requests = Array.init callers (fun _ -> @@ -165,7 +171,7 @@ let ``Concurrent requests for one key run the validation once`` () : Task = task cache.GetOrAdd producer key), TaskCreationOptions.LongRunning )) - Assert.True (firstRunStarted.Wait (TimeSpan.FromSeconds 10.0), "No caller started the validation") + Assert.True (firstRunStarted.Wait timeout, "No caller started the validation") // Give the other callers time to request the key while the first validation is still running; the assertion // below holds however late they come, since a late caller finds the cached result do! Task.Delay 200 @@ -216,117 +222,154 @@ let ``Validation result cache does not keep documents larger than its size limit cache.GetOrAdd producer small |> ignore Assert.Equal (3, runs.Value) -/// A cache of strings whose size is their length, on a clock the test sets -let private createCache (policy : CacheExpirationPolicy) (sizeLimit : int64) (now : TimeSpan ref) = - MemoryCache(policy, sizeLimit, (fun (key : string) -> int64 key.Length), StringComparer.Ordinal, fun () -> now.Value) +/// A clock the test sets, which a memory cache counts its expirations by +type private TestClock () = + member val UtcNow = DateTimeOffset (2026, 1, 1, 0, 0, 0, TimeSpan.Zero) with get, set + member clock.Advance (time : TimeSpan) = clock.UtcNow <- clock.UtcNow + time + interface ISystemClock with + member clock.UtcNow = clock.UtcNow + +/// A memory cache that counts the lookups made in it, so that a test knows when a request has passed its lookup +type private CountingMemoryCache (inner : IMemoryCache) = + let mutable lookups = 0 + + member _.Lookups = Volatile.Read &lookups -/// Gets the value of the key from the cache; a value produced for the key is the number of times it was produced, so -/// that 1 means the entry is still the one cached first and 2 that it was produced again -let private getCounting (cache : MemoryCache) (productions : Dictionary) (key : string) = - cache.GetOrAddResult key (fun () -> - let count = - match productions.TryGetValue key with - | true, count -> count + 1 - | false, _ -> 1 - productions[key] <- count - count) + interface IMemoryCache with + member _.TryGetValue (key : obj, value : byref) = + Interlocked.Increment &lookups |> ignore + inner.TryGetValue (key, &value) + member _.CreateEntry key = inner.CreateEntry key + member _.Remove key = inner.Remove key + member _.Dispose () = inner.Dispose () +/// Requests the key on a thread of its own, as the validation it runs or waits for blocks until the test releases it +let private startRequest (cache : IValidationResultCache) (producer : ValidationResultProducer) (key : ValidationResultKey) = + Task.Factory.StartNew> ((fun () -> cache.GetOrAdd producer key), TaskCreationOptions.LongRunning) [] -let ``Cache hit refreshes the sliding expiration of the entry`` () = - let now = ref TimeSpan.Zero - let cache = createCache (SlidingExpiration (TimeSpan.FromSeconds 30.0)) Int64.MaxValue now - let get = getCounting cache (Dictionary StringComparer.Ordinal) - // The first request - Assert.Equal (1, get "key") - now.Value <- TimeSpan.FromSeconds 20.0 - // A request 20 s after the first - Assert.Equal (1, get "key") - // 45 s after the entry was created, but 25 s after it was last used - now.Value <- TimeSpan.FromSeconds 45.0 - cache.RemoveExpired () - // The entry used 25 s ago survives removing the expired entries - Assert.Equal (1, cache.Count) - // A request 25 s after the last use - Assert.Equal (1, get "key") - now.Value <- TimeSpan.FromSeconds 76.0 - // A request 31 s after the last use - Assert.Equal (2, get "key") +let ``Cache hit refreshes the sliding expiration of a validation result`` () = + let clock = TestClock () + use memoryCache = new MemoryCache (MemoryCacheOptions (Clock = clock)) + let cache = MemoryValidationResultCache (memoryCache, TimeSpan.FromSeconds 30.0) :> IValidationResultCache + let key = keyOf "{ f(x: 1) }" + let runs = ref 0 + let producer () = + runs.Value <- runs.Value + 1 + Success + cache.GetOrAdd producer key |> ignore + clock.Advance (TimeSpan.FromSeconds 20.0) + cache.GetOrAdd producer key |> ignore + // 40 s after the result was cached, but 20 s after it was last used + clock.Advance (TimeSpan.FromSeconds 20.0) + cache.GetOrAdd producer key |> ignore + Assert.Equal (1, runs.Value) + // 31 s after the last use + clock.Advance (TimeSpan.FromSeconds 31.0) + cache.GetOrAdd producer key |> ignore + Assert.Equal (2, runs.Value) [] -let ``Cache hit does not extend an absolute expiration`` () = - let now = ref TimeSpan.Zero - let cache = createCache (AbsoluteExpiration (TimeSpan.FromSeconds 30.0)) Int64.MaxValue now - let get = getCounting cache (Dictionary StringComparer.Ordinal) - // The first request - Assert.Equal (1, get "key") - now.Value <- TimeSpan.FromSeconds 20.0 - // A request 20 s after the first - Assert.Equal (1, get "key") - now.Value <- TimeSpan.FromSeconds 31.0 - // A request 31 s after the entry was created - Assert.Equal (2, get "key") +let ``Validation results declare the size of their documents to a memory cache with a size limit`` () = + let first = keyOf "{ f(x: 1) }" + let second = keyOf "{ f(x: 2) }" + // Room for one of the two documents. With nothing to compact the first one stays, whatever the timing + let options = + MemoryCacheOptions (SizeLimit = first.DocumentSize + second.DocumentSize - 1L, CompactionPercentage = 0.0) + use memoryCache = new MemoryCache (options) + let cache = MemoryValidationResultCache (memoryCache) :> IValidationResultCache + let runs = ref 0 + let producer () = + runs.Value <- runs.Value + 1 + Success + cache.GetOrAdd producer first |> ignore + cache.GetOrAdd producer first |> ignore + Assert.Equal (1, runs.Value) + cache.GetOrAdd producer second |> ignore + cache.GetOrAdd producer second |> ignore + // The second document does not fit beside the first, so it is validated on every request + Assert.Equal (3, runs.Value) + Assert.Equal (1, memoryCache.Count) [] -let ``Cache over its size limit evicts the least recently used entries`` () = - let now = ref TimeSpan.Zero - let cache = createCache NoExpiration 10L now - let get = getCounting cache (Dictionary StringComparer.Ordinal) - // The first request of aaaa - Assert.Equal (1, get "aaaa") - now.Value <- TimeSpan.FromSeconds 1.0 - // The first request of bbbb - Assert.Equal (1, get "bbbb") - // Using aaaa makes bbbb the least recently used entry - now.Value <- TimeSpan.FromSeconds 2.0 - // The second request of aaaa - Assert.Equal (1, get "aaaa") - now.Value <- TimeSpan.FromSeconds 3.0 - // The first request of cccc - Assert.Equal (1, get "cccc") - // One entry of size 4 is evicted to get under the limit of 10 - Assert.Equal (8L, cache.Size) - // A request of aaaa after the eviction - Assert.Equal (1, get "aaaa") - // A request of cccc after the eviction - Assert.Equal (1, get "cccc") - // A request of the evicted bbbb - Assert.Equal (2, get "bbbb") +let ``Validation that outlasts the sliding expiration is shared and its result is cached from when it finished`` () : Task = task { + let clock = TestClock () + use memoryCache = new MemoryCache (MemoryCacheOptions (Clock = clock)) + let counting = new CountingMemoryCache (memoryCache) + let cache = MemoryValidationResultCache (counting, TimeSpan.FromSeconds 30.0) :> IValidationResultCache + let key = keyOf "{ f(x: 1) }" + let runs = ref 0 + use started = new ManualResetEventSlim false + use release = new ManualResetEventSlim false + let producer () = + Interlocked.Increment runs |> ignore + started.Set () + release.Wait timeout |> ignore + Success + let first = startRequest cache producer key + Assert.True (started.Wait timeout, "The validation did not start") + // The validation takes twice the sliding expiration + clock.Advance (TimeSpan.FromSeconds 60.0) + let second = startRequest cache producer key + // The first request looks the key up, and its validation once more as it starts; the third lookup is the second request's + Assert.True (SpinWait.SpinUntil ((fun () -> counting.Lookups >= 3), timeout), "The second request did not look the key up") + // Lets the second request go on from its lookup to the validation in flight; coming later it finds the cached + // result, so the assertions below hold either way + do! Task.Delay 200 + release.Set () + let! _ = Task.WhenAll [| first; second |] + Assert.Equal (1, runs.Value) + // 20 s after the validation finished, although 80 s after it started + clock.Advance (TimeSpan.FromSeconds 20.0) + cache.GetOrAdd producer key |> ignore + Assert.Equal (1, runs.Value) +} [] -let ``Entry larger than the size limit is produced on every request without being cached`` () = - let now = ref TimeSpan.Zero - let cache = createCache NoExpiration 10L now - let get = getCounting cache (Dictionary StringComparer.Ordinal) - // The first request of an entry within the limit - Assert.Equal (1, get "small") - // The first request of an entry over the limit - Assert.Equal (1, get "elevenchars") - // The second request of an entry over the limit - Assert.Equal (2, get "elevenchars") - // Only the entry within the limit is cached - Assert.Equal (1, cache.Count) - // A request of the entry within the limit after the ones over it - Assert.Equal (1, get "small") +let ``Concurrent requests share one validation whose result cannot be cached`` () : Task = task { + let key = keyOf "{ f(x: 1) }" + // No room for the document, so its result is never cached + use memoryCache = new MemoryCache (MemoryCacheOptions (SizeLimit = key.DocumentSize - 1L, CompactionPercentage = 0.0)) + let counting = new CountingMemoryCache (memoryCache) + let cache = MemoryValidationResultCache (counting) :> IValidationResultCache + let callers = 8 + let runs = ref 0 + use started = new ManualResetEventSlim false + use release = new ManualResetEventSlim false + let producer () = + Interlocked.Increment runs |> ignore + started.Set () + release.Wait timeout |> ignore + Success + let requests = Array.init callers (fun _ -> startRequest cache producer key) + Assert.True (started.Wait timeout, "No request started the validation") + // Every request looks the key up once, and the validation once more as it starts + Assert.True (SpinWait.SpinUntil ((fun () -> counting.Lookups > callers), timeout), "Not every request looked the key up") + // Lets the requests go on from their lookups to the validation in flight before it finishes + do! Task.Delay 200 + release.Set () + let! results = Task.WhenAll requests + Assert.All (results, fun result -> Assert.True (result.IsSuccess, $"Expected every request to get the shared result, but got %A{result}")) + Assert.Equal (1, runs.Value) + Assert.Equal (0, memoryCache.Count) +} [] -let ``Cache evicts while many threads add entries`` () = - let now = ref TimeSpan.Zero - let cache = createCache NoExpiration 1_000L now - let requests = - Array.init 8 (fun thread -> - Task.Factory.StartNew ( - (fun () -> - for i in 0..49_999 do - cache.GetOrAddResult $"%d{thread}-%d{i}" (fun () -> i) - |> ignore), - TaskCreationOptions.LongRunning - )) - // Copying the entries to evict while other threads add entries threw before, failing the requests - Task.WaitAll requests - // A request after the concurrent ones brings the cache back within its limit, whatever they left behind - cache.GetOrAddResult "last" (fun () -> 0) |> ignore - Assert.InRange (cache.Size, 0L, 1_000L) +let ``Executor caches validation results in a keyed memory cache of the service provider`` () = + let serviceKey = "GraphQL validation results" + let services = ServiceCollection () + services.AddKeyedSingleton ( + serviceKey, + fun _ _ -> new MemoryCache (MemoryCacheOptions (SizeLimit = MemoryValidationResultCache.DefaultSizeLimit)) :> IMemoryCache + ) + |> ignore + use provider = services.BuildServiceProvider () + let memoryCache = provider.GetRequiredKeyedService serviceKey + let validationCache = MemoryValidationResultCache (memoryCache) :> IValidationResultCache + let executor = Executor (intArgumentSchema, [], ValueSome validationCache) + executor.CreateExecutionPlan "{ f(x: 1) }" + |> ensureAccepted "the document" + Assert.Equal (1, (memoryCache :?> MemoryCache).Count) /// A schema that counts how often its introspected representation is read let private countIntrospectedReads (schema : ISchema) (reads : int ref) = {