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 ec961106..277ca8f7 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -307,6 +307,13 @@ * 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, 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 +* 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` * 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/docs/execution-pipeline.md b/docs/execution-pipeline.md index 8b3cab7b..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. 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, 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.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..b42b7470 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 @@ -183,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). /// @@ -198,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). /// @@ -216,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). /// @@ -233,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. @@ -244,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/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 22ca1017..00000000 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/MemoryCache.fs +++ /dev/null @@ -1,125 +0,0 @@ -namespace FSharp.Data.GraphQL - -open System -open System.Collections.Concurrent -open System.Collections.Generic -open System.Timers - - -// Cache implementation 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 diff --git a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs index e1690260..78d8bfc8 100644 --- a/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs +++ b/src/FSharp.Data.GraphQL.Shared/ValidationResultCache.fs @@ -1,24 +1,422 @@ namespace FSharp.Data.GraphQL.Validation -open FSharp.Data.GraphQL 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 +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) + + /// 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 = 0L + + 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. + // 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 its memory + member this.Node (kind : uint64) = + size <- size + NodeBytes + 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, 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 + 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 estimated memory of the parsed + /// document, in bytes + 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 -type ValidationResultProducer = - unit -> ValidationResult + /// The validated document, compared structurally. + val Document : Document + /// 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 + + /// 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) + } + + /// 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) = + key.hashCode = other.hashCode + && obj.ReferenceEquals (key.Schema, other.Schema) + && (obj.ReferenceEquals (key.Document, other.Document) + || EqualityComparer.Default.Equals (key.Document, other.Document)) + + /// + 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 + +/// +/// A cache of validation results held in an . +/// +/// +/// +/// 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 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. +/// +/// +/// 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 private (cache : IMemoryCache, slidingExpiration : TimeSpan, ownSizeLimit : int64 voption) = + + 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)) + + 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 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 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) -/// 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 + match tryGet (box key) with + | ValueSome result -> result + | ValueNone -> validate producer key 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..1a64e8f2 --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ValidationCacheTests.fs @@ -0,0 +1,411 @@ +module FSharp.Data.GraphQL.Tests.ValidationCacheTests + +open System +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 +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) + +/// 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." + +/// +/// 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) }" + // 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) = + 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) }" + // The test requires documents with equal structural hash codes + Assert.Equal (zero.GetHashCode (), colliding.GetHashCode ()) + let schema = introspected intArgumentSchema + Assert.NotEqual (ValidationResultKey (schema, zero), ValidationResultKey (schema, colliding)) + +[] +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) + // 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`` () = + 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.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))) + // The test requires structurally equal schemas + Assert.Equal (first, second) + let document = parse "{ f(x: 1) }" + Assert.NotEqual (ValidationResultKey (first, document), ValidationResultKey (second, document)) + +[] +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.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, + $"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 { + 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 timeout |> ignore + Success + let requests = + Array.init callers (fun _ -> + Task.Factory.StartNew>( + (fun () -> + barrier.SignalAndWait () + cache.GetOrAdd producer key), + TaskCreationOptions.LongRunning + )) + 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 + 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}")) + // The validation runs once, however many callers ask for the key at the same time + Assert.Equal (1, runs.Value) +} + +[] +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, $"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`` () = + 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 + cache.GetOrAdd producer small |> ignore + cache.GetOrAdd producer small |> ignore + // A document within the size limit is validated once + Assert.Equal (1, runs.Value) + cache.GetOrAdd producer large |> ignore + cache.GetOrAdd producer large |> ignore + // 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.Equal (3, runs.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 + + 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 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 ``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 ``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 ``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 ``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) = { + 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}" + // The executor reads the introspected schema only while it is created + Assert.Equal (readsAfterConstruction, reads.Value)