From 34b62ea62f5487f5cf8191bba736878b483b43c1 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 2 Sep 2022 11:18:39 +0100 Subject: [PATCH] Performance: Tasks / Struct (#337) Added: - `Equinox.Core`: `Category` base class, with `Decider` and `Stream` helper `module`s Changed: - Performance: Switch surface APIs to `struct` Tuples and Options where relevant, some due to `struct` changes in https://github.com/jet/FsCodec/pull/82, and use `task` in hot paths - `Equinox.Decider`: `log` is now supplied via `Equinox.Category` - `Equinox.Decider`: `maxAttempts` with a default policy and an optional argument on `Transact*` APIs re #232 - `Equinox`: push `Serilog` dependency from `Equinox` out to `Equinox.Core` --- CHANGELOG.md | 9 +- DOCUMENTATION.md | 41 ++--- README.md | 4 +- samples/Infrastructure/Infrastructure.fsproj | 3 +- samples/Infrastructure/Services.fs | 33 ++-- samples/Store/Domain/Cart.fs | 9 +- samples/Store/Domain/ContactPreferences.fs | 7 +- samples/Store/Domain/Domain.fsproj | 6 +- samples/Store/Domain/Favorites.fs | 7 +- samples/Store/Domain/InventoryItem.fs | 8 +- samples/Store/Domain/SavedForLater.fs | 7 +- samples/Store/Integration/CartIntegration.fs | 36 ++-- samples/Store/Integration/CodecIntegration.fs | 4 +- .../ContactPreferencesIntegration.fs | 43 ++--- .../Store/Integration/FavoritesIntegration.fs | 11 +- samples/Store/Integration/LogIntegration.fs | 4 +- samples/TodoBackend/Todo.fs | 4 +- samples/TodoBackend/TodoBackend.fsproj | 2 +- samples/Tutorial/AsAt.fsx | 4 +- samples/Tutorial/Cosmos.fsx | 8 +- samples/Tutorial/Counter.fsx | 12 +- samples/Tutorial/Favorites.fsx | 11 +- samples/Tutorial/FulfilmentCenter.fsx | 8 +- samples/Tutorial/Gapless.fs | 7 +- samples/Tutorial/Index.fs | 15 +- samples/Tutorial/Sequence.fs | 12 +- samples/Tutorial/Set.fs | 16 +- samples/Tutorial/Todo.fsx | 6 +- samples/Tutorial/Tutorial.fsproj | 4 +- samples/Tutorial/Upload.fs | 16 +- src/Equinox.Core/AsyncBatchingGate.fs | 50 +++-- src/Equinox.Core/AsyncCacheCell.fs | 70 ++++--- src/Equinox.Core/Cache.fs | 33 ++-- src/Equinox.Core/Category.fs | 50 +++++ src/Equinox.Core/Equinox.Core.fsproj | 11 +- src/Equinox.Core/Infrastructure.fs | 21 +++ src/Equinox.Core/StoreCategory.fs | 23 --- src/Equinox.Core/Types.fs | 9 +- .../CosmosStorePrometheus.fs | 4 +- .../Equinox.CosmosStore.Prometheus.fsproj | 4 +- src/Equinox.CosmosStore/CosmosStore.fs | 174 +++++++++--------- .../Equinox.CosmosStore.fsproj | 6 +- .../DynamoStorePrometheus.fs | 4 +- .../Equinox.DynamoStore.Prometheus.fsproj | 4 +- src/Equinox.DynamoStore/DynamoStore.fs | 160 ++++++++-------- .../Equinox.DynamoStore.fsproj | 7 +- .../Equinox.EventStore.fsproj | 6 +- src/Equinox.EventStore/EventStore.fs | 128 ++++++------- src/Equinox.EventStoreDb/Caching.fs | 31 ++-- .../Equinox.EventStoreDb.fsproj | 6 +- src/Equinox.EventStoreDb/EventStoreDb.fs | 142 +++++++------- .../Equinox.MemoryStore.fsproj | 7 +- src/Equinox.MemoryStore/MemoryStore.fs | 84 ++++----- .../Equinox.SqlStreamStore.MsSql.fsproj | 4 +- .../Equinox.SqlStreamStore.MySql.fsproj | 4 +- .../Equinox.SqlStreamStore.Postgres.fsproj | 4 +- .../Equinox.SqlStreamStore.fsproj | 6 +- src/Equinox.SqlStreamStore/SqlStreamStore.fs | 130 ++++++------- src/Equinox/Core.fs | 50 ++++- src/Equinox/Decider.fs | 166 +++++++++-------- src/Equinox/Equinox.fsproj | 9 +- .../AccessStrategies.fs | 14 +- .../CacheCellTests.fs | 32 ++-- .../CosmosFixtures.fs | 4 +- .../DocumentStoreIntegration.fs | 36 ++-- .../Equinox.CosmosStore.Integration.fsproj | 1 + .../JsonConverterTests.fs | 6 +- .../StoreIntegration.fs | 27 ++- .../MemoryStoreIntegration.fs | 13 +- tools/Equinox.Tool/Equinox.Tool.fsproj | 6 +- tools/Equinox.Tool/Program.fs | 11 +- .../Equinox.Tools.TestHarness.fsproj | 5 +- .../Infrastructure.fs | 1 + .../LoadTestRunner.fs | 5 +- 74 files changed, 1022 insertions(+), 903 deletions(-) create mode 100755 src/Equinox.Core/Category.fs delete mode 100755 src/Equinox.Core/StoreCategory.fs diff --git a/CHANGELOG.md b/CHANGELOG.md index 19a6bc16d..142254552 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ The `Unreleased` section name is replaced by the expected version of next releas - `Equinox`: `Decider.Transact`, `TransactAsync`, `TransactExAsync` overloads [#325](https://github.com/jet/equinox/pull/325) - `Equinox.ISyncContext.StreamEventBytes`: Exposes stored size of events in the stream (initial impl provides it for `DynamoStore` only) [#326](https://github.com/jet/equinox/pull/326) +- `Equinox.Core`: `Category` base class, with `Decider` and `Stream` helper `module`s [#337](https://github.com/jet/equinox/pull/337) - `CosmosStore.Prometheus`: Add `rut` tag to enable filtering/grouping by Read vs Write activity as per `DynamoStore` [#321](https://github.com/jet/equinox/pull/321) - `DynamoStore`/`DynamoStore.Prometheus`: Implements the majority of the `CosmosStore` functionality via `FSharp.AWS.DynamoDB` [#321](https://github.com/jet/equinox/pull/321) - `EventStoreDb`: As per `EventStore` module, but using the modern `EventStore.Client.Grpc.Streams` client [#196](https://github.com/jet/equinox/pull/196) @@ -19,8 +20,13 @@ The `Unreleased` section name is replaced by the expected version of next releas ### Changed +- Performance: Switch surface APIs to `struct` Tuples and Options where relevant, some due to `struct` changes in [`FsCodec` #82](https://github.com/jet/FsCodec/pull/82), and use `task` in hot paths [#337](https://github.com/jet/equinox/pull/337) - `Equinox`: Merge `ResolveOption` and `XXXStoreCategory.FromMemento` as `LoadOption` [#308](https://github.com/jet/equinox/pull/308) - `Equinox`: Merge `XXXStoreCategory.Resolve(sn, ?ResolveOption)` and `XXXStoreCategory.FromMemento` as option `LoadOption` parameter on all `Transact` and `Query` methods [#308](https://github.com/jet/equinox/pull/308) +- `Equinox.Decider`: `log` is now supplied via `Equinox.Category` [#337](https://github.com/jet/equinox/pull/337) +- `Equinox.Decider`: `maxAttempts` with a default policy and an optional argument on `Transact*` APIs [#337](https://github.com/jet/equinox/pull/337) +- `Equinox`: push `Serilog` dependency out to `Equinox.Core` [#337](https://github.com/jet/equinox/pull/337) +- `Equinox.Core`: push `FsCodec` dependency out to concrete stores [#337](https://github.com/jet/equinox/pull/337) - `CosmosStore`: Require `Microsoft.Azure.Cosmos` v `3.27.0` [#310](https://github.com/jet/equinox/pull/310) - `CosmosStore`: Switch to natively using `JsonElement` event bodies [#305](https://github.com/jet/equinox/pull/305) :pray: [@ylibrach](https://github.com/ylibrach) - `CosmosStore`: Switch to natively using `System.Text.Json` for serialization of all `Microsoft.Azure.Cosmos` round-trips [#305](https://github.com/jet/equinox/pull/305) :pray: [@ylibrach](https://github.com/ylibrach) @@ -28,7 +34,8 @@ The `Unreleased` section name is replaced by the expected version of next releas - `EventStore`: Target `EventStore.Client` v `22.0.0-preview`; rename `Connector` -> `EventStoreConnector` [#317](https://github.com/jet/equinox/pull/317) - `Equinox.Tool`/`samples/`: switched to use `Equinox.EventStoreDb` [#196](https://github.com/jet/equinox/pull/196) - Update all non-Client dependencies except `FSharp.Core`, `FSharp.Control.AsyncSeq` [#310](https://github.com/jet/equinox/pull/310) -- Update all Stores to use `FsCodec` v `3.0.0`, with [`EventBody` types switching from `byte[]` to `ReadOnlyMemory`, see FsCodec#75](https://github.com/jet/FsCodec/pull/75) [#323](https://github.com/jet/equinox/pull/323) +- `FSharp.Core` requirement to `6.0.0` [#337](https://github.com/jet/equinox/pull/337) +- Update all Stores to use `FsCodec` v `3.0.0`, with [`EventBody` types switching from `byte[]` to `ReadOnlyMemory` and/or `JsonElement` see FsCodec#75](https://github.com/jet/FsCodec/pull/75) [#323](https://github.com/jet/equinox/pull/323) - `CosmosStore.Core.Initialization.initAux`: Replace hard-coded manual 400 RU with `mode` parameter [#328](https://github.com/jet/equinox/pull/328) :pray: [@brihadish](https://github.com/brihadish) ### Removed diff --git a/DOCUMENTATION.md b/DOCUMENTATION.md index 342605760..1019fa18e 100755 --- a/DOCUMENTATION.md +++ b/DOCUMENTATION.md @@ -274,7 +274,7 @@ Stored Procedure | JavaScript code stored in a Container that (repeatedl Term | Description --------------------------|------------ -Category | Group of Streams bearing a common prefix `{Category}-{StreamId}` +Category | Group of Streams bearing a common prefix `{category}-{streamId}` Event | json or blob payload, together with an Event Type name representing an Event EventStore | [Open source](https://eventstore.org) Event Sourcing-optimized data store server and programming model with powerful integrated projection facilities Rolling Snapshot | Event written to an EventStore stream in order to ensure minimal store roundtrips when there is a Cache miss @@ -308,7 +308,7 @@ module Aggregate (* StreamName section *) let [] Category = "category" -let streamName id = FsCodec.StreamName.create Category (Id.toString id) +let streamName id = struct (Category, Id.toString id) (* Optionally, Helpers/Types *) @@ -372,11 +372,7 @@ type Service internal (resolve : Id -> Equinox.Decider(), stream, maxAttempts = 3) - Service(resolve) +let create resolve = Service(streamName >> resolve) ``` - `Service`'s constructor is `internal`; `create` is the main way in which one @@ -543,10 +539,8 @@ brevity, that implements all the relevant functions above: ```fsharp (* Event stream naming + schemas *) -let [] Category = - "Favorites" -let streamName (id : ClientId) = - FsCodec.StreamName.create Category (ClientId.toString id) +let [] Category = "Favorites" +let streamName (id : ClientId) = struct (Category, ClientId.toString id) type Item = { id: int; name: string; added: DateTimeOffset } type Event = @@ -593,7 +587,7 @@ let toSnapshot state = [Event.Snapshotted (Array.ofList state)] * The Service defines operations in business terms, neutral to any concrete * store selection or implementation supplied only a `resolve` function that can * be used to map from ids (as supplied to the `streamName` function) to an - * Equinox Stream typically the service should be a stateless Singleton + * Equinox.Decider; Typically the service should be a stateless Singleton *) type Service internal (resolve : ClientId -> Equinox.Decider) = @@ -615,10 +609,8 @@ type Service internal (resolve : ClientId -> Equinox.Decider = read clientId -let create resolveStream : Service = - let resolve id = - Equinox.Decider(Serilog.Log.ForContext(), resolveStream (streamName id), maxAttempts = 3) - Service(resolve) +let create resolve : Service = + Service(streamName >> resolve) ``` @@ -697,13 +689,13 @@ Equinox’s Command Handling consists of < 200 lines including interfaces and comments in https://github.com/jet/equinox/tree/master/src/Equinox - the elements you'll touch in a normal application are: -- [`module Flow`](https://github.com/jet/equinox/blob/master/src/Equinox/Core.fs#L34) - +- [`module Impl`](https://github.com/jet/equinox/blob/master/src/Equinox/Core.fs#L33) - internal implementation of Optimistic Concurrency Control / retry loop used by `Decider`. It's recommended to at least scan this file as it defines the Transaction semantics that are central to Equinox and the overall `Decider` concept. -- [`type Decider`](https://github.com/jet/equinox/blob/master/src/Equinox/Decider.fs#L11) - +- [`type Decider`](https://github.com/jet/equinox/blob/master/src/Equinox/Decider.fs#L7) - surface API one uses to `Transact` or `Query` against a specific stream's state -- [`type LoadOption` Discriminated Union](https://github.com/jet/equinox/blob/master/src/Equinox/Decider.fs#L59) - +- [`type LoadOption` Discriminated Union](https://github.com/jet/equinox/blob/master/src/Equinox/Decider.fs#L110) - used to specify optimization overrides to be applied when a `Decider`'s `Query` or `Transact` operations establishes the state of the stream Its recommended to read the examples in conjunction with perusing the code in @@ -846,11 +838,7 @@ type Service internal (resolve : string -> Equinox.Decider> resolve) ``` `Read` above will do a roundtrip to the Store in order to fetch the most recent @@ -921,9 +909,8 @@ result in you ending up with a model that's potentially both: - the `resolve` parameter affords one a sufficient [_seam_](http://www.informit.com/articles/article.aspx?p=359417) that - facilitates testing independently with a mocked or stubbed `IStream` (without - adding any references), or a `MemoryStore` (which does necessitate a - reference to a separate Assembly for clarity) as desired. + facilitates testing independently with `MemoryStore` (which does necessitate a + reference to a separate Assembly] as desired. ### Todo[Backend] walkthrough diff --git a/README.md b/README.md index dc3e739db..135b9d7c5 100644 --- a/README.md +++ b/README.md @@ -133,7 +133,7 @@ The components within this repository are delivered as multi-targeted Nuget pack ## Core library -- `Equinox` [![NuGet](https://img.shields.io/nuget/v/Equinox.svg)](https://www.nuget.org/packages/Equinox/): Store-agnostic decision flow runner that manages the optimistic concurrency protocol. ([depends](https://www.fuget.org/packages/Equinox) on `FsCodec` (for the `StreamName` type-contract), `Serilog` (but no specific Serilog sinks, i.e. you configure to emit to `NLog` etc)) +- `Equinox` [![NuGet](https://img.shields.io/nuget/v/Equinox.svg)](https://www.nuget.org/packages/Equinox/): Store-agnostic decision flow runner that manages the optimistic concurrency protocol and application-level API surface. ([depends](https://www.fuget.org/packages/Equinox) only on `FSharp.Core` v `6.0.0` ## Serialization support @@ -150,7 +150,7 @@ The components within this repository are delivered as multi-targeted Nuget pack ## Data Store libraries -- `Equinox.Core` [![NuGet](https://img.shields.io/nuget/v/Equinox.Core.svg)](https://www.nuget.org/packages/Equinox.Core/): Interfaces and helpers used in the concrete Store implementations, together with the default [`System.Runtime.Caching.Cache`-based] `Cache` implementation. Hosts generic utility types frequently useful alongside Equinox: [`AsyncCacheCell`](https://github.com/jet/equinox/blob/master/src/Equinox.Core/AsyncCacheCell.fs#L36), [`AsyncBatchingGate`](https://github.com/jet/equinox/blob/master/src/Equinox.Core/AsyncBatchingGate.fs#L41). ([depends](https://www.fuget.org/packages/Equinox.Core) on `Equinox`, `System.Runtime.Caching`) +- `Equinox.Core` [![NuGet](https://img.shields.io/nuget/v/Equinox.Core.svg)](https://www.nuget.org/packages/Equinox.Core/): Interfaces and helpers used in the concrete Store implementations, together with the default [`System.Runtime.Caching.Cache`-based] `Cache` implementation. Hosts generic utility types frequently useful alongside Equinox: [`AsyncCacheCell`](https://github.com/jet/equinox/blob/master/src/Equinox.Core/AsyncCacheCell.fs#L36), [`AsyncBatchingGate`](https://github.com/jet/equinox/blob/master/src/Equinox.Core/AsyncBatchingGate.fs#L41). ([depends](https://www.fuget.org/packages/Equinox.Core) on `Equinox`, `System.Runtime.Caching`, `Serilog` (but not specific Serilog sinks, i.e. you configure to emit to `NLog` etc)) - `Equinox.MemoryStore` [![MemoryStore NuGet](https://img.shields.io/nuget/v/Equinox.MemoryStore.svg)](https://www.nuget.org/packages/Equinox.MemoryStore/): In-memory store for integration testing/performance base-lining/providing out-of-the-box zero dependency storage for examples. ([depends](https://www.fuget.org/packages/Equinox.MemoryStore) on `Equinox.Core`, `FsCodec`) - `Equinox.CosmosStore` [![CosmosStore NuGet](https://img.shields.io/nuget/v/Equinox.CosmosStore.svg)](https://www.nuget.org/packages/Equinox.CosmosStore/): Azure CosmosDB Adapter with integrated 'unfolds' feature, facilitating optimal read performance in terms of latency and RU costs, instrumented to meet Jet's production monitoring requirements. ([depends](https://www.fuget.org/packages/Equinox.CosmosStore) on `Equinox.Core`, `Microsoft.Azure.Cosmos` >= `3.27`, `FsCodec`, `System.Text.Json`, `FSharp.Control.AsyncSeq` >= `2.0.23`) - `Equinox.CosmosStore.Prometheus` [![CosmosStore.Prometheus NuGet](https://img.shields.io/nuget/v/Equinox.CosmosStore.Prometheus.svg)](https://www.nuget.org/packages/Equinox.CosmosStore.Prometheus/): Integration package providing a `Serilog.Core.ILogEventSink` that extracts detailed metrics information attached to the `LogEvent`s and feeds them to the `prometheus-net`'s `Prometheus.Metrics` static instance. ([depends](https://www.fuget.org/packages/Equinox.CosmosStore.Prometheus) on `Equinox.CosmosStore`, `prometheus-net >= 3.6.0`) diff --git a/samples/Infrastructure/Infrastructure.fsproj b/samples/Infrastructure/Infrastructure.fsproj index 294075d40..42b9a9d85 100644 --- a/samples/Infrastructure/Infrastructure.fsproj +++ b/samples/Infrastructure/Infrastructure.fsproj @@ -22,9 +22,10 @@ + + - diff --git a/samples/Infrastructure/Services.fs b/samples/Infrastructure/Services.fs index 9ff77e6db..89ccc7284 100644 --- a/samples/Infrastructure/Services.fs +++ b/samples/Infrastructure/Services.fs @@ -1,49 +1,50 @@ module Samples.Infrastructure.Services open Domain +open Equinox open FsCodec.SystemTextJson.Interop // use ToJsonElementCodec because we are doing an overkill example open Microsoft.Extensions.DependencyInjection open System -type StreamResolver(storage) = - member _.Resolve - ( codec : FsCodec.IEventCodec<'event, ReadOnlyMemory, _>, +type Store(store) = + member _.Category + ( codec : FsCodec.IEventCodec<'event, ReadOnlyMemory, unit>, fold: 'state -> 'event seq -> 'state, initial : 'state, - snapshot : ('event -> bool) * ('state -> 'event)) = - match storage with + snapshot : ('event -> bool) * ('state -> 'event)) : Category<'event, 'state, unit> = + match store with | Storage.StorageConfig.Memory store -> - Equinox.MemoryStore.MemoryStoreCategory(store, codec, fold, initial).Resolve + Equinox.MemoryStore.MemoryStoreCategory(store, codec, fold, initial) | Storage.StorageConfig.Cosmos (store, caching, unfolds) -> let accessStrategy = if unfolds then Equinox.CosmosStore.AccessStrategy.Snapshot snapshot else Equinox.CosmosStore.AccessStrategy.Unoptimized - Equinox.CosmosStore.CosmosStoreCategory<'event,'state,_>(store, codec.ToJsonElementCodec(), fold, initial, caching, accessStrategy).Resolve + Equinox.CosmosStore.CosmosStoreCategory<'event,'state,_>(store, codec.ToJsonElementCodec(), fold, initial, caching, accessStrategy) | Storage.StorageConfig.Dynamo (store, caching, unfolds) -> let accessStrategy = if unfolds then Equinox.DynamoStore.AccessStrategy.Snapshot snapshot else Equinox.DynamoStore.AccessStrategy.Unoptimized - Equinox.DynamoStore.DynamoStoreCategory<'event,'state,_>(store, FsCodec.Deflate.EncodeTryDeflate codec, fold, initial, caching, accessStrategy).Resolve + Equinox.DynamoStore.DynamoStoreCategory<'event,'state,_>(store, FsCodec.Deflate.EncodeTryDeflate codec, fold, initial, caching, accessStrategy) | Storage.StorageConfig.Es (context, caching, unfolds) -> let accessStrategy = if unfolds then Equinox.EventStoreDb.AccessStrategy.RollingSnapshots snapshot |> Some else None - Equinox.EventStoreDb.EventStoreCategory<'event,'state,_>(context, codec, fold, initial, ?caching = caching, ?access = accessStrategy).Resolve + Equinox.EventStoreDb.EventStoreCategory<'event,'state,_>(context, codec, fold, initial, ?caching = caching, ?access = accessStrategy) | Storage.StorageConfig.Sql (context, caching, unfolds) -> let accessStrategy = if unfolds then Equinox.SqlStreamStore.AccessStrategy.RollingSnapshots snapshot |> Some else None - Equinox.SqlStreamStore.SqlStreamStoreCategory<'event,'state,_>(context, codec, fold, initial, ?caching = caching, ?access = accessStrategy).Resolve + Equinox.SqlStreamStore.SqlStreamStoreCategory<'event,'state,_>(context, codec, fold, initial, ?caching = caching, ?access = accessStrategy) type ServiceBuilder(storageConfig, handlerLog) = - let cat = StreamResolver(storageConfig) + let store = Store storageConfig member _.CreateFavoritesService() = let fold, initial = Favorites.Fold.fold, Favorites.Fold.initial - let snapshot = Favorites.Fold.isOrigin,Favorites.Fold.snapshot - Favorites.create handlerLog (cat.Resolve(Favorites.Events.codec,fold,initial,snapshot)) + let snapshot = Favorites.Fold.isOrigin, Favorites.Fold.snapshot + Favorites.create <| store.Category(Favorites.Events.codec, fold, initial, snapshot).Resolve handlerLog member _.CreateSaveForLaterService() = let fold, initial = SavedForLater.Fold.fold, SavedForLater.Fold.initial - let snapshot = SavedForLater.Fold.isOrigin,SavedForLater.Fold.compact - SavedForLater.create 50 handlerLog (cat.Resolve(SavedForLater.Events.codec,fold,initial,snapshot)) + let snapshot = SavedForLater.Fold.isOrigin, SavedForLater.Fold.compact + SavedForLater.create 50 <| store.Category(SavedForLater.Events.codec, fold, initial, snapshot).Resolve handlerLog member _.CreateTodosService() = let fold, initial = TodoBackend.Fold.fold, TodoBackend.Fold.initial let snapshot = TodoBackend.Fold.isOrigin, TodoBackend.Fold.snapshot - TodoBackend.create handlerLog (cat.Resolve(TodoBackend.Events.codec,fold,initial,snapshot)) + TodoBackend.create <| store.Category(TodoBackend.Events.codec, fold, initial, snapshot).Resolve handlerLog let register (services : IServiceCollection, storageConfig, handlerLog) = let regF (factory : IServiceProvider -> 'T) = services.AddSingleton<'T>(fun (sp: IServiceProvider) -> factory sp) |> ignore diff --git a/samples/Store/Domain/Cart.fs b/samples/Store/Domain/Cart.fs index 541a2e375..a53c26322 100644 --- a/samples/Store/Domain/Cart.fs +++ b/samples/Store/Domain/Cart.fs @@ -1,6 +1,6 @@ module Domain.Cart -let streamName (id: CartId) = FsCodec.StreamName.create "Cart" (CartId.toString id) +let streamName (id: CartId) = struct ("Cart", CartId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] @@ -164,8 +164,5 @@ type Service internal (resolve : CartId -> Equinox.Decider> resolve) diff --git a/samples/Store/Domain/ContactPreferences.fs b/samples/Store/Domain/ContactPreferences.fs index bd95324fc..5fcecd955 100644 --- a/samples/Store/Domain/ContactPreferences.fs +++ b/samples/Store/Domain/ContactPreferences.fs @@ -1,7 +1,7 @@ module Domain.ContactPreferences type Id = Id of email: string -let streamName (Id email) = FsCodec.StreamName.create "ContactPreferences" email // TODO hash >> base64 +let streamName (Id email) = struct ("ContactPreferences", email) // TODO hash >> base64 // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -56,6 +56,5 @@ type Service internal (resolve : Id -> Equinox.Decider let decider = resolve email decider.Query(id, Equinox.AllowStale) -let create log resolveStream = - let resolve id = Equinox.Decider(log, resolveStream (streamName id), maxAttempts = 3) - Service(resolve) +let create resolve = + Service(streamName >> resolve) diff --git a/samples/Store/Domain/Domain.fsproj b/samples/Store/Domain/Domain.fsproj index e58129504..049eaa212 100644 --- a/samples/Store/Domain/Domain.fsproj +++ b/samples/Store/Domain/Domain.fsproj @@ -15,10 +15,10 @@ - + - - + + diff --git a/samples/Store/Domain/Favorites.fs b/samples/Store/Domain/Favorites.fs index 8c5156c86..b2f38bcb5 100644 --- a/samples/Store/Domain/Favorites.fs +++ b/samples/Store/Domain/Favorites.fs @@ -1,6 +1,6 @@ module Domain.Favorites -let streamName (id: ClientId) = FsCodec.StreamName.create "Favorites" (ClientId.toString id) +let streamName (id: ClientId) = struct ("Favorites", ClientId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -77,6 +77,5 @@ type Service internal (resolve : ClientId -> Equinox.Decider (), decideUnfavorite sku c.State), fun () c -> c.Version) -let create log resolveStream = - let resolve id = Equinox.Decider(log, resolveStream (streamName id), maxAttempts = 3) - Service(resolve) +let create resolve = + Service(streamName >> resolve) diff --git a/samples/Store/Domain/InventoryItem.fs b/samples/Store/Domain/InventoryItem.fs index 3b6db0cca..2bd26cc5c 100644 --- a/samples/Store/Domain/InventoryItem.fs +++ b/samples/Store/Domain/InventoryItem.fs @@ -3,7 +3,7 @@ module Domain.InventoryItem open System -let streamName (id : InventoryItemId) = FsCodec.StreamName.create "InventoryItem" (InventoryItemId.toString id) +let streamName (id : InventoryItemId) = struct ("InventoryItem", InventoryItemId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -66,7 +66,5 @@ type Service internal (resolve : InventoryItemId -> Equinox.Decider(), resolveStream (streamName id), maxAttempts = 3) - Service(resolve) +let create resolve = + Service(streamName >> resolve) diff --git a/samples/Store/Domain/SavedForLater.fs b/samples/Store/Domain/SavedForLater.fs index c24cb547f..f8cc3becf 100644 --- a/samples/Store/Domain/SavedForLater.fs +++ b/samples/Store/Domain/SavedForLater.fs @@ -3,7 +3,7 @@ open System open System.Collections.Generic -let streamName (id: ClientId) = FsCodec.StreamName.create "SavedForLater" (ClientId.toString id) +let streamName (id: ClientId) = struct ("SavedForLater", ClientId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -142,6 +142,5 @@ type Service internal (resolve : ClientId -> Equinox.Decider> resolve, maxSavedItems) diff --git a/samples/Store/Integration/CartIntegration.fs b/samples/Store/Integration/CartIntegration.fs index 53236d7db..641d5e669 100644 --- a/samples/Store/Integration/CartIntegration.fs +++ b/samples/Store/Integration/CartIntegration.fs @@ -11,20 +11,22 @@ let snapshot = Cart.Fold.isOrigin, Cart.Fold.snapshot let createMemoryStore () = MemoryStore.VolatileStore>() let createServiceMemory log store = - Cart.create log (MemoryStore.MemoryStoreCategory(store, Cart.Events.codec, fold, initial).Resolve) + MemoryStore.MemoryStoreCategory(store, Cart.Events.codec, fold, initial) + |> Decider.resolve Serilog.Log.Logger |> Cart.create + let codec = Cart.Events.codec let codecJe = Cart.Events.codecJe -let resolveGesStreamWithRollingSnapshots context = - EventStoreDb.EventStoreCategory(context, codec, fold, initial, access = EventStoreDb.AccessStrategy.RollingSnapshots snapshot).Resolve -let resolveGesStreamWithoutCustomAccessStrategy context = - EventStoreDb.EventStoreCategory(context, codec, fold, initial).Resolve +let categoryGesStreamWithRollingSnapshots context = + EventStoreDb.EventStoreCategory(context, codec, fold, initial, access = EventStoreDb.AccessStrategy.RollingSnapshots snapshot) +let categoryGesStreamWithoutCustomAccessStrategy context = + EventStoreDb.EventStoreCategory(context, codec, fold, initial) -let resolveCosmosStreamWithSnapshotStrategy context = - CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.Snapshot snapshot).Resolve -let resolveCosmosStreamWithoutCustomAccessStrategy context = - CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.Unoptimized).Resolve +let categoryCosmosStreamWithSnapshotStrategy context = + CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.Snapshot snapshot) +let categoryCosmosStreamWithoutCustomAccessStrategy context = + CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.Unoptimized) let addAndThenRemoveItemsManyTimesExceptTheLastOne context cartId skuId (service: Cart.Service) count = service.ExecuteManyAsync(cartId, false, seq { @@ -51,35 +53,35 @@ type Tests(testOutputHelper) = do! act service args } - let arrangeEs connect choose resolveStream = async { + let arrangeEs connect choose createCategory = async { let client = connect log let context = choose client defaultBatchSize - return Cart.create log (resolveStream context) } + return Cart.create (createCategory context |> Decider.resolve log) } [] let ``Can roundtrip against EventStore, correctly folding the events without compaction semantics`` args = Async.RunSynchronously <| async { - let! service = arrangeEs connectToLocalEventStoreNode createContext resolveGesStreamWithoutCustomAccessStrategy + let! service = arrangeEs connectToLocalEventStoreNode createContext categoryGesStreamWithoutCustomAccessStrategy do! act service args } [] let ``Can roundtrip against EventStore, correctly folding the events with RollingSnapshots`` args = Async.RunSynchronously <| async { - let! service = arrangeEs connectToLocalEventStoreNode createContext resolveGesStreamWithRollingSnapshots + let! service = arrangeEs connectToLocalEventStoreNode createContext categoryGesStreamWithRollingSnapshots do! act service args } - let arrangeCosmos connect resolveStream = + let arrangeCosmos connect createCategory = let context : CosmosStore.CosmosStoreContext = connect log defaultQueryMaxItems - Cart.create log (resolveStream context) + Cart.create (createCategory context |> Decider.resolve log) [] let ``Can roundtrip against Cosmos, correctly folding the events without custom access strategy`` args = Async.RunSynchronously <| async { - let service = arrangeCosmos createPrimaryContext resolveCosmosStreamWithoutCustomAccessStrategy + let service = arrangeCosmos createPrimaryContext categoryCosmosStreamWithoutCustomAccessStrategy do! act service args } [] let ``Can roundtrip against Cosmos, correctly folding the events with With Snapshotting`` args = Async.RunSynchronously <| async { - let service = arrangeCosmos createPrimaryContext resolveCosmosStreamWithSnapshotStrategy + let service = arrangeCosmos createPrimaryContext categoryCosmosStreamWithSnapshotStrategy do! act service args } diff --git a/samples/Store/Integration/CodecIntegration.fs b/samples/Store/Integration/CodecIntegration.fs index 006d724ac..9fc342c2e 100644 --- a/samples/Store/Integration/CodecIntegration.fs +++ b/samples/Store/Integration/CodecIntegration.fs @@ -42,9 +42,9 @@ let codec = FsCodec.NewtonsoftJson.Codec.Create() [] let ``Can roundtrip, rendering correctly`` (x: SimpleDu) = - let serialized = codec.Encode(None, x) + let serialized = codec.Encode((), x) let d = serialized.Data render x =! if d.IsEmpty then null else System.Text.Encoding.UTF8.GetString(d.Span) let adapted = FsCodec.Core.TimelineEvent.Create(-1L, serialized.EventType, d) - let deserialized = codec.TryDecode adapted |> Option.get + let deserialized = codec.TryDecode adapted |> ValueOption.get deserialized =! x diff --git a/samples/Store/Integration/ContactPreferencesIntegration.fs b/samples/Store/Integration/ContactPreferencesIntegration.fs index 31c1c5762..b0ebb687d 100644 --- a/samples/Store/Integration/ContactPreferencesIntegration.fs +++ b/samples/Store/Integration/ContactPreferencesIntegration.fs @@ -9,22 +9,23 @@ let fold, initial = ContactPreferences.Fold.fold, ContactPreferences.Fold.initia let createMemoryStore () = MemoryStore.VolatileStore<_>() let createServiceMemory log store = - ContactPreferences.create log (MemoryStore.MemoryStoreCategory(store, FsCodec.Box.Codec.Create(), fold, initial).Resolve) + MemoryStore.MemoryStoreCategory(store, FsCodec.Box.Codec.Create(), fold, initial).Resolve log + |> ContactPreferences.create let codec = ContactPreferences.Events.codec let codecJe = ContactPreferences.Events.codecJe -let resolveStreamGesWithOptimizedStorageSemantics context = - EventStoreDb.EventStoreCategory(context 1, codec, fold, initial, access = EventStoreDb.AccessStrategy.LatestKnownEvent).Resolve -let resolveStreamGesWithoutAccessStrategy context = - EventStoreDb.EventStoreCategory(context defaultBatchSize, codec, fold, initial).Resolve - -let resolveStreamCosmosWithLatestKnownEventSemantics context = - CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.LatestKnownEvent).Resolve -let resolveStreamCosmosUnoptimized context = - CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.Unoptimized).Resolve -let resolveStreamCosmosRollingUnfolds context = +let categoryGesWithOptimizedStorageSemantics context = + EventStoreDb.EventStoreCategory(context 1, codec, fold, initial, access = EventStoreDb.AccessStrategy.LatestKnownEvent) +let categoryGesWithoutAccessStrategy context = + EventStoreDb.EventStoreCategory(context defaultBatchSize, codec, fold, initial) + +let categoryCosmosWithLatestKnownEventSemantics context = + CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.LatestKnownEvent) +let categoryCosmosUnoptimized context = + CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.Unoptimized) +let categoryCosmosRollingUnfolds context = let access = CosmosStore.AccessStrategy.Custom(ContactPreferences.Fold.isOrigin, ContactPreferences.Fold.transmute) - CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, access).Resolve + CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, access) type Tests(testOutputHelper) = let testOutput = TestOutput testOutputHelper @@ -43,41 +44,41 @@ type Tests(testOutputHelper) = do! act service args } - let arrangeEs connect choose resolveStream = async { + let arrangeEs connect choose createCategory = async { let client = connect log let context = choose client - return ContactPreferences.create log (resolveStream context) } + return ContactPreferences.create (createCategory context |> Decider.resolve log) } [] let ``Can roundtrip against EventStore, correctly folding the events with normal semantics`` args = Async.RunSynchronously <| async { - let! service = arrangeEs connectToLocalEventStoreNode createContext resolveStreamGesWithoutAccessStrategy + let! service = arrangeEs connectToLocalEventStoreNode createContext categoryGesWithoutAccessStrategy do! act service args } [] let ``Can roundtrip against EventStore, correctly folding the events with compaction semantics`` args = Async.RunSynchronously <| async { - let! service = arrangeEs connectToLocalEventStoreNode createContext resolveStreamGesWithOptimizedStorageSemantics + let! service = arrangeEs connectToLocalEventStoreNode createContext categoryGesWithOptimizedStorageSemantics do! act service args } - let arrangeCosmos connect resolveStream queryMaxItems = + let arrangeCosmos connect createCategory queryMaxItems = let context: CosmosStore.CosmosStoreContext = connect log queryMaxItems - ContactPreferences.create log (resolveStream context) + ContactPreferences.create (createCategory context |> Decider.resolve log) [] let ``Can roundtrip against Cosmos, correctly folding the events with Unoptimized semantics`` args = Async.RunSynchronously <| async { - let service = arrangeCosmos createPrimaryContext resolveStreamCosmosUnoptimized defaultQueryMaxItems + let service = arrangeCosmos createPrimaryContext categoryCosmosUnoptimized defaultQueryMaxItems do! act service args } [] let ``Can roundtrip against Cosmos, correctly folding the events with LatestKnownEvent semantics`` args = Async.RunSynchronously <| async { - let service = arrangeCosmos createPrimaryContext resolveStreamCosmosWithLatestKnownEventSemantics 1 + let service = arrangeCosmos createPrimaryContext categoryCosmosWithLatestKnownEventSemantics 1 do! act service args } [] let ``Can roundtrip against Cosmos, correctly folding the events with RollingUnfold semantics`` args = Async.RunSynchronously <| async { - let service = arrangeCosmos createPrimaryContext resolveStreamCosmosRollingUnfolds defaultQueryMaxItems + let service = arrangeCosmos createPrimaryContext categoryCosmosRollingUnfolds defaultQueryMaxItems do! act service args } diff --git a/samples/Store/Integration/FavoritesIntegration.fs b/samples/Store/Integration/FavoritesIntegration.fs index 4b1e4dd01..ca0f63796 100644 --- a/samples/Store/Integration/FavoritesIntegration.fs +++ b/samples/Store/Integration/FavoritesIntegration.fs @@ -10,22 +10,23 @@ let snapshot = Favorites.Fold.isOrigin, Favorites.Fold.snapshot let createMemoryStore () = MemoryStore.VolatileStore<_>() let createServiceMemory log store = - Favorites.create log (MemoryStore.MemoryStoreCategory(store, FsCodec.Box.Codec.Create(), fold, initial).Resolve) + let cat = MemoryStore.MemoryStoreCategory(store, FsCodec.Box.Codec.Create(), fold, initial) + Favorites.create <| cat.Resolve log let codec = Favorites.Events.codec let codecJe = Favorites.Events.codecJe let createServiceGes log context = let cat = EventStoreDb.EventStoreCategory(context, codec, fold, initial, access = EventStoreDb.AccessStrategy.RollingSnapshots snapshot) - Favorites.create log cat.Resolve + Favorites.create <| cat.Resolve log let createServiceCosmosSnapshotsUncached log context = let cat = CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, CosmosStore.AccessStrategy.Snapshot snapshot) - Favorites.create log cat.Resolve + Favorites.create <| cat.Resolve log let createServiceCosmosRollingStateUncached log context = let access = CosmosStore.AccessStrategy.RollingState Favorites.Fold.snapshot let cat = CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, CosmosStore.CachingStrategy.NoCaching, access) - Favorites.create log cat.Resolve + Favorites.create <| cat.Resolve log let createServiceCosmosUnoptimizedButCached log context = let access = CosmosStore.AccessStrategy.Unoptimized @@ -33,7 +34,7 @@ let createServiceCosmosUnoptimizedButCached log context = let cache = Cache ("name", 10) CosmosStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) let cat = CosmosStore.CosmosStoreCategory(context, codecJe, fold, initial, caching, access) - Favorites.create log cat.Resolve + Favorites.create <| cat.Resolve log type Command = | Favorite of date : System.DateTimeOffset * skuIds : SkuId list diff --git a/samples/Store/Integration/LogIntegration.fs b/samples/Store/Integration/LogIntegration.fs index e350caec0..e2000b0fe 100644 --- a/samples/Store/Integration/LogIntegration.fs +++ b/samples/Store/Integration/LogIntegration.fs @@ -109,7 +109,7 @@ type Tests(testOutputHelper) = let log = createLoggerWithMetricsExtraction buffer.Enqueue let client = connectToLocalEventStoreNode log let context = createContext client batchSize - let service = Cart.create log (CartIntegration.resolveGesStreamWithRollingSnapshots context) + let service = Cart.create (CartIntegration.categoryGesStreamWithRollingSnapshots context |> Equinox.Decider.resolve log) let itemCount = batchSize / 2 + 1 let cartId = % Guid.NewGuid() do! act buffer service itemCount ctx cartId skuId "ReadStreamAsyncB-Duration" @@ -121,7 +121,7 @@ type Tests(testOutputHelper) = let buffer = ConcurrentQueue() let log = createLoggerWithMetricsExtraction buffer.Enqueue let context = createPrimaryContext log queryMaxItems - let service = Cart.create log (CartIntegration.resolveCosmosStreamWithSnapshotStrategy context) + let service = Cart.create (CartIntegration.categoryCosmosStreamWithSnapshotStrategy context |> Equinox.Decider.resolve log) let itemCount = queryMaxItems / 2 + 1 let cartId = % Guid.NewGuid() do! act buffer service itemCount ctx cartId skuId "EqxCosmos Tip " // one is a 404, one is a 200 diff --git a/samples/TodoBackend/Todo.fs b/samples/TodoBackend/Todo.fs index 7ebce0b87..42c745039 100644 --- a/samples/TodoBackend/Todo.fs +++ b/samples/TodoBackend/Todo.fs @@ -5,7 +5,7 @@ open Domain // The TodoBackend spec does not dictate having multiple lists, tenants or clients // Here, we implement such a discriminator in order to allow each virtual client to maintain independent state let Category = "Todos" -let streamName (id : ClientId) = FsCodec.StreamName.create Category (ClientId.toString id) +let streamName (id : ClientId) = struct (Category, ClientId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -80,4 +80,4 @@ type Service internal (resolve : ClientId -> Equinox.Decider x.id = item.id) state' } -let create log resolve = Service(fun id -> Equinox.Decider(log, resolve (streamName id), maxAttempts = 3)) +let create resolve = Service(streamName >> resolve) diff --git a/samples/TodoBackend/TodoBackend.fsproj b/samples/TodoBackend/TodoBackend.fsproj index 88d401fcc..0b2d9f7d2 100644 --- a/samples/TodoBackend/TodoBackend.fsproj +++ b/samples/TodoBackend/TodoBackend.fsproj @@ -9,7 +9,7 @@ - + diff --git a/samples/Tutorial/AsAt.fsx b/samples/Tutorial/AsAt.fsx index cbc5020a1..4042fc65c 100644 --- a/samples/Tutorial/AsAt.fsx +++ b/samples/Tutorial/AsAt.fsx @@ -45,7 +45,7 @@ #endif open System -let streamName clientId = FsCodec.StreamName.create "Account" clientId +let streamName clientId = struct ("Account", clientId) module Events = @@ -160,7 +160,7 @@ module EventStore = // rig snapshots to be injected as events into the stream every `snapshotWindow` events let accessStrategy = AccessStrategy.RollingSnapshots (Fold.isValid,Fold.snapshot) let cat = EventStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) - let resolve id = Equinox.Decider(Log.log, cat.Resolve(streamName id), maxAttempts = 3) + let resolve = streamName >> Equinox.Decider.resolve log module Cosmos = diff --git a/samples/Tutorial/Cosmos.fsx b/samples/Tutorial/Cosmos.fsx index 2701c0885..122351c19 100644 --- a/samples/Tutorial/Cosmos.fsx +++ b/samples/Tutorial/Cosmos.fsx @@ -43,7 +43,7 @@ module Log = module Favorites = let Category = "Favorites" - let streamName clientId = FsCodec.StreamName.create Category clientId + let streamName clientId = struct (Category, clientId) module Events = @@ -83,9 +83,7 @@ module Favorites = let decider = resolve clientId decider.Query id - let create resolveStream = - let resolve clientId = Equinox.Decider(Log.log, resolveStream (streamName clientId), maxAttempts = 3) - Service(resolve) + let create resolve = Service(streamName >> resolve) module Cosmos = @@ -94,7 +92,7 @@ module Favorites = let create (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // OR CachingStrategy.NoCaching let category = CosmosStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) - create category.Resolve + create <| Equinox.Decider.resolve Log.log cat let [] appName = "equinox-tutorial" diff --git a/samples/Tutorial/Counter.fsx b/samples/Tutorial/Counter.fsx index fd64da69a..4031684cf 100644 --- a/samples/Tutorial/Counter.fsx +++ b/samples/Tutorial/Counter.fsx @@ -30,7 +30,7 @@ type Event = | Cleared of Cleared interface TypeShape.UnionContract.IUnionContract (* Kind of DDD aggregate ID *) -let streamName (id : string) = FsCodec.StreamName.create "Counter" id +let streamName (id : string) = struct ("Counter", id) type State = State of int let initial : State = State 0 @@ -83,18 +83,18 @@ type Service internal (resolve : string -> Equinox.Decider) = open Serilog let log = LoggerConfiguration().WriteTo.Console().CreateLogger() -let logEvents stream (events : FsCodec.ITimelineEvent<_>[]) = - log.Information("Committed to {stream}, events: {@events}", stream, seq { for x in events -> x.EventType }) +let logEvents c s (events : FsCodec.ITimelineEvent<_>[]) = + log.Information("Committed to {categoryName}-{streamId}, events: {@events}", c, s, seq { for x in events -> x.EventType }) (* We can integration test using an in-memory store See other examples such as Cosmos.fsx to see how we integrate with CosmosDB and/or other concrete stores *) let store = Equinox.MemoryStore.VolatileStore() -let _ = store.Committed.Subscribe(fun (s, xs) -> logEvents s xs) +let _ = store.Committed.Subscribe(fun (c, s, xs) -> logEvents c s xs) let codec = FsCodec.Box.Codec.Create() let cat = Equinox.MemoryStore.MemoryStoreCategory(store, codec, fold, initial) -let resolve instanceId = Equinox.Decider(log, streamName instanceId |> cat.Resolve, maxAttempts = 3) -let service = Service(resolve) +let resolve = cat |> Equinox.Decider.resolve log +let service = Service(streamName >> resolve) let clientId = "ClientA" service.Read(clientId) |> Async.RunSynchronously diff --git a/samples/Tutorial/Favorites.fsx b/samples/Tutorial/Favorites.fsx index 64d3f246f..3a41cf2b3 100644 --- a/samples/Tutorial/Favorites.fsx +++ b/samples/Tutorial/Favorites.fsx @@ -93,7 +93,7 @@ let log = LoggerConfiguration().WriteTo.Console().CreateLogger() // related streams are termed a Category; Each client will have it's own Stream. let Category = "Favorites" -let clientAFavoritesStreamName = FsCodec.StreamName.create Category "ClientA" +let clientAFavoritesStreamName = struct (Category, "ClientA") // For test purposes, we use the in-memory store let store = Equinox.MemoryStore.VolatileStore() @@ -116,10 +116,10 @@ let codec = // Each store has a Category that is used to resolve IStream instances binding to a specific stream in a specific store // ... because the nature of the contract with the handler is such that the store hands over State, we also pass the `initial` and `fold` as we used above let cat = Equinox.MemoryStore.MemoryStoreCategory(store, codec, fold, initial) -let stream streamName = Equinox.Decider(log, cat.Resolve streamName, maxAttempts = 2) +let decider = Equinox.Decider.resolve log cat // We hand the streamId to the resolver -let clientAStream = stream clientAFavoritesStreamName +let clientAStream = decider clientAFavoritesStreamName // ... and pass the stream to the Handler let handler = Handler(clientAStream) @@ -158,9 +158,8 @@ type Service(deciderFor : string -> Handler) = (* See Counter.fsx and Cosmos.fsx for a more compact representation which makes the Handler wiring less obtrusive *) let streamFor (clientId: string) = - let streamName = FsCodec.StreamName.create "Favorites" clientId - let stream = cat.Resolve streamName - let decider = Equinox.Decider(log, stream, maxAttempts = 3) + let streamIds = struct ("Favorites", clientId) + let decider = Equinox.Decider.resolve log cat streamIds Handler(decider) let service = Service(streamFor) diff --git a/samples/Tutorial/FulfilmentCenter.fsx b/samples/Tutorial/FulfilmentCenter.fsx index 51c13bbd1..098e2082b 100644 --- a/samples/Tutorial/FulfilmentCenter.fsx +++ b/samples/Tutorial/FulfilmentCenter.fsx @@ -50,7 +50,7 @@ module Types = module FulfilmentCenter = - let streamName id = FsCodec.StreamName.create "FulfilmentCenter" id + let streamName id = struct ("FulfilmentCenter", id) module Events = @@ -143,8 +143,8 @@ module Store = open FulfilmentCenter let category = CosmosStoreCategory(Store.context, Events.codec, Fold.fold, Fold.initial, Store.cacheStrategy, AccessStrategy.Unoptimized) -let resolve id = Equinox.Decider(Log.log, category.Resolve(streamName id), maxAttempts = 3) -let service = Service(resolve) +let resolve = Equinox.Decider.resolve Log.log category +let service = Service(streamName >> resolve) let fc = "fc0" service.UpdateName(fc, { code="FC000"; name="Head" }) |> Async.RunSynchronously @@ -155,7 +155,7 @@ Log.dumpMetrics () /// Manages ingestion of summary events tagged with the version emitted from FulfilmentCenter.Service.QueryWithVersion module FulfilmentCenterSummary = - let streamName id = FsCodec.StreamName.create "FulfilmentCenterSummary" id + let streamName id = struct ("FulfilmentCenterSummary", id) module Events = type UpdatedData = { version : int64; state : Summary } diff --git a/samples/Tutorial/Gapless.fs b/samples/Tutorial/Gapless.fs index 3c7198d89..6933243b5 100644 --- a/samples/Tutorial/Gapless.fs +++ b/samples/Tutorial/Gapless.fs @@ -5,7 +5,7 @@ module Gapless open System let [] Category = "Gapless" -let streamName id = FsCodec.StreamName.create Category (SequenceId.toString id) +let streamName id = struct (Category, SequenceId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -80,10 +80,7 @@ module Cosmos = let private create (context, cache, accessStrategy) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) // OR CachingStrategy.NoCaching let category = CosmosStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) - let resolve sequenceId = - let streamName = streamName sequenceId - Equinox.Decider(Serilog.Log.Logger, category.Resolve streamName, maxAttempts = 3) - Service(resolve) + Service(streamName >> Equinox.Decider.resolve Serilog.Log.Logger category) module Snapshot = diff --git a/samples/Tutorial/Index.fs b/samples/Tutorial/Index.fs index d8c0080d0..6c88cc2d0 100644 --- a/samples/Tutorial/Index.fs +++ b/samples/Tutorial/Index.fs @@ -1,7 +1,7 @@ module Index let [] Category = "Index" -let streamName indexId = FsCodec.StreamName.create Category (IndexId.toString indexId) +let streamName indexId = struct (Category, IndexId.toString indexId) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -46,10 +46,7 @@ type Service<'t> internal (decider : Equinox.Decider, Fold.Stat decider.Query id let create<'t> resolve indexId = - let log = Serilog.Log.ForContext>() - let streamName = streamName indexId - let decider = Equinox.Decider(log, resolve streamName, maxAttempts = 3) - Service(decider) + Service(streamName indexId |> resolve) module Cosmos = @@ -57,11 +54,11 @@ module Cosmos = let create<'v> (context,cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) let accessStrategy = AccessStrategy.RollingState Fold.snapshot - let cat = CosmosStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) - create cat.Resolve + CosmosStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + |> Equinox.Decider.resolve Serilog.Log.Logger |> create module MemoryStore = let create store = - let cat = Equinox.MemoryStore.MemoryStoreCategory(store, Events.codec, Fold.fold, Fold.initial) - create cat.Resolve + Equinox.MemoryStore.MemoryStoreCategory(store, Events.codec, Fold.fold, Fold.initial) + |> Equinox.Decider.resolve Serilog.Log.Logger |> create diff --git a/samples/Tutorial/Sequence.fs b/samples/Tutorial/Sequence.fs index d61dea75d..2efa7e26a 100644 --- a/samples/Tutorial/Sequence.fs +++ b/samples/Tutorial/Sequence.fs @@ -5,7 +5,7 @@ module Sequence open System let [] Category = "Sequence" -let streamName id = FsCodec.StreamName.create Category (SequenceId.toString id) +let streamName id = struct (Category, SequenceId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -36,19 +36,15 @@ type Service internal (resolve : SequenceId -> Equinox.Decider(), resolveStream streamName, maxAttempts = 3) - Service(resolve) +let create resolve = Service(streamName >> resolve) module Cosmos = open Equinox.CosmosStore - let private create (context,cache,accessStrategy) = + let private create (context, cache, accessStrategy) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) // OR CachingStrategy.NoCaching let category = CosmosStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) - create category.Resolve + category |> Equinox.Decider.resolve (Serilog.Log.ForContext()) |> create module LatestKnownEvent = diff --git a/samples/Tutorial/Set.fs b/samples/Tutorial/Set.fs index 0bd5c5133..2fc1e765e 100644 --- a/samples/Tutorial/Set.fs +++ b/samples/Tutorial/Set.fs @@ -1,7 +1,7 @@ module Set let [] Category = "Set" -let streamName id = FsCodec.StreamName.create Category (SetId.toString id) +let streamName id = struct (Category, SetId.toString id) // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = @@ -46,10 +46,8 @@ type Service internal (decider : Equinox.Decider) = member _.Read() : Async> = decider.Query id -let create resolveStream setId = - let streamName = streamName setId - let decider = Equinox.Decider(Serilog.Log.ForContext(), resolveStream streamName, maxAttempts = 3) - Service(decider) +let create resolve setId = + Service(streamName setId |> resolve) module Cosmos = @@ -57,11 +55,11 @@ module Cosmos = let create (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) let accessStrategy = AccessStrategy.RollingState Fold.snapshot - let category = CosmosStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) - create category.Resolve + CosmosStoreCategory(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + |> Equinox.Decider.resolve Serilog.Log.Logger |> create module MemoryStore = let create store = - let cat = Equinox.MemoryStore.MemoryStoreCategory(store, Events.codec, Fold.fold, Fold.initial) - create cat.Resolve + Equinox.MemoryStore.MemoryStoreCategory(store, Events.codec, Fold.fold, Fold.initial) + |> Equinox.Decider.resolve Serilog.Log.Logger |> create diff --git a/samples/Tutorial/Todo.fsx b/samples/Tutorial/Todo.fsx index 09cd221c9..5c4f656ef 100644 --- a/samples/Tutorial/Todo.fsx +++ b/samples/Tutorial/Todo.fsx @@ -29,7 +29,7 @@ open System This tutorial stresses different aspects *) let Category = "Todos" -let streamName (id : string) = FsCodec.StreamName.create Category id +let streamName (id : string) = struct (Category, id) type Todo = { id: int; order: int; title: string; completed: bool } type DeletedInfo = { id: int } @@ -137,9 +137,9 @@ module TodosCategory = let access = AccessStrategy.Snapshot (isOrigin,snapshot) let category = CosmosStoreCategory(Store.context, codec, fold, initial, Store.cacheStrategy, access=access) - let resolve id = Equinox.Decider(log, category.Resolve(streamName id), maxAttempts = 3) + let resolve = Equinox.Decider.resolve log category -let service = Service(TodosCategory.resolve) +let service = Service(streamName >> TodosCategory.resolve) let client = "ClientJ" let item = { id = 0; order = 0; title = "Feed cat"; completed = false } diff --git a/samples/Tutorial/Tutorial.fsproj b/samples/Tutorial/Tutorial.fsproj index 888859640..f33be5022 100644 --- a/samples/Tutorial/Tutorial.fsproj +++ b/samples/Tutorial/Tutorial.fsproj @@ -27,8 +27,8 @@ - - + + diff --git a/samples/Tutorial/Upload.fs b/samples/Tutorial/Upload.fs index 202b44e06..92daf580f 100644 --- a/samples/Tutorial/Upload.fs +++ b/samples/Tutorial/Upload.fs @@ -15,7 +15,7 @@ module CompanyId = let toString (value : CompanyId) : string = %value let [] Category = "Upload" -let streamName (companyId, purchaseOrderId) = FsCodec.StreamName.compose Category [PurchaseOrderId.toString purchaseOrderId; CompanyId.toString companyId] +let streamName (companyId, purchaseOrderId) = struct (Category, FsCodec.StreamName.createStreamId [PurchaseOrderId.toString purchaseOrderId; CompanyId.toString companyId]) type UploadId = string and [] uploadId @@ -52,22 +52,18 @@ type Service internal (resolve : CompanyId * PurchaseOrderId -> Equinox.Decider< let decider = resolve (companyId, purchaseOrderId) decider.Transact(decide value) -let create resolveStream = - let resolve ids = - let streamName = streamName ids - Equinox.Decider(Serilog.Log.ForContext(), resolveStream streamName, maxAttempts = 3) - Service(resolve) +let create resolve = Service(streamName >> resolve) module Cosmos = open Equinox.CosmosStore let create (context,cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) // OR CachingStrategy.NoCaching - let category = CosmosStoreCategory(context, Events.codecJe, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent) - create category.Resolve + CosmosStoreCategory(context, Events.codecJe, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent) + |> Equinox.Decider.resolve Serilog.Log.Logger |> create module EventStore = open Equinox.EventStoreDb let create context = - let cat = EventStoreCategory(context, Events.codec, Fold.fold, Fold.initial, access=AccessStrategy.LatestKnownEvent) - create cat.Resolve + EventStoreCategory(context, Events.codec, Fold.fold, Fold.initial, access=AccessStrategy.LatestKnownEvent) + |> Equinox.Decider.resolve Serilog.Log.Logger |> create diff --git a/src/Equinox.Core/AsyncBatchingGate.fs b/src/Equinox.Core/AsyncBatchingGate.fs index ce80a75ed..aeee7a054 100644 --- a/src/Equinox.Core/AsyncBatchingGate.fs +++ b/src/Equinox.Core/AsyncBatchingGate.fs @@ -4,29 +4,25 @@ namespace Equinox.Core /// - requests arriving together can be coalesced into the batch during the linger period via TryAdd /// - callers that have had items admitted can concurrently await the shared fate of the dispatch via AwaitResult /// - callers whose TryAdd has been denied can await the completion of the in-flight batch via AwaitCompletion -type internal AsyncBatch<'Req, 'Res>(dispatch : 'Req[] -> Async<'Res>, linger : System.TimeSpan) = - let lingerMs = int linger.TotalMilliseconds +type internal AsyncBatch<'Req, 'Res>(dispatch : 'Req[] -> Async<'Res>, lingerMs : int) = // Yes, naive impl in the absence of a cleaner way to have callers sharing the AwaitCompletion coordinate the adding - do if lingerMs < 1 then invalidArg "linger" "must be >= 1ms" let queue = new System.Collections.Concurrent.BlockingCollection<'Req>() - let workflow = async { - do! Async.Sleep lingerMs - queue.CompleteAdding() - let reqs = queue.ToArray() - return! dispatch reqs - } - let task = lazy (Async.StartAsTask workflow) + let task = lazy if lingerMs = 0 then task { queue.CompleteAdding(); return! dispatch (queue.ToArray()) } + else task { do! System.Threading.Tasks.Task.Delay lingerMs + queue.CompleteAdding() + return! dispatch (queue.ToArray()) } /// Attempt to add a request to the flight /// Succeeds during linger interval (which commences when the first caller triggers the workflow via AwaitResult) - /// Fails if this flight has closed (caller should generate a fresh, potentially after awaiting this.AwaitCompletion) + /// Fails if this flight has closed (caller should initialize a fresh Batch, potentially after awaiting this.AwaitCompletion) member _.TryAdd(item) = - if queue.IsAddingCompleted then false else - - // there's a race between the IsAddingCompleted check outcome and the CompleteAdding - // sadly there's no way to detect without a try/catch - try queue.TryAdd(item) - with :? System.InvalidOperationException -> false + if queue.IsAddingCompleted then + false + else + // there's a race between the IsAddingCompleted check outcome and the CompleteAdding + // sadly there's no way to detect without a try/catch + try queue.TryAdd(item) + with :? System.InvalidOperationException -> false /// Await the outcome of dispatching the batch (on the basis that the caller has a stake due to a successful TryAdd) member _.AwaitResult() = Async.AwaitTaskCorrect task.Value @@ -38,18 +34,16 @@ type internal AsyncBatch<'Req, 'Res>(dispatch : 'Req[] -> Async<'Res>, linger : |> ignore) /// Manages concurrent work such that requests arriving while a batch is in flight converge to wait for the next window -type AsyncBatchingGate<'Req, 'Res>(dispatch : 'Req[] -> Async<'Res>, ?linger) = - let mkBatch () = AsyncBatch(dispatch, defaultArg linger (System.TimeSpan.FromMilliseconds 5.)) - let mutable cell = mkBatch() +type AsyncBatchingGate<'Req, 'Res>(dispatch : 'Req[] -> Async<'Res>, ?linger : System.TimeSpan) = + let linger = match linger with None -> 1 | Some x -> int x.TotalMilliseconds + let mutable cell = AsyncBatch(dispatch, linger) - member x.Execute req = async { + member x.Execute req = let current = cell // If current has not yet been dispatched, hop on and join - if current.TryAdd req then - return! current.AwaitResult() - else // Any thread that discovers a batch in flight, needs to wait for it to conclude first - do! current.AwaitCompletion() + if current.TryAdd req then current.AwaitResult() + else async { // Any thread that discovers a batch in flight, needs to wait for it to conclude first + do! current.AwaitCompletion() // NOTE we don't observe any exception from the preceding batch // where competing threads discover a closed flight, we only want a single one to regenerate it - let _ = System.Threading.Interlocked.CompareExchange(&cell, mkBatch (), current) - return! x.Execute req - } + let _ = System.Threading.Interlocked.CompareExchange(&cell, AsyncBatch(dispatch, linger), current) + return! x.Execute req } diff --git a/src/Equinox.Core/AsyncCacheCell.fs b/src/Equinox.Core/AsyncCacheCell.fs index 5ce856daf..d67d207b0 100755 --- a/src/Equinox.Core/AsyncCacheCell.fs +++ b/src/Equinox.Core/AsyncCacheCell.fs @@ -1,51 +1,61 @@ namespace Equinox.Core +open System.Threading +open System.Threading.Tasks + /// Asynchronous Lazy<'T> used to gate a workflow to ensure at most once execution of a computation. -type AsyncLazy<'T>(workflow : Async<'T>) = - let task = lazy (Async.StartAsTask workflow) +type AsyncLazy<'T>(workflow : unit -> Task<'T>) = - /// Await the outcome of the computation. - /// NOTE due to `Lazy` semantics, failed attempts will cache any exception; AsyncCacheCell compensates for this - member _.AwaitValue() = Async.AwaitTaskCorrect task.Value + /// NOTE due to `Lazy` semantics, failed attempts will cache any exception; AsyncCacheCell compensates for this by rolling over to a new instance + let workflow = lazy workflow () /// Synchronously check whether the value has been computed (and/or remains valid) - member this.IsValid(?isExpired) = - if not task.IsValueCreated then false else + member _.IsValid(isExpired) = + if not workflow.IsValueCreated then false else - let value = task.Value - if not value.IsCompleted || value.IsFaulted then false else + let t = workflow.Value + if t.Status <> TaskStatus.RanToCompletion then false else match isExpired with - | Some f -> not (f value.Result) + | ValueSome isExpired -> not (isExpired t.Result) | _ -> true /// Used to rule out values where the computation yielded an exception or the result has now expired - member this.TryAwaitValid(?isExpired) : Async<'T option> = async { + member _.TryAwaitValid(isExpired) : Task<'T voption> = + let t = workflow.Value + // Determines if the last attempt completed, but failed; For TMI see https://stackoverflow.com/a/33946166/11635 - if task.Value.IsFaulted then return None else + if t.IsFaulted then Task.FromResult ValueNone + else task { + let! (res : 'T) = t + match isExpired with + | ValueSome isExpired when isExpired res -> return ValueNone + | _ -> return ValueSome res } - let! result = this.AwaitValue() - match isExpired with - | Some f when f result -> return None - | _ -> return Some result - } + /// Await the outcome of the computation. + member _.Await() = workflow.Value /// Generic async lazy caching implementation that admits expiration/recomputation/retry on exception semantics. /// If `workflow` fails, all readers entering while the load/refresh is in progress will share the failure /// The first caller through the gate triggers a recomputation attempt if the previous attempt ended in failure -type AsyncCacheCell<'T>(workflow : Async<'T>, ?isExpired : 'T -> bool) = - let mutable cell = AsyncLazy workflow +type AsyncCacheCell<'T>(workflow : CancellationToken -> Task<'T>, ?isExpired : 'T -> bool) = + + let isExpired = match isExpired with Some x -> ValueSome x | None -> ValueNone + // we can't pre-initialize as we need the invocation to be tied to a CancellationToken + let mutable cell = AsyncLazy(fun () -> Task.FromException<'T>(System.InvalidOperationException "AsyncCacheCell Not Yet initialized")) + + /// Synchronously check the value remains valid (to short-circuit an Await step where value not required) + member _.IsValid() = cell.IsValid(isExpired) - /// Synchronously check the value remains valid (to short-circuit an Async AwaitValue step where value not required) - member _.IsValid() = cell.IsValid(?isExpired=isExpired) /// Gets or asynchronously recomputes a cached value depending on expiry and availability - member _.AwaitValue() = async { + member _.Await(ct) = task { + // Each concurrent execution takes a copy of the cell, and attempts to reuse the value; later used to ensure only one triggers the workflow let current = cell - match! current.TryAwaitValid(?isExpired=isExpired) with - | Some res -> return res - | None -> - // avoid unnecessary recomputation in cases where competing threads detect expiry; - // the first write attempt wins, and everybody else reads off that value - let _ = System.Threading.Interlocked.CompareExchange(&cell, AsyncLazy workflow, current) - return! cell.AwaitValue() - } + match! current.TryAwaitValid(isExpired) with + | ValueSome res -> return res // ... if it's already / still valid, we're done + | ValueNone -> + // Prepare a new instance, with cancellation under our control (it won't start until the first Await on the LazyTask triggers it though) + let newInstance = AsyncLazy(fun () -> workflow ct) + // If there are concurrent executions, the first through the gate wins; everybody else awaits the instance the winner wrote + let _ = Interlocked.CompareExchange(&cell, newInstance, current) + return! cell.Await() } diff --git a/src/Equinox.Core/Cache.fs b/src/Equinox.Core/Cache.fs index f98b6376b..cae762d80 100755 --- a/src/Equinox.Core/Cache.fs +++ b/src/Equinox.Core/Cache.fs @@ -1,8 +1,9 @@ namespace Equinox.Core open System +open System.Threading.Tasks -type CacheItemOptions = +type [] CacheItemOptions = | AbsoluteExpiration of DateTimeOffset | RelativeExpiration of TimeSpan @@ -11,22 +12,23 @@ type CacheEntry<'state>(initialToken: StreamToken, initialState: 'state, superse let mutable currentToken, currentState = initialToken, initialState member x.UpdateIfNewer(other : CacheEntry<'state>) = lock x <| fun () -> - let otherToken, otherState = other.Value + let struct (otherToken, otherState) = other.Value if otherToken |> supersedes currentToken then currentToken <- otherToken currentState <- otherState - member x.Value : StreamToken * 'state = + member x.Value : struct (StreamToken * 'state) = lock x <| fun () -> currentToken, currentState type ICache = - abstract member UpdateIfNewer : key: string * options: CacheItemOptions * entry: CacheEntry<'state> -> Async - abstract member TryGet : key: string -> Async<(StreamToken * 'state) option> + abstract member UpdateIfNewer : key: string * options: CacheItemOptions * entry: CacheEntry<'state> -> Task + abstract member TryGet : key: string -> Task namespace Equinox open System.Runtime.Caching +open System.Threading.Tasks open Equinox.Core type Cache(name, sizeMb : int) = @@ -41,16 +43,15 @@ type Cache(name, sizeMb : int) = | RelativeExpiration relative -> CacheItemPolicy(SlidingExpiration = relative) interface ICache with - member _.UpdateIfNewer(key, options, entry) = async { + member _.UpdateIfNewer(key, options, entry) = let policy = toPolicy options match cache.AddOrGetExisting(key, box entry, policy) with - | null -> () - | :? CacheEntry<'state> as existingEntry -> existingEntry.UpdateIfNewer entry - | x -> failwithf "UpdateIfNewer Incompatible cache entry %A" x } - - member _.TryGet key = async { - return - match cache.Get key with - | null -> None - | :? CacheEntry<'state> as existingEntry -> Some existingEntry.Value - | x -> failwithf "TryGet Incompatible cache entry %A" x } + | null -> Task.FromResult() + | :? CacheEntry<'state> as existingEntry -> existingEntry.UpdateIfNewer entry; Task.FromResult() + | x -> failwithf "UpdateIfNewer Incompatible cache entry %A" x + + member _.TryGet key = + match cache.Get key with + | null -> ValueNone |> Task.FromResult + | :? CacheEntry<'state> as existingEntry -> ValueSome existingEntry.Value |> Task.FromResult + | x -> failwithf "TryGet Incompatible cache entry %A" x diff --git a/src/Equinox.Core/Category.fs b/src/Equinox.Core/Category.fs new file mode 100755 index 000000000..b9aa6be74 --- /dev/null +++ b/src/Equinox.Core/Category.fs @@ -0,0 +1,50 @@ +// Low level stream impl, used by Store-specific Category types that layer policies such as Caching in +namespace Equinox + +open System.Threading +open System.Threading.Tasks + +/// Store-agnostic interface representing interactions a Flow can have with the state of a given event stream. Not intended for direct use by consumer code. +[] +type Category<'event, 'state, 'context>( + resolveInner : struct (string * string) -> struct (Core.ICategory<'event, 'state, 'context> * string * (CancellationToken -> Task) voption), + empty : struct (Core.StreamToken * 'state)) = + + member _.Stream(log : Serilog.ILogger, context : 'context, categoryName, streamId) = + let struct (inner, streamName, init) = resolveInner (categoryName, streamId) + { new Core.IStream<'event, 'state> with + member _.LoadEmpty() = + empty + member x.Load(allowStale, ct) = + inner.Load(log, categoryName, streamId, streamName, allowStale, ct) + member _.TrySync(attempt, (token, originState), events, ct) = + let log = if attempt = 1 then log else log.ForContext("attempts", attempt) + inner.TrySync(log, categoryName, streamId, streamName, context, init, token, originState, events, ct) } + +module Stream = + + let resolveWithContext (ctx : 'context) log (cat : Category<'event, 'state, 'context>) : struct (string * string) -> Core.IStream<'event, 'state> = + fun struct (categoryName, streamId) -> + cat.Stream(log, ctx, categoryName, streamId) + + let resolve log (cat : Category<'event, 'state, unit>) = + resolveWithContext () log cat + +module Decider = + + let resolveWithContext context log (cat : Category<'event, 'state, 'context>) : struct (string * string) -> Decider<'event, 'state> = + Stream.resolveWithContext context log cat >> Decider + + let resolve log (cat : Category<'event, 'state, unit>) = + resolveWithContext () log cat + +[] +type DeciderExtensions = + + [] + static member Resolve(cat : Category<'event, 'state, 'context>, context : 'context, log) : struct (string * string) -> Decider<'event, 'state> = + Decider.resolveWithContext context log cat + + [] + static member Resolve(cat : Category<'event, 'state, unit>, log) : struct (string * string) -> Decider<'event, 'state> = + Decider.resolveWithContext () log cat diff --git a/src/Equinox.Core/Equinox.Core.fsproj b/src/Equinox.Core/Equinox.Core.fsproj index 97dac9760..2a7f3c9c0 100644 --- a/src/Equinox.Core/Equinox.Core.fsproj +++ b/src/Equinox.Core/Equinox.Core.fsproj @@ -7,7 +7,7 @@ - + @@ -19,9 +19,14 @@ - + - + + + contentFiles + + + diff --git a/src/Equinox.Core/Infrastructure.fs b/src/Equinox.Core/Infrastructure.fs index 9c715fbca..59477382c 100755 --- a/src/Equinox.Core/Infrastructure.fs +++ b/src/Equinox.Core/Infrastructure.fs @@ -50,3 +50,24 @@ type Async with else sc ()) |> ignore) + +module Async = + + let startAsTask ct computation = Async.StartAsTask(computation, cancellationToken = ct) + +module ValueTuple = + + let inline fst struct (f, _s) = f + let inline snd struct (_f, s) = s + +module ValueOption = + + let inline toOption x = match x with ValueSome x -> Some x | ValueNone -> None + +module Seq = + + let inline chooseV f = Seq.choose (f >> ValueOption.toOption) + +module Array = + + let inline chooseV f = Array.choose (f >> ValueOption.toOption) diff --git a/src/Equinox.Core/StoreCategory.fs b/src/Equinox.Core/StoreCategory.fs deleted file mode 100755 index ca1883623..000000000 --- a/src/Equinox.Core/StoreCategory.fs +++ /dev/null @@ -1,23 +0,0 @@ -/// Low level stream builders, generally consumed via Store-specific Stream Builders that layer policies such as Caching in at the Category level -namespace Equinox.Core - -/// Represents a specific stream in a ICategory -[] -type private Stream<'event, 'state, 'context>(category : ICategory<'event, 'state, string, 'context>, streamId: string, empty : StreamToken * 'state, ?context : 'context, ?init : unit -> Async) = - - interface IStream<'event, 'state> with - member _.LoadEmpty() = empty - member _.Load(log, allowStale) = category.Load(log, streamId, allowStale) - member _.TrySync(log, token: StreamToken, originState: 'state, events: 'event list) = - let sync = category.TrySync(log, streamId, token, originState, events, context) - match init with - | None -> sync - | Some f -> async { do! f () - return! sync } - -/// Store-agnostic interface representing interactions a Flow can have with the state of a given event stream. Not intended for direct use by consumer code. -type StoreCategory<'event, 'state, 'streamId, 'context>(resolve, empty) = - - member _.Resolve(streamName : 'streamId, [] ?context) = - let category, streamName, maybeContainerInitializationGate = resolve streamName - Stream<'event, 'state, 'context>(category, streamName, empty, ?context = context, ?init = maybeContainerInitializationGate) :> IStream<'event, 'state> diff --git a/src/Equinox.Core/Types.fs b/src/Equinox.Core/Types.fs index 33e8c6e11..26e6c36d1 100755 --- a/src/Equinox.Core/Types.fs +++ b/src/Equinox.Core/Types.fs @@ -3,18 +3,21 @@ namespace Equinox.Core open Serilog open System open System.Diagnostics +open System.Threading +open System.Threading.Tasks /// Store-agnostic interface representing interactions an Application can have with a set of streams with a common event type -type ICategory<'event, 'state, 'streamId, 'context> = +type ICategory<'event, 'state, 'context> = /// Obtain the state from the target stream - abstract Load : log: ILogger * 'streamId * allowStale : bool -> Async + abstract Load : log: ILogger * categoryName: string * streamId: string * streamName: string * allowStale: bool * ct: CancellationToken -> Task /// Given the supplied `token`, attempt to sync to the proposed updated `state'` by appending the supplied `events` to the underlying stream, yielding: /// - Written: signifies synchronization has succeeded, implying the included StreamState should now be assumed to be the state of the stream /// - Conflict: signifies the sync failed, and the proposed decision hence needs to be reconsidered in light of the supplied conflicting Stream State /// NB the central precondition upon which the sync is predicated is that the stream has not diverged from the `originState` represented by `token` /// where the precondition is not met, the SyncResult.Conflict bears a [lazy] async result (in a specific manner optimal for the store) - abstract TrySync : log: ILogger * streamName : 'streamId * StreamToken * 'state * events: 'event list * 'context option -> Async> + abstract TrySync : log: ILogger * categoryName: string * streamId: string * streamName: string * 'context * maybeInit: (CancellationToken -> Task) voption + * StreamToken * 'state * events: 'event list * CancellationToken -> Task> /// Represents a time measurement of a computation that includes stopwatch tick metadata [] diff --git a/src/Equinox.CosmosStore.Prometheus/CosmosStorePrometheus.fs b/src/Equinox.CosmosStore.Prometheus/CosmosStorePrometheus.fs index 00a5802ea..3e091efec 100644 --- a/src/Equinox.CosmosStore.Prometheus/CosmosStorePrometheus.fs +++ b/src/Equinox.CosmosStore.Prometheus/CosmosStorePrometheus.fs @@ -92,8 +92,8 @@ type LogSink(customTags: seq) = payloadCounters (facet, op, outcome) (db, con, cat, float count, if bytes = -1 then None else Some (float bytes)) let (|CatSRu|) ({ interval = i; ru = ru } : Measurement as m) = - let cat, _id = FsCodec.StreamName.splitCategoryAndId (FSharp.UMX.UMX.tag m.stream) - m.database, m.container, cat, i.Elapsed, ru + let struct (cat, _id) = FsCodec.StreamName.splitCategoryAndStreamId (FSharp.UMX.UMX.tag m.stream) + struct (m.database, m.container, cat, i.Elapsed, ru) let observeRes (_rut, facet, _op as stat) (CatSRu (db, con, cat, s, ru)) = roundtripHistogram stat (db, con, cat, s, ru) roundtripSummary facet (db, con, s, ru) diff --git a/src/Equinox.CosmosStore.Prometheus/Equinox.CosmosStore.Prometheus.fsproj b/src/Equinox.CosmosStore.Prometheus/Equinox.CosmosStore.Prometheus.fsproj index b5fb8ed3a..be4ebf595 100644 --- a/src/Equinox.CosmosStore.Prometheus/Equinox.CosmosStore.Prometheus.fsproj +++ b/src/Equinox.CosmosStore.Prometheus/Equinox.CosmosStore.Prometheus.fsproj @@ -13,9 +13,9 @@ - + - + diff --git a/src/Equinox.CosmosStore/CosmosStore.fs b/src/Equinox.CosmosStore/CosmosStore.fs index 886a7b23b..68a0eeb2b 100644 --- a/src/Equinox.CosmosStore/CosmosStore.fs +++ b/src/Equinox.CosmosStore/CosmosStore.fs @@ -7,6 +7,8 @@ open Microsoft.Azure.Cosmos open Serilog open System open System.Text.Json +open System.Threading +open System.Threading.Tasks type EventBody = JsonElement @@ -270,9 +272,9 @@ module Log = { mutable rux100 : int64; mutable count : int64; mutable ms : int64 } static member Create() = { rux100 = 0L; count = 0L; ms = 0L } member x.Ingest(ru, ms) = - System.Threading.Interlocked.Increment(&x.count) |> ignore - System.Threading.Interlocked.Add(&x.rux100, int64 (ru*100.)) |> ignore - System.Threading.Interlocked.Add(&x.ms, ms) |> ignore + Interlocked.Increment(&x.count) |> ignore + Interlocked.Add(&x.rux100, int64 (ru*100.)) |> ignore + Interlocked.Add(&x.ms, ms) |> ignore let inline private (|RcMs|) ({ interval = i; ru = ru } : Measurement) = ru, let e = i.Elapsed in int64 e.TotalMilliseconds type LogSink() = @@ -586,12 +588,12 @@ module Initialization = return! createOrProvisionContainer d (cName, "/id", applyAuxContainerProperties) mode } // as per Cosmos team, Partition Key must be "/id" /// Holds Container state, coordinating initialization activities - type internal ContainerInitializerGuard(container : Container, fallback : Container option, ?initContainer : Container -> Async) = + type internal ContainerInitializerGuard(container : Container, fallback : Container option, ?initContainer : Container -> CancellationToken -> Task) = let initGuard = initContainer |> Option.map (fun init -> AsyncCacheCell(init container)) member _.Container = container member _.Fallback = fallback - member internal _.InitializationGate = match initGuard with Some g when not (g.IsValid()) -> Some g.AwaitValue | _ -> None + member internal _.InitializationGate = match initGuard with Some g when not (g.IsValid()) -> ValueSome g.Await | _ -> ValueNone module internal Tip = @@ -709,12 +711,12 @@ module internal Query = [] type ScanResult<'event> = { found : bool; minIndex : int64; next : int64; maybeTipPos : Position option; events : 'event[] } - let scanTip (tryDecode : #IEventData -> 'event option, isOrigin : 'event -> bool) (pos : Position, i : int64, xs : #ITimelineEvent[]) : ScanResult<'event> = + let scanTip (tryDecode : #IEventData -> 'event voption, isOrigin : 'event -> bool) (pos : Position, i : int64, xs : #ITimelineEvent[]) : ScanResult<'event> = let items = ResizeArray() let isOrigin' e = match tryDecode e with - | None -> false - | Some e -> + | ValueNone -> false + | ValueSome e -> items.Insert(0, e) // WalkResult always renders events ordered correctly - here we're aiming to align with Enum.EventsAndUnfolds isOrigin e let f, e = xs |> Seq.tryFindBack isOrigin' |> Option.isSome, items.ToArray() @@ -722,7 +724,7 @@ module internal Query = // Yields events in ascending Index order let scan<'event> (log : ILogger) (container, stream) includeTip (maxItems : int) maxRequests direction - (tryDecode : ITimelineEvent -> 'event option, isOrigin : 'event -> bool) + (tryDecode : ITimelineEvent -> 'event voption, isOrigin : 'event -> bool) (minIndex, maxIndex) : Async option> = async { let mutable found = false @@ -735,10 +737,10 @@ module internal Query = if maybeTipPos = None then maybeTipPos <- maybePos lastResponse <- Some events; ru <- ru + r responseCount <- responseCount + 1 - seq { for x in events -> x, tryDecode x }) + seq { for x in events -> struct (x, tryDecode x) }) |> AsyncSeq.concatSeq |> AsyncSeq.takeWhileInclusive (function - | x, Some e when isOrigin e -> + | struct (x, ValueSome e) when isOrigin e -> found <- true match lastResponse with | None -> log.Information("EqxCosmos Stop stream={stream} at={index} {case}", stream, x.Index, x.EventType) @@ -756,8 +758,8 @@ module internal Query = mkQuery readLog (container, stream) includeTip maxItems (direction, minIndex, maxIndex) |> feedIteratorMapTi (mapPage direction (container, stream) (minIndex, maxIndex) maxRequests readLog) let! t, (events, maybeTipPos, ru) = mergeBatches log batches |> Stopwatch.Time - let raws = Array.map fst events - let decoded = if direction = Direction.Forward then Array.choose snd events else Seq.choose snd events |> Seq.rev |> Array.ofSeq + let raws = Array.map ValueTuple.fst events + let decoded = if direction = Direction.Forward then Array.chooseV ValueTuple.snd events else Seq.chooseV ValueTuple.snd events |> Seq.rev |> Array.ofSeq let minMax = (None, raws) ||> Array.fold (fun acc x -> let i = x.Index in Some (match acc with None -> i, i | Some (n, x) -> min n i, max x i)) let version = match maybeTipPos, minMax with @@ -1083,12 +1085,12 @@ type StoreClient(container : Container, archive : Container option, query : Quer Prune.until log (container, stream) query.MaxItems index type internal Category<'event, 'state, 'context>(store : StoreClient, codec : IEventCodec<'event, EventBody, 'context>) = - member _.Load(log, stream, initial, checkUnfolds, fold, isOrigin) : Async = async { - let! token, events = store.Load(log, (stream, None), (codec.TryDecode, isOrigin), checkUnfolds) - return token, fold initial events } - member _.Reload(log, streamName, (Token.Unpack pos as streamToken), state, fold, isOrigin, ?preloaded) : Async = async { - match! store.Reload(log, (streamName, pos), (codec.TryDecode, isOrigin), ?preview = preloaded) with - | LoadFromTokenResult.Unchanged -> return streamToken, state + member _.Load(log, stream, initial, checkUnfolds, fold, isOrigin, ct) : Task = task { + let! token, events = store.Load(log, (stream, None), (codec.TryDecode, isOrigin), checkUnfolds) |> Async.startAsTask ct + return struct (token, fold initial events) } + member _.Reload(log, streamName, (Token.Unpack pos as streamToken), state, fold, isOrigin, ct, ?preloaded) : Task = task { + match! store.Reload(log, (streamName, pos), (codec.TryDecode, isOrigin), ?preview = preloaded) |> Async.startAsTask ct with + | LoadFromTokenResult.Unchanged -> return struct (streamToken, state) | LoadFromTokenResult.Found (token', events) -> return token', fold state events } member cat.Sync(log, streamName, (Token.Unpack pos as streamToken), state, events, mapUnfolds, fold, isOrigin, context, compressUnfolds) : Async> = async { let state' = fold state (Seq.ofList events) @@ -1105,20 +1107,20 @@ type internal Category<'event, 'state, 'context>(store : StoreClient, codec : IE let projections = projectionsEncoded |> Seq.map (Sync.mkUnfold renderElement baseIndex) let batch = Sync.mkBatch streamName eventsEncoded projections match! store.Sync(log, streamName, exp, batch) with - | InternalSyncResult.Conflict (pos', tipEvents) -> return SyncResult.Conflict (cat.Reload(log, streamName, streamToken, state, fold, isOrigin, (pos', pos.index, tipEvents))) - | InternalSyncResult.ConflictUnknown _token' -> return SyncResult.Conflict (cat.Reload(log, streamName, streamToken, state, fold, isOrigin)) + | InternalSyncResult.Conflict (pos', tipEvents) -> return SyncResult.Conflict (fun ct -> cat.Reload(log, streamName, streamToken, state, fold, isOrigin, ct, (pos', pos.index, tipEvents))) + | InternalSyncResult.ConflictUnknown _token' -> return SyncResult.Conflict (fun ct -> cat.Reload(log, streamName, streamToken, state, fold, isOrigin, ct)) | InternalSyncResult.Written token' -> return SyncResult.Written (token', state') } module internal Caching = let applyCacheUpdatesWithSlidingExpiration (cache : ICache, prefix : string) (slidingExpiration : TimeSpan) = - let mkCacheEntry (initialToken : StreamToken, initialState : 'state) = CacheEntry<'state>(initialToken, initialState, Token.supersedes) + let mkCacheEntry struct (initialToken : StreamToken, initialState : 'state) = CacheEntry<'state>(initialToken, initialState, Token.supersedes) let options = CacheItemOptions.RelativeExpiration slidingExpiration fun streamName value -> cache.UpdateIfNewer(prefix + streamName, options, mkCacheEntry value) let applyCacheUpdatesWithFixedTimeSpan (cache : ICache, prefix : string) (period : TimeSpan) = - let mkCacheEntry (initialToken : StreamToken, initialState : 'state) = CacheEntry<'state>(initialToken, initialState, Token.supersedes) + let mkCacheEntry struct (initialToken : StreamToken, initialState : 'state) = CacheEntry<'state>(initialToken, initialState, Token.supersedes) fun streamName value -> let expirationPoint = let creationDate = DateTimeOffset.UtcNow in creationDate.Add period let options = CacheItemOptions.AbsoluteExpiration expirationPoint @@ -1127,25 +1129,26 @@ module internal Caching = type CachingCategory<'event, 'state, 'context> ( category : Category<'event, 'state, 'context>, fold : 'state -> 'event seq -> 'state, initial : 'state, isOrigin : 'event -> bool, - tryReadCache, updateCache, + tryReadCache, updateCache : _ -> struct (_*_) -> Task, checkUnfolds, compressUnfolds, mapUnfolds : Choice 'state -> 'event seq, 'event list -> 'state -> 'event list * 'event list>) = - let cache streamName inner = async { - let! tokenAndState = inner - do! updateCache streamName tokenAndState - return tokenAndState } - interface ICategory<'event, 'state, string, 'context> with - member _.Load(log, streamName, allowStale) : Async = async { - match! tryReadCache streamName with - | None -> return! category.Load(log, streamName, initial, checkUnfolds, fold, isOrigin) |> cache streamName - | Some tokenAndState when allowStale -> return tokenAndState // read already updated TTL, no need to write - | Some (token, state) -> return! category.Reload(log, streamName, token, state, fold, isOrigin) |> cache streamName } - member _.TrySync(log : ILogger, streamName, streamToken, state, events : 'event list, context) : Async> = async { - match! category.Sync(log, streamName, streamToken, state, events, mapUnfolds, fold, isOrigin, context, compressUnfolds) with + let cache streamName (inner : unit -> Task<_>) = task { + let! struct (token, state) = inner () + do! updateCache streamName (token, state) + return struct (token, state) } + interface ICategory<'event, 'state, 'context> with + member _.Load(log, _categoryName, _streamId, streamName, allowStale, ct) : Task = task { + match! tryReadCache streamName : Task with + | ValueNone -> return! (fun () -> category.Load(log, streamName, initial, checkUnfolds, fold, isOrigin, ct)) |> cache streamName + | ValueSome struct (token, state) when allowStale -> return struct (token, state) // read already updated TTL, no need to write + | ValueSome (token, state) -> return! (fun () -> category.Reload(log, streamName, token, state, fold, isOrigin, ct)) |> cache streamName } + member _.TrySync(log : ILogger, _categoryName, _streamId, streamName, context, maybeInit, streamToken, state, events, ct) : Task> = task { + match maybeInit with ValueNone -> () | ValueSome i -> do! i ct + match! category.Sync(log, streamName, streamToken, state, events, mapUnfolds, fold, isOrigin, context, compressUnfolds) |> Async.startAsTask ct with | SyncResult.Conflict resync -> - return SyncResult.Conflict (cache streamName resync) + return SyncResult.Conflict (fun ct -> cache streamName (fun () -> resync ct)) | SyncResult.Written (token', state') -> - do! updateCache streamName (token', state') + do! updateCache streamName struct (token', state') return SyncResult.Written (token', state') } module ConnectionString = @@ -1159,9 +1162,9 @@ namespace Equinox.CosmosStore open Equinox.Core open Equinox.CosmosStore.Core -open FsCodec open Microsoft.Azure.Cosmos open System +open System.Threading.Tasks [] type Discovery = @@ -1297,7 +1300,9 @@ type CosmosStoreClient [] ?archiveDatabaseId, // Container Name to use for locating missing events. Default: use containerId [] ?archiveContainerId) = - let genStreamName (categoryName, streamId) = if categoryName = null then streamId else sprintf "%s-%s" categoryName streamId + let genStreamName (categoryName, streamId) = + if categoryName = null then streamId + else FsCodec.StreamName.Internal.ofCategoryAndStreamId (categoryName, streamId) let catAndStreamToDatabaseContainerStream (categoryName, streamId) = databaseId, containerId, genStreamName (categoryName, streamId) let primaryContainer (d, c) = (client : CosmosClient).GetDatabase(d).GetContainer(c) let fallbackContainer = @@ -1305,17 +1310,17 @@ type CosmosStoreClient else fun (d, c) -> Some ((defaultArg archiveClient client).GetDatabase(defaultArg archiveDatabaseId d).GetContainer(defaultArg archiveContainerId c)) CosmosStoreClient(catAndStreamToDatabaseContainerStream, primaryContainer, fallbackContainer, ?disableInitialization = disableInitialization, ?createGateway = createGateway) - member internal _.ResolveContainerGuardAndStreamName(categoryName, streamId) : Initialization.ContainerInitializerGuard * string = + member internal _.ResolveContainerGuardAndStreamName(categoryName, streamId) : struct (Initialization.ContainerInitializerGuard * string) = let createContainerInitializerGuard (d, c) = let init = if Some true = disableInitialization then None - else Some (fun cosmosContainer -> Initialization.createSyncStoredProcIfNotExists None cosmosContainer |> Async.Ignore) + else Some (fun cosmosContainer ct -> Initialization.createSyncStoredProcIfNotExists None cosmosContainer |> Async.Ignore |> Async.startAsTask ct) let archiveD, archiveC = primaryDatabaseAndContainerToArchive (d, c) let primaryContainer, fallbackContainer = createContainer (d, c), createFallbackContainer (archiveD, archiveC) Initialization.ContainerInitializerGuard(createGateway primaryContainer, Option.map createGateway fallbackContainer, ?initContainer = init) let databaseId, containerId, streamName = categoryAndStreamNameToDatabaseContainerStream (categoryName, streamId) let g = containerInitGuards.GetOrAdd((databaseId, containerId), createContainerInitializerGuard) - g, streamName + struct (g, streamName) /// Connect to an Equinox.CosmosStore in the specified Container /// NOTE: The returned CosmosStoreClient instance should be held as a long-lived singleton within the application. @@ -1356,9 +1361,9 @@ type CosmosStoreContext(storeClient : CosmosStoreClient, tipOptions, queryOption member val QueryOptions = queryOptions member val TipOptions = tipOptions member internal x.ResolveContainerClientAndStreamIdAndInit(categoryName, streamId) = - let cg, streamId = storeClient.ResolveContainerGuardAndStreamName(categoryName, streamId) + let struct (cg, streamName) = storeClient.ResolveContainerGuardAndStreamName(categoryName, streamId) let store = StoreClient(cg.Container, cg.Fallback, x.QueryOptions, x.TipOptions) - store, streamId, cg.InitializationGate + struct (store, streamName, cg.InitializationGate) /// For CosmosDB, caching is critical in order to reduce RU consumption. /// As such, it can often be omitted, particularly if streams are short or there are snapshots being maintained @@ -1416,37 +1421,37 @@ type AccessStrategy<'event, 'state> = /// | Custom of isOrigin : ('event -> bool) * transmute : ('event list -> 'state -> 'event list*'event list) -type CosmosStoreCategory<'event, 'state, 'context> - ( context : CosmosStoreContext, codec, fold, initial, caching, access, - // Compress Unfolds in Tip. Default: true. - // NOTE when set to false, requires Equinox.CosmosStore or Equinox.Cosmos Version >= 2.3.0 to be able to read - [] ?compressUnfolds) = - let compressUnfolds = defaultArg compressUnfolds true - let categories = System.Collections.Concurrent.ConcurrentDictionary>() - let resolveCategory (categoryName, container) = - let createCategory _name : ICategory<_, _, string, 'context> = - let tryReadCache, updateCache = - match caching with - | CachingStrategy.NoCaching -> (fun _ -> async { return None }), fun _ _ -> async { () } - | CachingStrategy.SlidingWindow (cache, window) -> cache.TryGet, Caching.applyCacheUpdatesWithSlidingExpiration (cache, null) window - | CachingStrategy.FixedTimeSpan (cache, period) -> cache.TryGet, Caching.applyCacheUpdatesWithFixedTimeSpan (cache, null) period - let isOrigin, checkUnfolds, mapUnfolds = - match access with - | AccessStrategy.Unoptimized -> (fun _ -> false), false, Choice1Of3 () - | AccessStrategy.LatestKnownEvent -> (fun _ -> true), true, Choice2Of3 (fun events _ -> Seq.last events |> Seq.singleton) - | AccessStrategy.Snapshot (isOrigin, toSnapshot) -> isOrigin, true, Choice2Of3 (fun _ state -> toSnapshot state |> Seq.singleton) - | AccessStrategy.MultiSnapshot (isOrigin, unfold) -> isOrigin, true, Choice2Of3 (fun _ state -> unfold state) - | AccessStrategy.RollingState toSnapshot -> (fun _ -> true), true, Choice3Of3 (fun _ state -> [], [toSnapshot state]) - | AccessStrategy.Custom (isOrigin, transmute) -> isOrigin, true, Choice3Of3 transmute - let cosmosCat = Category<'event, 'state, 'context>(container, codec) - Caching.CachingCategory<'event, 'state, 'context>(cosmosCat, fold, initial, isOrigin, tryReadCache, updateCache, checkUnfolds, compressUnfolds, mapUnfolds) :> _ - categories.GetOrAdd(categoryName, createCategory) - let resolve (StreamName.CategoryAndId (categoryName, streamId)) = - let container, streamName, maybeContainerInitializationGate = context.ResolveContainerClientAndStreamIdAndInit(categoryName, streamId) - resolveCategory (categoryName, container), streamName, maybeContainerInitializationGate - let empty = Token.create Position.fromKnownEmpty, initial - let storeCategory = StoreCategory(resolve, empty) - member _.Resolve(streamName, ?context) = storeCategory.Resolve(streamName, ?context = context) +type CosmosStoreCategory<'event, 'state, 'context>(resolveInner, empty) = + inherit Equinox.Category<'event, 'state, 'context>(resolveInner, empty) + new ( context : CosmosStoreContext, codec, fold, initial, caching, access, + // Compress Unfolds in Tip. Default: true. + // NOTE when set to false, requires Equinox.CosmosStore or Equinox.Cosmos Version >= 2.3.0 to be able to read + [] ?compressUnfolds) = + let compressUnfolds = defaultArg compressUnfolds true + let categories = System.Collections.Concurrent.ConcurrentDictionary>() + let resolveCategory (categoryName, container) = + let createCategory _name : ICategory<_, _, 'context> = + let tryReadCache, updateCache = + match caching with + | CachingStrategy.NoCaching -> (fun _ -> Task.FromResult ValueNone), fun _ _ -> Task.FromResult () + | CachingStrategy.SlidingWindow (cache, window) -> cache.TryGet, Caching.applyCacheUpdatesWithSlidingExpiration (cache, null) window + | CachingStrategy.FixedTimeSpan (cache, period) -> cache.TryGet, Caching.applyCacheUpdatesWithFixedTimeSpan (cache, null) period + let isOrigin, checkUnfolds, mapUnfolds = + match access with + | AccessStrategy.Unoptimized -> (fun _ -> false), false, Choice1Of3 () + | AccessStrategy.LatestKnownEvent -> (fun _ -> true), true, Choice2Of3 (fun events _ -> Seq.last events |> Seq.singleton) + | AccessStrategy.Snapshot (isOrigin, toSnapshot) -> isOrigin, true, Choice2Of3 (fun _ state -> toSnapshot state |> Seq.singleton) + | AccessStrategy.MultiSnapshot (isOrigin, unfold) -> isOrigin, true, Choice2Of3 (fun _ state -> unfold state) + | AccessStrategy.RollingState toSnapshot -> (fun _ -> true), true, Choice3Of3 (fun _ state -> [], [toSnapshot state]) + | AccessStrategy.Custom (isOrigin, transmute) -> isOrigin, true, Choice3Of3 transmute + let cosmosCat = Category<'event, 'state, 'context>(container, codec) + Caching.CachingCategory<'event, 'state, 'context>(cosmosCat, fold, initial, isOrigin, tryReadCache, updateCache, checkUnfolds, compressUnfolds, mapUnfolds) :> _ + categories.GetOrAdd(categoryName, createCategory) + let resolveInner struct (categoryName, streamId) = + let struct (container, streamName, maybeContainerInitializationGate) = context.ResolveContainerClientAndStreamIdAndInit(categoryName, streamId) + struct (resolveCategory (categoryName, container), streamName, maybeContainerInitializationGate) + let empty = struct (Token.create Position.fromKnownEmpty, initial) + CosmosStoreCategory(resolveInner, empty) namespace Equinox.CosmosStore.Core @@ -1485,13 +1490,13 @@ type EventsContext internal | Direction.Backward -> None, startPos new (context : Equinox.CosmosStore.CosmosStoreContext, log) = - let store, _streamId, _init = context.ResolveContainerClientAndStreamIdAndInit(null, null) + let struct (store, _streamId, _init) = context.ResolveContainerClientAndStreamIdAndInit(null, null) EventsContext(context, store, log) member _.ResolveStream(streamName) = - let _cc, streamId, init = context.ResolveContainerClientAndStreamIdAndInit(null, streamName) - streamId, init - member x.StreamId(streamName) : string = x.ResolveStream streamName |> fst + let struct (_cc, streamName, init) = context.ResolveContainerClientAndStreamIdAndInit(null, streamName) + struct (streamName, init) + member x.StreamId(streamName) : string = x.ResolveStream streamName |> ValueTuple.fst member internal _.GetLazy(stream, ?queryMaxItems, ?direction, ?minIndex, ?maxIndex) : AsyncSeq[]> = let direction = defaultArg direction Direction.Forward @@ -1509,7 +1514,7 @@ type EventsContext internal | Some limit -> maxCountPredicate limit | None -> fun _ -> false let minIndex, maxIndex = getRange direction startPos - let! token, events = store.Read(log, stream, direction, (Some, isOrigin), ?minIndex = minIndex, ?maxIndex = maxIndex) + let! token, events = store.Read(log, stream, direction, (ValueSome, isOrigin), ?minIndex = minIndex, ?maxIndex = maxIndex) if direction = Direction.Backward then System.Array.Reverse events return token, events } @@ -1534,9 +1539,10 @@ type EventsContext internal // Writes go through the stored proc, which we need to provision per container // Having to do this here in this way is far from ideal, but work on caching, external snapshots and caching is likely // to move this about before we reach a final destination in any case - match x.ResolveStream stream |> snd with - | None -> () - | Some init -> do! init () + match x.ResolveStream stream |> ValueTuple.snd with + | ValueNone -> () + | ValueSome init -> let! ct = Async.CancellationToken + do! init ct |> Async.AwaitTaskCorrect let batch = Sync.mkBatch stream events Seq.empty match! store.Sync(log, stream, SyncExp.Version position.index, batch) with | InternalSyncResult.Written (Token.Unpack pos) -> return AppendResult.Ok pos diff --git a/src/Equinox.CosmosStore/Equinox.CosmosStore.fsproj b/src/Equinox.CosmosStore/Equinox.CosmosStore.fsproj index c7da71bc1..560f2bca4 100644 --- a/src/Equinox.CosmosStore/Equinox.CosmosStore.fsproj +++ b/src/Equinox.CosmosStore/Equinox.CosmosStore.fsproj @@ -15,11 +15,11 @@ - + - + - + diff --git a/src/Equinox.DynamoStore.Prometheus/DynamoStorePrometheus.fs b/src/Equinox.DynamoStore.Prometheus/DynamoStorePrometheus.fs index 0da54c427..bde024a8a 100644 --- a/src/Equinox.DynamoStore.Prometheus/DynamoStorePrometheus.fs +++ b/src/Equinox.DynamoStore.Prometheus/DynamoStorePrometheus.fs @@ -92,8 +92,8 @@ type LogSink(customTags: seq) = payloadCounters (facet, op, outcome) (table, cat, float count, if bytes = -1 then None else Some (float bytes)) let (|CatSRu|) ({ interval = i; ru = ru } : Measurement as m) = - let cat, _id = FsCodec.StreamName.splitCategoryAndId (FSharp.UMX.UMX.tag m.stream) - m.table, cat, i.Elapsed, ru + let struct (cat, _id) = FsCodec.StreamName.splitCategoryAndStreamId (FSharp.UMX.UMX.tag m.stream) + struct (m.table, cat, i.Elapsed, ru) let observeRes (_rut, facet, _op as stat) (CatSRu (table, cat, s, ru)) = roundtripHistogram stat (table, cat, s, ru) roundtripSummary facet (table, s, ru) diff --git a/src/Equinox.DynamoStore.Prometheus/Equinox.DynamoStore.Prometheus.fsproj b/src/Equinox.DynamoStore.Prometheus/Equinox.DynamoStore.Prometheus.fsproj index b5bf22f16..790c12ded 100644 --- a/src/Equinox.DynamoStore.Prometheus/Equinox.DynamoStore.Prometheus.fsproj +++ b/src/Equinox.DynamoStore.Prometheus/Equinox.DynamoStore.Prometheus.fsproj @@ -13,9 +13,9 @@ - + - + diff --git a/src/Equinox.DynamoStore/DynamoStore.fs b/src/Equinox.DynamoStore/DynamoStore.fs index da98cd940..3e595e05d 100644 --- a/src/Equinox.DynamoStore/DynamoStore.fs +++ b/src/Equinox.DynamoStore/DynamoStore.fs @@ -7,6 +7,7 @@ open FSharp.Control open Serilog open System open System.IO +open System.Threading.Tasks [] type InternalBody = { encoding : int; data : MemoryStream } @@ -45,8 +46,9 @@ type Event = causationId : string option } interface ITimelineEvent with member x.Index = x.i - member x.Context = null member x.IsUnfold = false + member x.Context = null + member x.Size = Event.Bytes x member x.EventType = x.c member x.Data = x.d member x.Meta = x.m @@ -54,10 +56,11 @@ type Event = member x.CorrelationId = Option.toObj x.correlationId member x.CausationId = Option.toObj x.causationId member x.Timestamp = x.t + static member Bytes(x : Event) = + let inline len x = match x with Some (s : string) -> s.Length | None -> 0 + x.c.Length + InternalBody.bytes x.d + InternalBody.bytes x.m + len x.correlationId + len x.causationId + 20 (*t*) + 20 (*overhead*) module Event = - let private len = function Some (s : string) -> s.Length | None -> 0 - let bytes (x : Event) = x.c.Length + InternalBody.bytes x.d + InternalBody.bytes x.m + len x.correlationId + len x.causationId + 20 (*t*) + 20 (*overhead*) - let arrayBytes (xs : Event array) = Array.sumBy bytes xs + let arrayBytes (xs : Event array) = Array.sumBy Event.Bytes xs /// Compaction/Snapshot/Projection Event based on the state at a given point in time `i` [] @@ -78,8 +81,9 @@ type Unfold = m : InternalBody } interface ITimelineEvent with member x.Index = x.i - member x.Context = null member x.IsUnfold = true + member x.Context = null + member x.Size = Unfold.Bytes x member x.EventType = x.c member x.Data = x.d member x.Meta = x.m @@ -87,16 +91,16 @@ type Unfold = member x.CorrelationId = null member x.CausationId = null member x.Timestamp = x.t + static member Bytes(x : Unfold) = x.c.Length + InternalBody.bytes x.d + InternalBody.bytes x.m + 50 module Unfold = - let private bytes (x : Unfold) = x.c.Length + InternalBody.bytes x.d + InternalBody.bytes x.m + 50 - let arrayBytes (xs : Unfold array) = match xs with null -> 0 | u -> Array.sumBy bytes u + let arrayBytes (xs : Unfold array) = match xs with null -> 0 | u -> Array.sumBy Unfold.Bytes u -/// The abstract storage format for a 'normal' (frozen, not Tip) Batch of Events (without any Unfolds) -/// NOTE See BatchSchema for what actually gets stored +/// The abstract storage format for a Batch of Events represented in a DynamoDB Item +/// NOTE See Batch.Schema buddy type for what actually gets stored /// NOTE names are intended to generally align with CosmosStore naming. Key Diffs: -/// - no mandatory `id` and/or requirement for it to be a `string` -> replaced with `i` as an int64 (also Tip magic value is tipMagicI: int.MaxValue, not "-1") +/// - no mandatory `id` and/or requirement for it to be a `string` -> replaced with `i` as an int64 +/// (also Tip magic value is tipMagicI: Int32.MaxValue, not "-1") /// - etag is managed explicitly (on Cosmos DB, its managed by the service and named "_etag") -/// NOTE see the BatchSchema buddy type for what the store internally has [] type Batch = { p : string // "{streamName}" @@ -113,7 +117,7 @@ type Batch = /// `i` value for successor batch (to facilitate identifying which Batch a given startPos is within) n : int64 - /// The Domain Events (as opposed to Unfolded Events, see Tip) at this offset in the stream + /// The Domain Events (as opposed to Unfolded Events in `u`) for this page of the stream e : Event array /// Compaction/Snapshot/Projection quasi-events @@ -623,7 +627,7 @@ module internal Sync = let calfEvents, residualEvents = ResizeArray(cur.events.Length + events.Length), ResizeArray() let mutable calfFull, calfSize = false, 1024 for e in Seq.append cur.events events do - match calfFull, calfSize + Event.bytes e with + match calfFull, calfSize + Event.Bytes e with | false, calfSize' when calfSize' < maxDynamoDbItemSize -> calfSize <- calfSize'; calfEvents.Add e | _ -> calfFull <- true; residualEvents.Add e let calfEvents = calfEvents.ToArray() @@ -719,7 +723,7 @@ module internal Query = let mutable used, dropped = 0, 0 let mutable found = false for x in xs do - let bytes = Event.bytes x + let bytes = Event.Bytes x if found then dropped <- dropped + bytes else used <- used + bytes if x.i = stopIndex then found <- true @@ -728,13 +732,13 @@ module internal Query = [] type ScanResult<'event> = { found : bool; minIndex : int64; next : int64; maybeTipPos : Position option; events : 'event array } - let scanTip (tryDecode : ITimelineEvent -> 'event option, isOrigin : 'event -> bool) (pos : Position, i : int64, xs : ITimelineEvent array) + let scanTip (tryDecode : ITimelineEvent -> 'event voption, isOrigin : 'event -> bool) (pos : Position, i : int64, xs : ITimelineEvent array) : ScanResult<'event> = let items = ResizeArray() let isOrigin' e = match tryDecode e with - | None -> false - | Some e -> + | ValueNone -> false + | ValueSome e -> items.Insert(0, e) // WalkResult always renders events ordered correctly - here we're aiming to align with Enum.EventsAndUnfolds isOrigin e let f, e = xs |> Seq.map EncodedBody.ofInternal |> Seq.tryFindBack isOrigin' |> Option.isSome, items.ToArray() @@ -742,7 +746,7 @@ module internal Query = // Yields events in ascending Index order let scan<'event> (log : ILogger) (container, stream) maxItems maxRequests direction - (tryDecode : ITimelineEvent -> 'event option, isOrigin : 'event -> bool) + (tryDecode : ITimelineEvent -> 'event voption, isOrigin : 'event -> bool) (minIndex, maxIndex) : Async option> = async { let mutable found = false @@ -755,10 +759,10 @@ module internal Query = if Option.isNone maybeTipPos then maybeTipPos <- maybePos lastResponse <- Some events; ru <- ru + rc.total responseCount <- responseCount + 1 - seq { for x in events -> x, x |> EncodedBody.ofInternal |> tryDecode }) + seq { for x in events -> struct (x, x |> EncodedBody.ofInternal |> tryDecode) }) |> AsyncSeq.concatSeq |> AsyncSeq.takeWhileInclusive (function - | x,Some e when isOrigin e -> + | struct (x, ValueSome e) when isOrigin e -> found <- true match lastResponse with | None -> log.Information("EqxDynamo Stop stream={stream} at={index} {case}", stream, x.i, x.c) @@ -776,8 +780,8 @@ module internal Query = mkQuery readLog (container, stream) maxItems (direction, minIndex, maxIndex) |> AsyncSeq.map (mapPage direction (container, stream) (minIndex, maxIndex, maxItems) maxRequests readLog) let! t, (events, maybeTipPos, ru) = mergeBatches log batches |> Stopwatch.Time - let raws = Array.map fst events - let decoded = if direction = Direction.Forward then Array.choose snd events else Seq.choose snd events |> Seq.rev |> Array.ofSeq + let raws = Array.map ValueTuple.fst events + let decoded = if direction = Direction.Forward then Array.chooseV ValueTuple.snd events else Seq.chooseV ValueTuple.snd events |> Seq.rev |> Array.ofSeq let minMax = (None, raws) ||> Array.fold (fun acc x -> let i = int64 x.i in Some (match acc with None -> i, i | Some (n, x) -> min n i, max x i)) let version = match maybeTipPos, minMax with @@ -1113,12 +1117,12 @@ type internal StoreClient(container : Container, fallback : Container option, qu Prune.until log (container, stream) query.MaxItems index type internal Category<'event, 'state, 'context>(store : StoreClient, codec : IEventCodec<'event, EncodedBody, 'context>) = - member _.Load(log, stream, initial, checkUnfolds, fold, isOrigin) : Async = async { + member _.Load(log, stream, initial, checkUnfolds, fold, isOrigin) : Task = task { let! token, events = store.Load(log, (stream, None), (codec.TryDecode, isOrigin), checkUnfolds) - return token, fold initial events } - member _.Reload(log, stream, (Token.Unpack pos as streamToken), state, fold, isOrigin, ?preloaded) : Async = async { - match! store.Reload(log, (stream, pos), (codec.TryDecode, isOrigin), ?preview = preloaded) with - | LoadFromTokenResult.Unchanged -> return streamToken, state + return struct (token, fold initial events) } + member _.Reload(log, stream, (Token.Unpack pos as streamToken), state, fold, isOrigin, ct, ?preloaded) : Task = task { + match! store.Reload(log, (stream, pos), (codec.TryDecode, isOrigin), ?preview = preloaded) |> Async.startAsTask ct with + | LoadFromTokenResult.Unchanged -> return struct (streamToken, state) | LoadFromTokenResult.Found (token', events) -> return token', fold state events } member cat.Sync(log, stream, (Token.Unpack pos as streamToken), state, events, mapUnfolds, fold, isOrigin, context): Async> = async { let state' = fold state (Seq.ofList events) @@ -1133,7 +1137,7 @@ type internal Category<'event, 'state, 'context>(store : StoreClient, codec : IE Position.toEtag >> Sync.Exp.Etag, events', Seq.map encode events' |> Array.ofSeq, Seq.map encode unfolds let baseVer = Position.toIndex pos + int64 (List.length events) match! store.Sync(log, stream, pos, exp, baseVer, eventsEncoded, Seq.toArray unfoldsEncoded) with - | InternalSyncResult.ConflictUnknown -> return SyncResult.Conflict (cat.Reload(log, stream, streamToken, state, fold, isOrigin)) + | InternalSyncResult.ConflictUnknown -> return SyncResult.Conflict (fun ct -> cat.Reload(log, stream, streamToken, state, fold, isOrigin, ct)) | InternalSyncResult.Written token' -> return SyncResult.Written (token', state') } module internal Caching = @@ -1154,22 +1158,22 @@ module internal Caching = type CachingCategory<'event, 'state, 'context> ( category : Category<'event, 'state, 'context>, fold : 'state -> 'event seq -> 'state, initial : 'state, isOrigin : 'event -> bool, - tryReadCache, updateCache, + tryReadCache, updateCache : string -> _ -> Task, checkUnfolds, mapUnfolds : Choice 'state -> 'event seq, 'event list -> 'state -> 'event list * 'event list>) = - let cache streamName inner = async { - let! tokenAndState = inner - do! updateCache streamName tokenAndState - return tokenAndState } - interface ICategory<'event, 'state, string, 'context> with - member _.Load(log, streamName, allowStale) : Async = async { - match! tryReadCache streamName with - | None -> return! category.Load(log, streamName, initial, checkUnfolds, fold, isOrigin) |> cache streamName - | Some tokenAndState when allowStale -> return tokenAndState // read already updated TTL, no need to write - | Some (token, state) -> return! category.Reload(log, streamName, token, state, fold, isOrigin) |> cache streamName } - member _.TrySync(log : ILogger, streamName, streamToken, state, events : 'event list, context) : Async> = async { - match! category.Sync(log, streamName, streamToken, state, events, mapUnfolds, fold, isOrigin, context) with + let cache streamName (inner : unit -> Task<_>) = task { + let! struct (token, state) = inner () + do! updateCache streamName (token, state) + return struct (token, state) } + interface ICategory<'event, 'state, 'context> with + member _.Load(log, _categoryName, _streamId, streamName, allowStale, ct) : Task = task { + match! tryReadCache streamName : Task> with + | ValueNone -> return! (fun () -> category.Load(log, streamName, initial, checkUnfolds, fold, isOrigin)) |> cache streamName + | ValueSome struct (token, state) when allowStale -> return struct (token, state) // read already updated TTL, no need to write + | ValueSome struct (token, state) -> return! (fun () -> category.Reload(log, streamName, token, state, fold, isOrigin, ct)) |> cache streamName } + member _.TrySync(log : ILogger, _categoryName, _streamId, streamName, context, _maybeInit, streamToken, state, events, ct) : Task> = task { + match! category.Sync(log, streamName, streamToken, state, events, mapUnfolds, fold, isOrigin, context) |> Async.startAsTask ct with | SyncResult.Conflict resync -> - return SyncResult.Conflict (cache streamName resync) + return SyncResult.Conflict (fun ct -> (fun () -> resync ct) |> cache streamName) | SyncResult.Written (token', state') -> do! updateCache streamName (token', state') return SyncResult.Written (token', state') } @@ -1179,6 +1183,7 @@ namespace Equinox.DynamoStore open Equinox.Core open Equinox.DynamoStore.Core open System +open System.Threading.Tasks type [] ConnectionMode = AwsEnvironment of systemName : string | AwsKeyCredentials of serviceUrl : string @@ -1251,7 +1256,9 @@ type DynamoStoreClient [] ?archiveTableName, // Client to use for archive store. Default: (if archiveTableName specified) use same archiveTableName but via client. [] ?archiveClient : Amazon.DynamoDBv2.IAmazonDynamoDB) = - let genStreamName (categoryName, streamId) = if categoryName = null then streamId else sprintf "%s-%s" categoryName streamId + let genStreamName (categoryName, streamId) = + if categoryName = null then streamId else + FsCodec.StreamName.Internal.ofCategoryAndStreamId (categoryName, streamId) let catAndStreamToTableStream (categoryName, streamId) = tableName, genStreamName (categoryName, streamId) let primaryContainer t = Container.Create(client, t) let fallbackContainer = @@ -1291,7 +1298,7 @@ type DynamoStoreContext(storeClient : DynamoStoreClient, tipOptions, queryOption member val TipOptions = tipOptions member internal x.ResolveContainerClientAndStreamId(categoryName, streamId) = let container, fallback, streamName = storeClient.ResolveContainerFallbackAndStreamName(categoryName, streamId) - StoreClient(container, fallback, x.QueryOptions, x.TipOptions), streamName + struct (StoreClient(container, fallback, x.QueryOptions, x.TipOptions), streamName) /// For DynamoDB, caching is critical in order to reduce RU consumption. /// As such, it can often be omitted, particularly if streams are short or there are snapshots being maintained @@ -1349,38 +1356,39 @@ type AccessStrategy<'event, 'state> = /// | Custom of isOrigin : ('event -> bool) * transmute : ('event list -> 'state -> 'event list*'event list) -type DynamoStoreCategory<'event, 'state, 'context>(context : DynamoStoreContext, codec, fold, initial, caching, access) = - let categories = System.Collections.Concurrent.ConcurrentDictionary>() - let resolveCategory (categoryName, container) = - let createCategory _name : ICategory<_, _, string, 'context> = - let tryReadCache, updateCache = - match caching with - | CachingStrategy.NoCaching -> (fun _ -> async { return None }), fun _ _ -> async { () } - | CachingStrategy.SlidingWindow (cache, window) -> cache.TryGet, Caching.applyCacheUpdatesWithSlidingExpiration (cache, null) window - | CachingStrategy.FixedTimeSpan (cache, period) -> cache.TryGet, Caching.applyCacheUpdatesWithFixedTimeSpan (cache, null) period - let isOrigin, checkUnfolds, mapUnfolds = - match access with - | AccessStrategy.Unoptimized -> (fun _ -> false), false, Choice1Of3 () - | AccessStrategy.LatestKnownEvent -> (fun _ -> true), true, Choice2Of3 (fun events _ -> Seq.last events |> Seq.singleton) - | AccessStrategy.Snapshot (isOrigin, toSnapshot) -> isOrigin, true, Choice2Of3 (fun _ state -> toSnapshot state |> Seq.singleton) - | AccessStrategy.MultiSnapshot (isOrigin, unfold) -> isOrigin, true, Choice2Of3 (fun _ state -> unfold state) - | AccessStrategy.RollingState toSnapshot -> (fun _ -> true), true, Choice3Of3 (fun _ state -> [], [toSnapshot state]) - | AccessStrategy.Custom (isOrigin, transmute) -> isOrigin, true, Choice3Of3 transmute - let cosmosCat = Category<'event, 'state, 'context>(container, codec) - Caching.CachingCategory<'event, 'state, 'context>(cosmosCat, fold, initial, isOrigin, tryReadCache, updateCache, checkUnfolds, mapUnfolds) :> _ - categories.GetOrAdd(categoryName, createCategory) - let resolve (FsCodec.StreamName.CategoryAndId (categoryName, streamId)) = - let container, streamName = context.ResolveContainerClientAndStreamId(categoryName, streamId) - resolveCategory (categoryName, container), streamName, None - let empty = Token.empty, initial - let storeCategory = StoreCategory(resolve, empty) - member _.Resolve(streamName, ?context) = storeCategory.Resolve(streamName, ?context = context) +type DynamoStoreCategory<'event, 'state, 'context>(resolveInner, empty) = + inherit Equinox.Category<'event, 'state, 'context>(resolveInner, empty) + new (context : DynamoStoreContext, codec, fold, initial, caching, access) = + let categories = System.Collections.Concurrent.ConcurrentDictionary>() + let resolveCategory (categoryName, container) = + let createCategory _name : ICategory<_, _, 'context> = + let tryReadCache, updateCache = + match caching with + | CachingStrategy.NoCaching -> (fun _ -> Task.FromResult ValueNone), fun _ _ -> Task.FromResult () + | CachingStrategy.SlidingWindow (cache, window) -> cache.TryGet, Caching.applyCacheUpdatesWithSlidingExpiration (cache, null) window + | CachingStrategy.FixedTimeSpan (cache, period) -> cache.TryGet, Caching.applyCacheUpdatesWithFixedTimeSpan (cache, null) period + let isOrigin, checkUnfolds, mapUnfolds = + match access with + | AccessStrategy.Unoptimized -> (fun _ -> false), false, Choice1Of3 () + | AccessStrategy.LatestKnownEvent -> (fun _ -> true), true, Choice2Of3 (fun events _ -> Seq.last events |> Seq.singleton) + | AccessStrategy.Snapshot (isOrigin, toSnapshot) -> isOrigin, true, Choice2Of3 (fun _ state -> toSnapshot state |> Seq.singleton) + | AccessStrategy.MultiSnapshot (isOrigin, unfold) -> isOrigin, true, Choice2Of3 (fun _ state -> unfold state) + | AccessStrategy.RollingState toSnapshot -> (fun _ -> true), true, Choice3Of3 (fun _ state -> [], [toSnapshot state]) + | AccessStrategy.Custom (isOrigin, transmute) -> isOrigin, true, Choice3Of3 transmute + let cosmosCat = Category<'event, 'state, 'context>(container, codec) + Caching.CachingCategory<'event, 'state, 'context>(cosmosCat, fold, initial, isOrigin, tryReadCache, updateCache, checkUnfolds, mapUnfolds) :> _ + categories.GetOrAdd(categoryName, createCategory) + let resolveInner struct (categoryName, streamId) = + let struct (container, streamName) = context.ResolveContainerClientAndStreamId(categoryName, streamId) + struct (resolveCategory (categoryName, container), streamName, ValueNone) + let empty = struct (Token.empty, initial) + DynamoStoreCategory(resolveInner, empty) module Exceptions = - let (|ProvisionedThroughputExceeded|_|) : exn -> unit option = function - | :? Amazon.DynamoDBv2.Model.ProvisionedThroughputExceededException -> Some () - | _ -> None + let [] (|ProvisionedThroughputExceeded|_|) : exn -> unit voption = function + | :? Amazon.DynamoDBv2.Model.ProvisionedThroughputExceededException -> ValueSome () + | _ -> ValueNone namespace Equinox.DynamoStore.Core @@ -1412,10 +1420,10 @@ type EventsContext internal return Position.flatten pos', data } new (context : Equinox.DynamoStore.DynamoStoreContext, log) = - let storeClient, _streamId = context.ResolveContainerClientAndStreamId(null, null) + let storeClient = context.ResolveContainerClientAndStreamId(null, null) |> ValueTuple.fst EventsContext(context, storeClient, log) - member x.StreamId(streamName) : string = context.ResolveContainerClientAndStreamId(null, streamName) |> snd + member x.StreamId(streamName) : string = context.ResolveContainerClientAndStreamId(null, streamName) |> ValueTuple.snd member internal _.GetLazy(stream, ?queryMaxItems, ?direction, ?minIndex, ?maxIndex) : AsyncSeq array> = let direction = defaultArg direction Direction.Forward @@ -1433,7 +1441,7 @@ type EventsContext internal match maxCount with | Some limit -> maxCountPredicate limit | None -> fun _ -> false - let! token, events = store.Read(log, stream, direction, (Some, isOrigin), ?minIndex = minIndex, ?maxIndex = maxIndex) + let! token, events = store.Read(log, stream, direction, (ValueSome, isOrigin), ?minIndex = minIndex, ?maxIndex = maxIndex) if direction = Direction.Backward then System.Array.Reverse events return token, events } diff --git a/src/Equinox.DynamoStore/Equinox.DynamoStore.fsproj b/src/Equinox.DynamoStore/Equinox.DynamoStore.fsproj index c4ce89758..0cd37a827 100644 --- a/src/Equinox.DynamoStore/Equinox.DynamoStore.fsproj +++ b/src/Equinox.DynamoStore/Equinox.DynamoStore.fsproj @@ -10,12 +10,11 @@ - + - - + - + diff --git a/src/Equinox.EventStore/Equinox.EventStore.fsproj b/src/Equinox.EventStore/Equinox.EventStore.fsproj index e26f6086b..166b07ef8 100644 --- a/src/Equinox.EventStore/Equinox.EventStore.fsproj +++ b/src/Equinox.EventStore/Equinox.EventStore.fsproj @@ -15,12 +15,12 @@ - + - + - + diff --git a/src/Equinox.EventStore/EventStore.fs b/src/Equinox.EventStore/EventStore.fs index 579632cc0..160db91cc 100755 --- a/src/Equinox.EventStore/EventStore.fs +++ b/src/Equinox.EventStore/EventStore.fs @@ -261,9 +261,9 @@ module private Read = Array.fold acc (0, 0) let loadBackwardsUntilCompactionOrStart (log : ILogger) retryPolicy conn batchSize maxPermittedBatchReads streamName (tryDecode, isOrigin) - : Async = async { + : Async = async { let mergeFromCompactionPointOrStartFromBackwardsStream (log : ILogger) (batchesBackward : AsyncSeq) - : Async = async { + : Async = async { let versionFromStream, lastBatch = ref None, ref None let! tempBackward = batchesBackward @@ -271,10 +271,10 @@ module private Read = match batch with | None, events -> lastBatch.Value <- Some events; events | Some _ as reportedVersion, events -> versionFromStream.Value <- reportedVersion; lastBatch.Value <- Some events; events - |> Array.map (fun e -> e, tryDecode e)) + |> Array.map (fun e -> struct (e, tryDecode e))) |> AsyncSeq.concatSeq |> AsyncSeq.takeWhileInclusive (function - | x, Some e when isOrigin e -> + | x, ValueSome e when isOrigin e -> match lastBatch.Value with | None -> log.Information("GesStop stream={stream} at={eventNumber}", streamName, x.Event.EventNumber) | Some batch -> @@ -295,7 +295,7 @@ module private Read = let readlog = log |> Log.prop "direction" direction let batchesBackward : AsyncSeq = readBatches readlog retryingLoggingReadSlice maxPermittedBatchReads startPosition let! t, (version, events) = mergeFromCompactionPointOrStartFromBackwardsStream log batchesBackward |> Stopwatch.Time - log |> logBatchRead direction streamName t (Array.map fst events) batchSize version + log |> logBatchRead direction streamName t (Array.map ValueTuple.fst events) batchSize version return version, events } module UnionEncoderAdapters = @@ -385,18 +385,18 @@ type EventStoreContext(conn : EventStoreConnection, batching : BatchingPolicy) = member _.LoadBatched streamName log (tryDecode, isCompactionEventType) : Async = async { let! version, events = Read.loadForwardsFrom log conn.ReadRetryPolicy conn.ReadConnection batching.BatchSize batching.MaxBatches streamName 0L match tryIsResolvedEventEventType isCompactionEventType with - | None -> return Token.ofNonCompacting version, Array.choose tryDecode events + | None -> return Token.ofNonCompacting version, Array.chooseV tryDecode events | Some isCompactionEvent -> match events |> Array.tryFindBack isCompactionEvent with - | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.choose tryDecode events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose tryDecode events } + | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.chooseV tryDecode events + | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV tryDecode events } member _.LoadBackwardsStoppingAtCompactionEvent streamName log (tryDecode, isOrigin) : Async = async { let! version, events = Read.loadBackwardsUntilCompactionOrStart log conn.ReadRetryPolicy conn.ReadConnection batching.BatchSize batching.MaxBatches streamName (tryDecode, isOrigin) - match Array.tryHead events |> Option.filter (function _, Some e -> isOrigin e | _ -> false) with - | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.choose snd events - | Some (resolvedEvent, _) -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose snd events } + match Array.tryHead events |> Option.filter (function _, ValueSome e -> isOrigin e | _ -> false) with + | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.chooseV ValueTuple.snd events + | Some (resolvedEvent, _) -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV ValueTuple.snd events } member _.LoadFromToken useWriteConn streamName log (Token.Unpack token as streamToken) (tryDecode, isCompactionEventType) : Async = async { @@ -404,11 +404,11 @@ type EventStoreContext(conn : EventStoreConnection, batching : BatchingPolicy) = let connToUse = if useWriteConn then conn.WriteConnection else conn.ReadConnection let! version, events = Read.loadForwardsFrom log conn.ReadRetryPolicy connToUse batching.BatchSize batching.MaxBatches streamName streamPosition match isCompactionEventType with - | None -> return Token.ofNonCompacting version, Array.choose tryDecode events + | None -> return Token.ofNonCompacting version, Array.chooseV tryDecode events | Some isCompactionEvent -> - match events |> Array.tryFindBack (fun re -> match tryDecode re with Some e -> isCompactionEvent e | _ -> false) with - | None -> return Token.ofPreviousTokenAndEventsLength streamToken events.Length batching.BatchSize version, Array.choose tryDecode events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose tryDecode events } + match events |> Array.tryFindBack (fun re -> match tryDecode re with ValueSome e -> isCompactionEvent e | _ -> false) with + | None -> return Token.ofPreviousTokenAndEventsLength streamToken events.Length batching.BatchSize version, Array.chooseV tryDecode events + | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV tryDecode events } member _.TrySync log streamName (Token.Unpack token as streamToken) (events, encodedEvents : EventData array) isCompactionEventType : Async = async { let streamVersion = token.streamVersion @@ -477,17 +477,17 @@ type private Category<'event, 'state, 'context>(context : EventStoreContext, cod let load (fold : 'state -> 'event seq -> 'state) initial f = async { let! token, events = f - return token, fold initial events } + return struct (token, fold initial events) } - member _.Load (fold : 'state -> 'event seq -> 'state) (initial : 'state) (streamName : string) (log : ILogger) : Async = + member _.Load (fold : 'state -> 'event seq -> 'state) (initial : 'state) (streamName : string) (log : ILogger) : Async = loadAlgorithm (load fold) streamName initial log - member _.LoadFromToken (fold : 'state -> 'event seq -> 'state) (state : 'state) (streamName : string) token (log : ILogger) : Async = + member _.LoadFromToken (fold : 'state -> 'event seq -> 'state) (state : 'state) (streamName : string) token (log : ILogger) : Async = (load fold) state (context.LoadFromToken false streamName log token (tryDecode, compactionPredicate)) member _.TrySync<'context> ( log : ILogger, fold : 'state -> 'event seq -> 'state, - streamName, (Token.Unpack token as streamToken), state : 'state, events : 'event list, ctx : 'context option) : Async> = async { + streamName, (Token.Unpack token as streamToken), state : 'state, events : 'event list, ctx : 'context) : Async> = async { let encode e = codec.Encode(ctx, e) let events = match access with @@ -498,24 +498,24 @@ type private Category<'event, 'state, 'context>(context : EventStoreContext, cod let encodedEvents : EventData[] = events |> Seq.map (encode >> UnionEncoderAdapters.eventDataOfEncodedEvent) |> Array.ofSeq match! context.TrySync log streamName streamToken (events, encodedEvents) compactionPredicate with | GatewaySyncResult.ConflictUnknown _ -> - return SyncResult.Conflict (load fold state (context.LoadFromToken true streamName log streamToken (tryDecode, compactionPredicate))) + return SyncResult.Conflict (fun ct -> load fold state (context.LoadFromToken true streamName log streamToken (tryDecode, compactionPredicate)) |> Async.startAsTask ct) | GatewaySyncResult.Written token' -> return SyncResult.Written (token', fold state (Seq.ofList events)) } type private Folder<'event, 'state, 'context>(category : Category<'event, 'state, 'context>, fold : 'state -> 'event seq -> 'state, initial : 'state, ?readCache) = let batched log streamName = category.Load fold initial streamName log - interface ICategory<'event, 'state, string, 'context> with - member _.Load(log, streamName, allowStale) : Async = + interface ICategory<'event, 'state, 'context> with + member _.Load(log, _categoryName, _streamId, streamName, allowStale, ct) = match readCache with - | None -> batched log streamName - | Some (cache : ICache, prefix : string) -> async { + | None -> Async.startAsTask ct (batched log streamName) + | Some (cache : ICache, prefix : string) -> task { match! cache.TryGet(prefix + streamName) with - | None -> return! batched log streamName - | Some tokenAndState when allowStale -> return tokenAndState - | Some (token, state) -> return! category.LoadFromToken fold state streamName token log } - member _.TrySync(log, streamName, token, initialState, events : 'event list, context) : Async> = async { - match! category.TrySync(log, fold, streamName, token, initialState, events, context) with - | SyncResult.Conflict resync -> return SyncResult.Conflict resync + | ValueNone -> return! batched log streamName + | ValueSome tokenAndState when allowStale -> return tokenAndState + | ValueSome (token, state) -> return! category.LoadFromToken fold state streamName token log } + member _.TrySync(log, _categoryName, _streamId, streamName, context, _maybeInit, streamToken, initialState, events, _ct) = task { + match! category.TrySync(log, fold, streamName, streamToken, initialState, events, context) with + | SyncResult.Conflict resync -> return SyncResult.Conflict resync | SyncResult.Written (token', state') -> return SyncResult.Written (token', state') } /// For EventStoreDB, caching is less critical than it is for e.g. CosmosDB @@ -535,40 +535,40 @@ type CachingStrategy = /// Semantics are identical to SlidingWindow. | SlidingWindowPrefixed of ICache * window : TimeSpan * prefix : string -type EventStoreCategory<'event, 'state, 'context> - ( context : EventStoreContext, codec : FsCodec.IEventCodec<_, _, 'context>, fold, initial, - // Caching can be overkill for EventStore esp considering the degree to which its intrinsic caching is a first class feature - // e.g., A key benefit is that reads of streams more than a few pages long get completed in constant time after the initial load - [] ?caching, - [] ?access) = - - do match access with - | Some AccessStrategy.LatestKnownEvent when Option.isSome caching -> - "Equinox.EventStore does not support (and it would make things _less_ efficient even if it did)" - + "mixing AccessStrategy.LatestKnownEvent with Caching at present." - |> invalidOp - | _ -> () - let inner = Category<'event, 'state, 'context>(context, codec, ?access = access) - let readCacheOption = - match caching with - | None -> None - | Some (CachingStrategy.SlidingWindow (cache, _)) - | Some (CachingStrategy.FixedTimeSpan (cache, _)) -> Some (cache, null) - | Some (CachingStrategy.SlidingWindowPrefixed (cache, _, prefix)) -> Some (cache, prefix) - let folder = Folder<'event, 'state, 'context>(inner, fold, initial, ?readCache = readCacheOption) - let category : ICategory<_, _, _, 'context> = - match caching with - | None -> folder :> _ - | Some (CachingStrategy.SlidingWindow (cache, window)) -> - Caching.applyCacheUpdatesWithSlidingExpiration cache null window folder Token.supersedes - | Some (CachingStrategy.FixedTimeSpan (cache, period)) -> - Caching.applyCacheUpdatesWithFixedTimeSpan cache null period folder Token.supersedes - | Some (CachingStrategy.SlidingWindowPrefixed (cache, window, prefix)) -> - Caching.applyCacheUpdatesWithSlidingExpiration cache prefix window folder Token.supersedes - let resolve streamName = category, FsCodec.StreamName.toString streamName, None - let empty = context.TokenEmpty, initial - let storeCategory = StoreCategory(resolve, empty) - member _.Resolve(streamName : FsCodec.StreamName, [] ?context) = storeCategory.Resolve(streamName, ?context = context) +type EventStoreCategory<'event, 'state, 'context>(resolveInner, empty) = + inherit Equinox.Category<'event, 'state, 'context>(resolveInner, empty) + new ( context : EventStoreContext, codec : FsCodec.IEventCodec<_, _, 'context>, fold, initial, + // Caching can be overkill for EventStore esp considering the degree to which its intrinsic caching is a first class feature + // e.g., A key benefit is that reads of streams more than a few pages long get completed in constant time after the initial load + [] ?caching, + [] ?access) = + + do match access with + | Some AccessStrategy.LatestKnownEvent when Option.isSome caching -> + "Equinox.EventStore does not support (and it would make things _less_ efficient even if it did)" + + "mixing AccessStrategy.LatestKnownEvent with Caching at present." + |> invalidOp + | _ -> () + let inner = Category<'event, 'state, 'context>(context, codec, ?access = access) + let readCacheOption = + match caching with + | None -> None + | Some (CachingStrategy.SlidingWindow (cache, _)) + | Some (CachingStrategy.FixedTimeSpan (cache, _)) -> Some (cache, null) + | Some (CachingStrategy.SlidingWindowPrefixed (cache, _, prefix)) -> Some (cache, prefix) + let folder = Folder<'event, 'state, 'context>(inner, fold, initial, ?readCache = readCacheOption) + let category : ICategory<_, _, 'context> = + match caching with + | None -> folder :> _ + | Some (CachingStrategy.SlidingWindow (cache, window)) -> + Caching.applyCacheUpdatesWithSlidingExpiration cache null window folder Token.supersedes + | Some (CachingStrategy.FixedTimeSpan (cache, period)) -> + Caching.applyCacheUpdatesWithFixedTimeSpan cache null period folder Token.supersedes + | Some (CachingStrategy.SlidingWindowPrefixed (cache, window, prefix)) -> + Caching.applyCacheUpdatesWithSlidingExpiration cache prefix window folder Token.supersedes + let resolveInner streamIds = struct (category, FsCodec.StreamName.Internal.ofCategoryAndStreamId streamIds, ValueNone) + let empty = struct (context.TokenEmpty, initial) + EventStoreCategory(resolveInner, empty) type private SerilogAdapter(log : ILogger) = interface EventStore.ClientAPI.ILogger with diff --git a/src/Equinox.EventStoreDb/Caching.fs b/src/Equinox.EventStoreDb/Caching.fs index db64acd20..e95fbe12d 100644 --- a/src/Equinox.EventStoreDb/Caching.fs +++ b/src/Equinox.EventStoreDb/Caching.fs @@ -1,19 +1,22 @@ module Equinox.Core.Caching -type internal Decorator<'event, 'state, 'context>(inner : ICategory<'event, 'state, string, 'context>, updateCache : string -> StreamToken * 'state -> Async) = +open System.Threading.Tasks - let cache streamName inner = async { +type internal Decorator<'event, 'state, 'context>( + inner : ICategory<'event, 'state, 'context>, updateCache : string -> struct (StreamToken * 'state) -> Task) = + + let cache streamName (inner : Task<_>) = task { let! tokenAndState = inner do! updateCache streamName tokenAndState return tokenAndState } - interface ICategory<'event, 'state, string, 'context> with - member _.Load(log, streamName : string, opt) : Async = - inner.Load(log, streamName, opt) |> cache streamName + interface ICategory<'event, 'state, 'context> with + member _.Load(log, categoryName, streamId, streamName, allowStale, ct) = + inner.Load(log, categoryName, streamId, streamName, allowStale, ct) |> cache streamName - member _.TrySync(log : Serilog.ILogger, streamName, streamToken, state, events : 'event list, context) : Async> = async { - match! inner.TrySync(log, streamName, streamToken, state, events, context) with - | SyncResult.Conflict resync -> return SyncResult.Conflict (resync |> cache streamName) + member _.TrySync(log, categoryName, streamId, streamName, context, maybeInit, streamToken, state, events, ct) = task { + match! inner.TrySync((log, categoryName, streamId, streamName, context, maybeInit, streamToken, state, events, ct)) with + | SyncResult.Conflict resync -> return SyncResult.Conflict (fun ct -> resync ct |> cache streamName) | SyncResult.Written (token', state') -> do! updateCache streamName (token', state') return SyncResult.Written (token', state') } @@ -22,10 +25,10 @@ let applyCacheUpdatesWithSlidingExpiration (cache : ICache) (prefix : string) (slidingExpiration : System.TimeSpan) - (category : ICategory<'event, 'state, string, 'context>) + (category : ICategory<'event, 'state, 'context>) supersedes - : ICategory<'event, 'state, string, 'context> = - let mkCacheEntry (initialToken : StreamToken, initialState : 'state) = new CacheEntry<'state>(initialToken, initialState, supersedes) + : ICategory<'event, 'state, 'context> = + let mkCacheEntry struct (initialToken : StreamToken, initialState : 'state) = new CacheEntry<'state>(initialToken, initialState, supersedes) let options = CacheItemOptions.RelativeExpiration slidingExpiration let addOrUpdateSlidingExpirationCacheEntry streamName value = cache.UpdateIfNewer(prefix + streamName, options, mkCacheEntry value) Decorator<'event, 'state, 'context>(category, addOrUpdateSlidingExpirationCacheEntry) :> _ @@ -34,10 +37,10 @@ let applyCacheUpdatesWithFixedTimeSpan (cache : ICache) (prefix : string) (lifetime : System.TimeSpan) - (category : ICategory<'event, 'state, string, 'context>) + (category : ICategory<'event, 'state, 'context>) supersedes - : ICategory<'event, 'state, string, 'context> = - let mkCacheEntry (initialToken : StreamToken, initialState : 'state) = CacheEntry<'state>(initialToken, initialState, supersedes) + : ICategory<'event, 'state, 'context> = + let mkCacheEntry struct (initialToken : StreamToken, initialState : 'state) = CacheEntry<'state>(initialToken, initialState, supersedes) let addOrUpdateFixedLifetimeCacheEntry streamName value = let expirationPoint = let creationDate = System.DateTimeOffset.UtcNow in creationDate.Add lifetime let options = CacheItemOptions.AbsoluteExpiration expirationPoint diff --git a/src/Equinox.EventStoreDb/Equinox.EventStoreDb.fsproj b/src/Equinox.EventStoreDb/Equinox.EventStoreDb.fsproj index 2ef3cbf73..0441a9922 100644 --- a/src/Equinox.EventStoreDb/Equinox.EventStoreDb.fsproj +++ b/src/Equinox.EventStoreDb/Equinox.EventStoreDb.fsproj @@ -15,12 +15,12 @@ - + - + - + diff --git a/src/Equinox.EventStoreDb/EventStoreDb.fs b/src/Equinox.EventStoreDb/EventStoreDb.fs index 7ed6e64b9..5ba2e97be 100755 --- a/src/Equinox.EventStoreDb/EventStoreDb.fs +++ b/src/Equinox.EventStoreDb/EventStoreDb.fs @@ -194,14 +194,14 @@ module private Read = "Esdb{action:l} stream={stream} count={count}/{batches} version={version}", action, streamName, count, batches, version) let loadBackwardsUntilOrigin (log : ILogger) (conn : EventStoreClient) batchSize streamName (tryDecode, isOrigin) - : Async = async { + : Async = async { let! ct = Async.CancellationToken let res = conn.ReadStreamAsync(Direction.Backwards, streamName, StreamPosition.End, int64 batchSize, resolveLinkTos = false, cancellationToken = ct) try let! events = AsyncSeq.ofAsyncEnum res - |> AsyncSeq.map (fun x -> x, tryDecode x) + |> AsyncSeq.map (fun x -> struct (x, tryDecode x)) |> AsyncSeq.takeWhileInclusive (function - | x, Some e when isOrigin e -> + | x, ValueSome e when isOrigin e -> log.Information("EsdbStop stream={stream} at={eventNumber}", streamName, let en = x.Event.EventNumber in en.ToInt64()) false | _ -> true) @@ -212,10 +212,10 @@ module private Read = with :? AggregateException as e when (e.InnerExceptions.Count = 1 && e.InnerExceptions[0] :? StreamNotFoundException) -> return -1L, [||] } let loadBackwards (log : ILogger) (conn : EventStoreClient) batchSize streamName (tryDecode, isOrigin) - : Async = async { + : Async = async { let! t, (version, events) = loadBackwardsUntilOrigin log conn batchSize streamName (tryDecode, isOrigin) |> Stopwatch.Time let log = log |> Log.prop "batchSize" batchSize |> Log.prop "stream" streamName - log |> logBatchRead Direction.Backward streamName t (Array.map fst events) (Some batchSize) version + log |> logBatchRead Direction.Backward streamName t (Array.map ValueTuple.fst events) (Some batchSize) version return version, events } let loadForward (conn : EventStoreClient) streamName startPosition @@ -316,32 +316,32 @@ type EventStoreContext(conn : EventStoreConnection, batching : BatchingPolicy) = let tryIsResolvedEventEventType predicateOption = predicateOption |> Option.map isResolvedEventEventType member _.TokenEmpty = Token.ofUncompactedVersion batching.BatchSize -1L - member _.LoadBatched(streamName, log, tryDecode, isCompactionEventType) : Async = async { + member _.LoadBatched(streamName, log, tryDecode, isCompactionEventType) : Async = async { let! version, events = Read.loadForwards log conn.ReadConnection streamName StreamPosition.Start match tryIsResolvedEventEventType isCompactionEventType with - | None -> return Token.ofNonCompacting version, Array.choose tryDecode events + | None -> return Token.ofNonCompacting version, Array.chooseV tryDecode events | Some isCompactionEvent -> match events |> Array.tryFindBack isCompactionEvent with - | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.choose tryDecode events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose tryDecode events } + | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.chooseV tryDecode events + | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV tryDecode events } - member _.LoadBackwardsStoppingAtCompactionEvent(streamName, log, limit, (tryDecode, isOrigin)) : Async = async { + member _.LoadBackwardsStoppingAtCompactionEvent(streamName, log, limit, (tryDecode, isOrigin)) : Async = async { let! version, events = Read.loadBackwards log conn.ReadConnection (defaultArg limit Int32.MaxValue) streamName (tryDecode, isOrigin) - match Array.tryHead events |> Option.filter (function _, Some e -> isOrigin e | _ -> false) with - | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.choose snd events - | Some (resolvedEvent, _) -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose snd events } + match Array.tryHead events |> Option.filter (function _, ValueSome e -> isOrigin e | _ -> false) with + | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.chooseV ValueTuple.snd events + | Some (resolvedEvent, _) -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV ValueTuple.snd events } member _.LoadFromToken(useWriteConn, streamName, log, (Token.Unpack token as streamToken), tryDecode, isCompactionEventType) - : Async = async { + : Async = async { let streamPosition = StreamPosition.FromInt64(token.streamVersion + 1L) let connToUse = if useWriteConn then conn.WriteConnection else conn.ReadConnection let! version, events = Read.loadForwards log connToUse streamName streamPosition match isCompactionEventType with - | None -> return Token.ofNonCompacting version, Array.choose tryDecode events + | None -> return Token.ofNonCompacting version, Array.chooseV tryDecode events | Some isCompactionEvent -> - match events |> Array.tryFindBack (fun re -> match tryDecode re with Some e -> isCompactionEvent e | _ -> false) with - | None -> return Token.ofPreviousTokenAndEventsLength streamToken events.Length batching.BatchSize version, Array.choose tryDecode events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose tryDecode events } + match events |> Array.tryFindBack (fun re -> match tryDecode re with ValueSome e -> isCompactionEvent e | _ -> false) with + | None -> return Token.ofPreviousTokenAndEventsLength streamToken events.Length batching.BatchSize version, Array.chooseV tryDecode events + | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV tryDecode events } member _.TrySync(log, streamName, (Token.Unpack token as streamToken), events, encodedEvents : EventData array, isCompactionEventType): Async = async { let streamVersion = token.streamVersion @@ -411,18 +411,18 @@ type private Category<'event, 'state, 'context>(context : EventStoreContext, cod | Some (AccessStrategy.RollingSnapshots _) -> compacted None let load (fold : 'state -> 'event seq -> 'state) initial f = async { - let! token, events = f - return token, fold initial events } + let! struct (token, events) = f + return struct (token, fold initial events) } - member _.Load(fold : 'state -> 'event seq -> 'state, initial : 'state, streamName : string, log : ILogger) : Async = + member _.Load(fold : 'state -> 'event seq -> 'state, initial : 'state, streamName : string, log : ILogger) : Async = loadAlgorithm (load fold) streamName initial log - member _.LoadFromToken(fold : 'state -> 'event seq -> 'state, state : 'state, streamName : string, token, log : ILogger) : Async = + member _.LoadFromToken(fold : 'state -> 'event seq -> 'state, state : 'state, streamName : string, token, log : ILogger) : Async = (load fold) state (context.LoadFromToken(false, streamName, log, token, tryDecode, compactionPredicate)) member _.TrySync<'context> ( log : ILogger, fold : 'state -> 'event seq -> 'state, - streamName, (Token.Unpack token as streamToken), state : 'state, events : 'event list, ctx : 'context option) : Async> = async { + streamName, (Token.Unpack token as streamToken), state : 'state, events : 'event list, ctx : 'context) : Async> = async { let encode e = codec.Encode(ctx, e) let events = match access with @@ -432,29 +432,27 @@ type private Category<'event, 'state, 'context>(context : EventStoreContext, cod if cc.IsCompactionDue then events @ [fold state events |> compact] else events let encodedEvents : EventData[] = events |> Seq.map (encode >> UnionEncoderAdapters.eventDataOfEncodedEvent) |> Array.ofSeq - let! syncRes = context.TrySync(log, streamName, streamToken, events, encodedEvents, compactionPredicate) - match syncRes with + match! context.TrySync(log, streamName, streamToken, events, encodedEvents, compactionPredicate) with | GatewaySyncResult.ConflictUnknown _ -> - return SyncResult.Conflict (load fold state (context.LoadFromToken(true, streamName, log, streamToken, tryDecode, compactionPredicate))) + return SyncResult.Conflict (fun ct -> load fold state (context.LoadFromToken(true, streamName, log, streamToken, tryDecode, compactionPredicate)) |> Async.startAsTask ct) | GatewaySyncResult.Written token' -> return SyncResult.Written (token', fold state (Seq.ofList events)) } type private Folder<'event, 'state, 'context>(category : Category<'event, 'state, 'context>, fold : 'state -> 'event seq -> 'state, initial : 'state, ?readCache) = let batched log streamName = category.Load(fold, initial, streamName, log) - interface ICategory<'event, 'state, string, 'context> with - member _.Load(log, streamName, allowStale) : Async = + interface ICategory<'event, 'state, 'context> with + member _.Load(log, _categoryName, _streamId, streamName, allowStale, _ct) = task { match readCache with - | None -> batched log streamName - | Some (cache : ICache, prefix : string) -> async { + | None -> return! batched log streamName + | Some (cache : ICache, prefix : string) -> match! cache.TryGet(prefix + streamName) with - | None -> return! batched log streamName - | Some tokenAndState when allowStale -> return tokenAndState - | Some (token, state) -> return! category.LoadFromToken(fold, state, streamName, token, log) } - - member _.TrySync(log : ILogger, streamName, token, initialState, events : 'event list, context) : Async> = async { - let! syncRes = category.TrySync(log, fold, streamName, token, initialState, events, context) - match syncRes with - | SyncResult.Conflict resync -> return SyncResult.Conflict resync + | ValueNone -> return! batched log streamName + | ValueSome tokenAndState when allowStale -> return tokenAndState + | ValueSome (token, state) -> return! category.LoadFromToken(fold, state, streamName, token, log) } + + member _.TrySync(log, _categoryName, _aggregateId, streamName, context, _maybeInit, streamToken, initialState, events, ct) = task { + match! category.TrySync(log, fold, streamName, streamToken, initialState, events, context) with + | SyncResult.Conflict resync -> return SyncResult.Conflict resync | SyncResult.Written (token', state') -> return SyncResult.Written (token', state') } /// For EventStoreDB, caching is less critical than it is for e.g. CosmosDB @@ -474,40 +472,40 @@ type CachingStrategy = /// Semantics are identical to SlidingWindow. | SlidingWindowPrefixed of ICache * window : TimeSpan * prefix : string -type EventStoreCategory<'event, 'state, 'context> - ( context : EventStoreContext, codec : FsCodec.IEventCodec<_, _, 'context>, fold, initial, - // Caching can be overkill for EventStore esp considering the degree to which its intrinsic caching is a first class feature - // e.g., A key benefit is that reads of streams more than a few pages long get completed in constant time after the initial load - [] ?caching, - [] ?access) = - - do match access with - | Some AccessStrategy.LatestKnownEvent when Option.isSome caching -> - "Equinox.EventStoreDb does not support (and it would make things _less_ efficient even if it did)" - + "mixing AccessStrategy.LatestKnownEvent with Caching at present." - |> invalidOp - | _ -> () - let inner = Category<'event, 'state, 'context>(context, codec, ?access = access) - let readCacheOption = - match caching with - | None -> None - | Some (CachingStrategy.SlidingWindow (cache, _)) - | Some (CachingStrategy.FixedTimeSpan (cache, _)) -> Some (cache, null) - | Some (CachingStrategy.SlidingWindowPrefixed (cache, _, prefix)) -> Some (cache, prefix) - let folder = Folder<'event, 'state, 'context>(inner, fold, initial, ?readCache = readCacheOption) - let category : ICategory<_, _, _, 'context> = - match caching with - | None -> folder :> _ - | Some (CachingStrategy.SlidingWindow (cache, window)) -> - Caching.applyCacheUpdatesWithSlidingExpiration cache null window folder Token.supersedes - | Some (CachingStrategy.FixedTimeSpan (cache, period)) -> - Caching.applyCacheUpdatesWithFixedTimeSpan cache null period folder Token.supersedes - | Some (CachingStrategy.SlidingWindowPrefixed (cache, window, prefix)) -> - Caching.applyCacheUpdatesWithSlidingExpiration cache prefix window folder Token.supersedes - let resolve streamName = category, FsCodec.StreamName.toString streamName, None - let empty = context.TokenEmpty, initial - let storeCategory = StoreCategory(resolve, empty) - member _.Resolve(streamName : FsCodec.StreamName, [] ?context) = storeCategory.Resolve(streamName, ?context = context) +type EventStoreCategory<'event, 'state, 'context>(resolveInner, empty) = + inherit Equinox.Category<'event, 'state, 'context>(resolveInner, empty) + new ( context : EventStoreContext, codec : FsCodec.IEventCodec<_, _, 'context>, fold, initial, + // Caching can be overkill for EventStore esp considering the degree to which its intrinsic caching is a first class feature + // e.g., A key benefit is that reads of streams more than a few pages long get completed in constant time after the initial load + [] ?caching, + [] ?access) = + + do match access with + | Some AccessStrategy.LatestKnownEvent when Option.isSome caching -> + "Equinox.EventStoreDb does not support (and it would make things _less_ efficient even if it did)" + + "mixing AccessStrategy.LatestKnownEvent with Caching at present." + |> invalidOp + | _ -> () + let inner = Category<'event, 'state, 'context>(context, codec, ?access = access) + let readCacheOption = + match caching with + | None -> None + | Some (CachingStrategy.SlidingWindow (cache, _)) + | Some (CachingStrategy.FixedTimeSpan (cache, _)) -> Some (cache, null) + | Some (CachingStrategy.SlidingWindowPrefixed (cache, _, prefix)) -> Some (cache, prefix) + let folder = Folder<'event, 'state, 'context>(inner, fold, initial, ?readCache = readCacheOption) + let category : ICategory<_, _, 'context> = + match caching with + | None -> folder :> _ + | Some (CachingStrategy.SlidingWindow (cache, window)) -> + Caching.applyCacheUpdatesWithSlidingExpiration cache null window folder Token.supersedes + | Some (CachingStrategy.FixedTimeSpan (cache, period)) -> + Caching.applyCacheUpdatesWithFixedTimeSpan cache null period folder Token.supersedes + | Some (CachingStrategy.SlidingWindowPrefixed (cache, window, prefix)) -> + Caching.applyCacheUpdatesWithSlidingExpiration cache prefix window folder Token.supersedes + let resolveInner streamIds = struct (category, FsCodec.StreamName.Internal.ofCategoryAndStreamId streamIds, ValueNone) + let empty = struct (context.TokenEmpty, initial) + EventStoreCategory(resolveInner, empty) (* TODO type private SerilogAdapter(log : ILogger) = diff --git a/src/Equinox.MemoryStore/Equinox.MemoryStore.fsproj b/src/Equinox.MemoryStore/Equinox.MemoryStore.fsproj index 9abbb6e62..929ebc903 100644 --- a/src/Equinox.MemoryStore/Equinox.MemoryStore.fsproj +++ b/src/Equinox.MemoryStore/Equinox.MemoryStore.fsproj @@ -5,6 +5,7 @@ + @@ -13,11 +14,11 @@ - + - + - + diff --git a/src/Equinox.MemoryStore/MemoryStore.fs b/src/Equinox.MemoryStore/MemoryStore.fs index d1fc4a118..ebc649731 100644 --- a/src/Equinox.MemoryStore/MemoryStore.fs +++ b/src/Equinox.MemoryStore/MemoryStore.fs @@ -4,7 +4,7 @@ namespace Equinox.MemoryStore open Equinox.Core -open System.Runtime.InteropServices +open System.Threading.Tasks /// Maintains a dictionary of ITimelineEvent<'Format>[] per stream-name, allowing one to vary the encoding used to match that of a given concrete store, or optimize test run performance type VolatileStore<'Format>() = @@ -13,71 +13,73 @@ type VolatileStore<'Format>() = let seedStream _streamName struct (_expectedCount, events) = events let updateValue _streamName (currentValue : FsCodec.ITimelineEvent<'Format>[]) struct (expectedCount, events) = - if Array.length currentValue <> expectedCount then currentValue + if currentValue.Length <> expectedCount then currentValue // note we don't publish here, as this function can be potentially invoked multiple times where there is a race else Array.append currentValue events - let trySync streamName expectedCount events : bool * FsCodec.ITimelineEvent<'Format>[] = + let trySync streamName expectedCount events : struct (bool * FsCodec.ITimelineEvent<'Format>[]) = let res = streams.AddOrUpdate(streamName, seedStream, updateValue, (expectedCount, events)) (obj.ReferenceEquals(Array.last res, Array.last events), res) - // Where TrySync attempts overlap on the same stream, there's a race to raise the Committed event for each 'commit' resulting from a successful Sync - // If we don't serialize the publishing of the events, its possible for handlers to observe the Events out of order let committed = Event<_>() - // Here we neuter that effect - the BatchingGate can end up with commits submitted out of order, but we serialize the raising of the events per stream - let publishBatches (commits : (FsCodec.StreamName * FsCodec.ITimelineEvent<'Format>[])[]) = async { - for streamName, events in commits |> Seq.groupBy fst do - committed.Trigger(streamName, events |> Seq.collect snd |> Seq.sortBy (fun x -> x.Index) |> Seq.toArray) } - let publishCommit = AsyncBatchingGate(publishBatches, System.TimeSpan.FromMilliseconds 2.) + /// Notifies re batches of events being committed to a given Stream. + /// Commits are guaranteed to be notified in correct order, with max one notification in flight per stream + /// NOTE current impl locks on a global basis rather than at stream level + [] member _.Committed : IEvent[])> = committed.Publish - /// Notifies of a batch of events being committed to a given Stream. Guarantees no out of order and/or overlapping raising of the event
- /// NOTE in some cases, two or more overlapping commits can be coalesced into a single Committed event - [] member _.Committed : IEvent[]> = committed.Publish - - /// Loads state from a given stream - member _.TryLoad streamName = match streams.TryGetValue streamName with false, _ -> None | true, packed -> Some packed + /// Loads events from a given stream, null if none yet written + member _.Load(streamName) = + let mutable events = Unchecked.defaultof<_> + streams.TryGetValue(streamName, &events) |> ignore + events /// Attempts a synchronization operation - yields conflicting value if expectedCount does not match - member _.TrySync(streamName, expectedCount, events) : Async[]> = async { - let succeeded, _ as outcome = trySync streamName expectedCount events - if succeeded then do! publishCommit.Execute((FsCodec.StreamName.parse streamName, events)) - return outcome } + member this.TrySync(streamName, categoryName, streamId, expectedCount, events) : struct (bool * FsCodec.ITimelineEvent<'Format>[]) = + // Where attempts overlap on the same stream, there's a race to raise the Committed event for each 'commit' + // If we don't serialize the publishing of the events, its possible for handlers to observe the Events out of order + // NOTE while a Channels based impl might offer better throughput at load, in practical terms serializing all Committed event notifications + // works very well as long as the handlers don't do a lot of processing, instead offloading to a private work queue + lock streams <| fun () -> + let struct (succeeded, _) as outcome = trySync streamName expectedCount events + if succeeded then committed.Trigger(categoryName, streamId, events) + outcome -type Token = { eventCount : int } +type Token = int /// Internal implementation detail of MemoryStore module private Token = let private streamTokenOfEventCount (eventCount : int) : StreamToken = // TOCONSIDER Could implement streamBytes tracking based on a supplied event size function (store is agnostic to format) - { value = box { eventCount = eventCount }; version = int64 eventCount; streamBytes = -1 } - let (|Unpack|) (token : StreamToken) : int = let t = unbox token.value in t.eventCount + { value = box eventCount; version = int64 eventCount; streamBytes = -1 } + let (|Unpack|) (token : StreamToken) : int = unbox token.value /// Represent a stream known to be empty let ofEmpty = streamTokenOfEventCount 0 let ofValue (value : 'event array) = streamTokenOfEventCount value.Length /// Represents the state of a set of streams in a style consistent withe the concrete Store types - no constraints on memory consumption (but also no persistence!). type Category<'event, 'state, 'context, 'Format>(store : VolatileStore<'Format>, codec : FsCodec.IEventCodec<'event, 'Format, 'context>, fold, initial) = - interface ICategory<'event, 'state, string, 'context> with - member _.Load(_log, streamName, _opt) = async { - match store.TryLoad streamName with - | None -> return Token.ofEmpty, initial - | Some value -> return Token.ofValue value, fold initial (value |> Seq.choose codec.TryDecode) } - member _.TrySync(_log, streamName, Token.Unpack eventCount, state, events : 'event list, context : 'context option) = async { + interface ICategory<'event, 'state, 'context> with + member _.Load(_log, _categoryName, _streamId, streamName, _allowStale, _ct) = + match store.Load(streamName) with + | null -> struct (Token.ofEmpty, initial) |> Task.FromResult + | xs -> struct (Token.ofValue xs, fold initial (Seq.chooseV codec.TryDecode xs)) |> Task.FromResult + member _.TrySync(_log, categoryName, streamId, streamName, context, _init, Token.Unpack eventCount, state, events, _ct) = let inline map i (e : FsCodec.IEventData<'Format>) = FsCodec.Core.TimelineEvent.Create(int64 i, e.EventType, e.Data, e.Meta, e.EventId, e.CorrelationId, e.CausationId, e.Timestamp) - let encoded = events |> Seq.mapi (fun i e -> map (eventCount + i) (codec.Encode(context, e))) |> Array.ofSeq - match! store.TrySync(streamName, eventCount, encoded) with + let encoded = Array.ofSeq events |> Array.mapi (fun i e -> map (eventCount + i) (codec.Encode(context, e))) + match store.TrySync(streamName, categoryName, streamId, eventCount, encoded) with | true, streamEvents' -> - return SyncResult.Written (Token.ofValue streamEvents', fold state events) + SyncResult.Written (Token.ofValue streamEvents', fold state events) |> Task.FromResult | false, conflictingEvents -> - let resync = async { + let resync _ct = let token' = Token.ofValue conflictingEvents - return token', fold state (conflictingEvents |> Seq.skip eventCount |> Seq.choose codec.TryDecode) } - return SyncResult.Conflict resync } + struct (token', fold state (conflictingEvents |> Seq.skip eventCount |> Seq.chooseV codec.TryDecode)) |> Task.FromResult + SyncResult.Conflict resync |> Task.FromResult -type MemoryStoreCategory<'event, 'state, 'Format, 'context>(store : VolatileStore<'Format>, codec : FsCodec.IEventCodec<'event, 'Format, 'context>, fold, initial) = - let category = Category<'event, 'state, 'context, 'Format>(store, codec, fold, initial) - let resolve streamName = category :> ICategory<_, _, _, _>, FsCodec.StreamName.toString streamName, (None : (unit -> Async) option) - let empty = Token.ofEmpty, initial - let storeCategory = StoreCategory<'event, 'state, FsCodec.StreamName, 'context>(resolve, empty) - member _.Resolve(streamName : FsCodec.StreamName, [] ?context : 'context) = storeCategory.Resolve(streamName, ?context = context) +type MemoryStoreCategory<'event, 'state, 'Format, 'context>(resolveInner, empty) = + inherit Equinox.Category<'event, 'state, 'context>(resolveInner, empty) + new (store : VolatileStore<'Format>, codec : FsCodec.IEventCodec<'event, 'Format, 'context>, fold, initial) = + let impl = Category<'event, 'state, 'context, 'Format>(store, codec, fold, initial) + let resolveInner streamIds = struct (impl :> ICategory<_, _, _>, FsCodec.StreamName.Internal.ofCategoryAndStreamId streamIds, ValueNone) + let empty = struct (Token.ofEmpty, initial) + MemoryStoreCategory(resolveInner, empty) diff --git a/src/Equinox.SqlStreamStore.MsSql/Equinox.SqlStreamStore.MsSql.fsproj b/src/Equinox.SqlStreamStore.MsSql/Equinox.SqlStreamStore.MsSql.fsproj index d75c75540..41272cec5 100644 --- a/src/Equinox.SqlStreamStore.MsSql/Equinox.SqlStreamStore.MsSql.fsproj +++ b/src/Equinox.SqlStreamStore.MsSql/Equinox.SqlStreamStore.MsSql.fsproj @@ -10,9 +10,9 @@ - + - + diff --git a/src/Equinox.SqlStreamStore.MySql/Equinox.SqlStreamStore.MySql.fsproj b/src/Equinox.SqlStreamStore.MySql/Equinox.SqlStreamStore.MySql.fsproj index c1ff56138..f2ea764eb 100644 --- a/src/Equinox.SqlStreamStore.MySql/Equinox.SqlStreamStore.MySql.fsproj +++ b/src/Equinox.SqlStreamStore.MySql/Equinox.SqlStreamStore.MySql.fsproj @@ -10,9 +10,9 @@ - + - + diff --git a/src/Equinox.SqlStreamStore.Postgres/Equinox.SqlStreamStore.Postgres.fsproj b/src/Equinox.SqlStreamStore.Postgres/Equinox.SqlStreamStore.Postgres.fsproj index 22f5fc465..764c29a68 100644 --- a/src/Equinox.SqlStreamStore.Postgres/Equinox.SqlStreamStore.Postgres.fsproj +++ b/src/Equinox.SqlStreamStore.Postgres/Equinox.SqlStreamStore.Postgres.fsproj @@ -10,9 +10,9 @@ - + - + diff --git a/src/Equinox.SqlStreamStore/Equinox.SqlStreamStore.fsproj b/src/Equinox.SqlStreamStore/Equinox.SqlStreamStore.fsproj index 12913228e..5d38dba0e 100644 --- a/src/Equinox.SqlStreamStore/Equinox.SqlStreamStore.fsproj +++ b/src/Equinox.SqlStreamStore/Equinox.SqlStreamStore.fsproj @@ -15,11 +15,11 @@ - + - + - + diff --git a/src/Equinox.SqlStreamStore/SqlStreamStore.fs b/src/Equinox.SqlStreamStore/SqlStreamStore.fs index e4c9524ef..73aa6e8a5 100644 --- a/src/Equinox.SqlStreamStore/SqlStreamStore.fs +++ b/src/Equinox.SqlStreamStore/SqlStreamStore.fs @@ -241,9 +241,9 @@ module private Read = let acc (tu, tr) (ResolvedEventLen bytes as y) = if y.Position < firstUsedEventNumber then tu, tr + bytes else tu + bytes, tr Array.fold acc (0, 0) let loadBackwardsUntilCompactionOrStart (log : ILogger) retryPolicy conn batchSize maxPermittedBatchReads streamName (tryDecode, isOrigin) - : Async = async { + : Async = async { let mergeFromCompactionPointOrStartFromBackwardsStream (log : ILogger) (batchesBackward : AsyncSeq) - : Async = async { + : Async = async { let versionFromStream, lastBatch = ref None, ref None let! tempBackward = batchesBackward @@ -251,10 +251,10 @@ module private Read = match batch with | None, events -> lastBatch.Value <- Some events; events | Some _ as reportedVersion, events -> versionFromStream.Value <- reportedVersion; lastBatch.Value <- Some events; events - |> Array.map (fun e -> e, tryDecode e)) + |> Array.map (fun e -> struct (e, tryDecode e))) |> AsyncSeq.concatSeq |> AsyncSeq.takeWhileInclusive (function - | x, Some e when isOrigin e -> + | x, ValueSome e when isOrigin e -> match lastBatch.Value with | None -> log.Information("SqlEsStop stream={stream} at={eventNumber}", streamName, x.Position) | Some batch -> @@ -274,7 +274,7 @@ module private Read = let readlog = log |> Log.prop "direction" direction let batchesBackward : AsyncSeq = readBatches readlog retryingLoggingReadSlice maxPermittedBatchReads startPosition let! t, (version, events) = mergeFromCompactionPointOrStartFromBackwardsStream log batchesBackward |> Stopwatch.Time - log |> logBatchRead direction streamName t (Array.map fst events) batchSize version + log |> logBatchRead direction streamName t (Array.map ValueTuple.fst events) batchSize version return version, events } module UnionEncoderAdapters = @@ -358,28 +358,28 @@ type SqlStreamStoreContext(connection : SqlStreamStoreConnection, batching : Bat member _.LoadBatched streamName log (tryDecode, isCompactionEventType) : Async = async { let! version, events = Read.loadForwardsFrom log connection.ReadRetryPolicy connection.ReadConnection batching.BatchSize batching.MaxBatches streamName 0L match tryIsResolvedEventEventType isCompactionEventType with - | None -> return Token.ofNonCompacting version, Array.choose tryDecode events + | None -> return Token.ofNonCompacting version, Array.chooseV tryDecode events | Some isCompactionEvent -> match events |> Array.tryFindBack isCompactionEvent with - | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.choose tryDecode events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose tryDecode events } + | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.chooseV tryDecode events + | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV tryDecode events } member _.LoadBackwardsStoppingAtCompactionEvent streamName log (tryDecode, isOrigin) : Async = async { let! version, events = Read.loadBackwardsUntilCompactionOrStart log connection.ReadRetryPolicy connection.ReadConnection batching.BatchSize batching.MaxBatches streamName (tryDecode, isOrigin) - match Array.tryHead events |> Option.filter (function _, Some e -> isOrigin e | _ -> false) with - | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.choose snd events - | Some (resolvedEvent, _) -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose snd events } + match Array.tryHead events |> Option.filter (function _, ValueSome e -> isOrigin e | _ -> false) with + | None -> return Token.ofUncompactedVersion batching.BatchSize version, Array.chooseV ValueTuple.snd events + | Some (resolvedEvent, _) -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV ValueTuple.snd events } member _.LoadFromToken useWriteConn streamName log (Token.Unpack token as streamToken) (tryDecode, isCompactionEventType) : Async = async { let streamPosition = token.streamVersion + 1L let connToUse = if useWriteConn then connection.WriteConnection else connection.ReadConnection let! version, events = Read.loadForwardsFrom log connection.ReadRetryPolicy connToUse batching.BatchSize batching.MaxBatches streamName streamPosition match isCompactionEventType with - | None -> return Token.ofNonCompacting version, Array.choose tryDecode events + | None -> return Token.ofNonCompacting version, Array.chooseV tryDecode events | Some isCompactionEvent -> - match events |> Array.tryFindBack (fun re -> match tryDecode re with Some e -> isCompactionEvent e | _ -> false) with - | None -> return Token.ofPreviousTokenAndEventsLength streamToken events.Length batching.BatchSize version, Array.choose tryDecode events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.choose tryDecode events } + match events |> Array.tryFindBack (fun re -> match tryDecode re with ValueSome e -> isCompactionEvent e | _ -> false) with + | None -> return Token.ofPreviousTokenAndEventsLength streamToken events.Length batching.BatchSize version, Array.chooseV tryDecode events + | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize version, Array.chooseV tryDecode events } member _.TrySync log streamName (Token.Unpack pos as streamToken) (events, encodedEvents : EventData array) isCompactionEventType : Async = async { match! Write.writeEvents log connection.WriteRetryPolicy connection.WriteConnection streamName pos.streamVersion encodedEvents with | EsSyncResult.ConflictUnknown -> @@ -441,14 +441,14 @@ type private Category<'event, 'state, 'context>(context : SqlStreamStoreContext, | Some (AccessStrategy.RollingSnapshots _) -> compacted let load (fold : 'state -> 'event seq -> 'state) initial f = async { let! token, events = f - return token, fold initial events } - member _.Load(fold : 'state -> 'event seq -> 'state) (initial : 'state) (streamName : string) (log : ILogger) : Async = + return struct (token, fold initial events) } + member _.Load(fold : 'state -> 'event seq -> 'state) (initial : 'state) (streamName : string) (log : ILogger) : Async = loadAlgorithm (load fold) streamName initial log - member _.LoadFromToken (fold : 'state -> 'event seq -> 'state) (state : 'state) (streamName : string) token (log : ILogger) : Async = + member _.LoadFromToken (fold : 'state -> 'event seq -> 'state) (state : 'state) (streamName : string) token (log : ILogger) : Async = (load fold) state (context.LoadFromToken false streamName log token (tryDecode, compactionPredicate)) member _.TrySync<'context> ( log : ILogger, fold : 'state -> 'event seq -> 'state, - streamName, (Token.Unpack token as streamToken), state : 'state, events : 'event list, ctx : 'context option) : Async> = async { + streamName, (Token.Unpack token as streamToken), state : 'state, events : 'event list, ctx : 'context) : Async> = async { let encode e = codec.Encode(ctx, e) let events = match access with @@ -459,24 +459,24 @@ type private Category<'event, 'state, 'context>(context : SqlStreamStoreContext, let encodedEvents : EventData[] = events |> Seq.map (encode >> UnionEncoderAdapters.eventDataOfEncodedEvent) |> Array.ofSeq match! context.TrySync log streamName streamToken (events, encodedEvents) compactionPredicate with | GatewaySyncResult.ConflictUnknown -> - return SyncResult.Conflict (load fold state (context.LoadFromToken true streamName log streamToken (tryDecode, compactionPredicate))) + return SyncResult.Conflict (fun ct -> load fold state (context.LoadFromToken true streamName log streamToken (tryDecode, compactionPredicate)) |> Async.startAsTask ct) | GatewaySyncResult.Written token' -> return SyncResult.Written (token', fold state (Seq.ofList events)) } type private Folder<'event, 'state, 'context>(category : Category<'event, 'state, 'context>, fold : 'state -> 'event seq -> 'state, initial : 'state, ?readCache) = - let batched log streamName = category.Load fold initial streamName log - interface ICategory<'event, 'state, string, 'context> with - member _.Load(log, streamName, allowStale) : Async = + let batched log streamName ct = category.Load fold initial streamName log |> Async.startAsTask ct + interface ICategory<'event, 'state, 'context> with + member _.Load(log, _categoryName, _streamId, streamName, allowStale, ct) = task { match readCache with - | None -> batched log streamName - | Some (cache : ICache, prefix : string) -> async { + | None -> return! batched log streamName ct + | Some (cache : ICache, prefix : string) -> match! cache.TryGet(prefix + streamName) with - | None -> return! batched log streamName - | Some tokenAndState when allowStale -> return tokenAndState - | Some (token, state) -> return! category.LoadFromToken fold state streamName token log } - member _.TrySync(log : ILogger, streamName, streamToken, initialState, events : 'event list, context) : Async> = async { - match! category.TrySync(log, fold, streamName, streamToken, initialState, events, context) with - | SyncResult.Conflict resync -> return SyncResult.Conflict resync + | ValueNone -> return! batched log streamName ct + | ValueSome tokenAndState when allowStale -> return tokenAndState + | ValueSome (token, state) -> return! category.LoadFromToken fold state streamName token log } + member _.TrySync(log, _categoryName, _streamId, streamName, context, _init, token, originState, events, _ct) = task { + match! category.TrySync(log, fold, streamName, token, originState, events, context) with + | SyncResult.Conflict resync -> return SyncResult.Conflict resync | SyncResult.Written (token', state') -> return SyncResult.Written (token', state') } /// For SqlStreamStore, caching is less critical than it is for e.g. CosmosDB @@ -496,40 +496,40 @@ type CachingStrategy = /// Semantics are identical to SlidingWindow. | SlidingWindowPrefixed of ICache * window : TimeSpan * prefix : string -type SqlStreamStoreCategory<'event, 'state, 'context> - ( context : SqlStreamStoreContext, codec : FsCodec.IEventCodec<_, _, 'context>, fold, initial, - // Caching can be overkill for EventStore esp considering the degree to which its intrinsic caching is a first class feature - // e.g., A key benefit is that reads of streams more than a few pages long get completed in constant time after the initial load - []?caching, - []?access) = - do match access with - | Some AccessStrategy.LatestKnownEvent when Option.isSome caching -> - "Equinox.SqlStreamStore does not support (and it would make things _less_ efficient even if it did)" - + "mixing AccessStrategy.LatestKnownEvent with Caching at present." - |> invalidOp - | _ -> () - - let inner = Category<'event, 'state, 'context>(context, codec, ?access = access) - let readCacheOption = - match caching with - | None -> None - | Some (CachingStrategy.SlidingWindow (cache, _)) - | Some (CachingStrategy.FixedTimeSpan (cache, _)) -> Some (cache, null) - | Some (CachingStrategy.SlidingWindowPrefixed (cache, _, prefix)) -> Some (cache, prefix) - let folder = Folder<'event, 'state, 'context>(inner, fold, initial, ?readCache = readCacheOption) - let category : ICategory<_, _, _, 'context> = - match caching with - | None -> folder :> _ - | Some (CachingStrategy.SlidingWindow (cache, window)) -> - Caching.applyCacheUpdatesWithSlidingExpiration cache null window folder Token.supersedes - | Some (CachingStrategy.FixedTimeSpan (cache, period)) -> - Caching.applyCacheUpdatesWithFixedTimeSpan cache null period folder Token.supersedes - | Some (CachingStrategy.SlidingWindowPrefixed (cache, window, prefix)) -> - Caching.applyCacheUpdatesWithSlidingExpiration cache prefix window folder Token.supersedes - let resolve streamName = category, FsCodec.StreamName.toString streamName, None - let empty = context.TokenEmpty, initial - let storeCategory = StoreCategory<'event, 'state, FsCodec.StreamName, 'context>(resolve, empty) - member _.Resolve(streamName : FsCodec.StreamName, [] ?context : 'context) = storeCategory.Resolve(streamName, ?context = context) +type SqlStreamStoreCategory<'event, 'state, 'context>(resolveInner, empty) = + inherit Equinox.Category<'event, 'state, 'context>(resolveInner, empty) + new ( context : SqlStreamStoreContext, codec : FsCodec.IEventCodec<_, _, 'context>, fold, initial, + // Caching can be overkill for EventStore esp considering the degree to which its intrinsic caching is a first class feature + // e.g., A key benefit is that reads of streams more than a few pages long get completed in constant time after the initial load + []?caching, + []?access) = + do match access with + | Some AccessStrategy.LatestKnownEvent when Option.isSome caching -> + "Equinox.SqlStreamStore does not support (and it would make things _less_ efficient even if it did)" + + "mixing AccessStrategy.LatestKnownEvent with Caching at present." + |> invalidOp + | _ -> () + + let inner = Category<'event, 'state, 'context>(context, codec, ?access = access) + let readCacheOption = + match caching with + | None -> None + | Some (CachingStrategy.SlidingWindow (cache, _)) + | Some (CachingStrategy.FixedTimeSpan (cache, _)) -> Some (cache, null) + | Some (CachingStrategy.SlidingWindowPrefixed (cache, _, prefix)) -> Some (cache, prefix) + let folder = Folder<'event, 'state, 'context>(inner, fold, initial, ?readCache = readCacheOption) + let category : ICategory<_, _, 'context> = + match caching with + | None -> folder :> _ + | Some (CachingStrategy.SlidingWindow (cache, window)) -> + Caching.applyCacheUpdatesWithSlidingExpiration cache null window folder Token.supersedes + | Some (CachingStrategy.FixedTimeSpan (cache, period)) -> + Caching.applyCacheUpdatesWithFixedTimeSpan cache null period folder Token.supersedes + | Some (CachingStrategy.SlidingWindowPrefixed (cache, window, prefix)) -> + Caching.applyCacheUpdatesWithSlidingExpiration cache prefix window folder Token.supersedes + let resolveInner streamIds = struct (category, FsCodec.StreamName.Internal.ofCategoryAndStreamId streamIds, ValueNone) + let empty = struct (context.TokenEmpty, initial) + SqlStreamStoreCategory(resolveInner, empty) [] type ConnectorBase([]?readRetryPolicy, []?writeRetryPolicy) = diff --git a/src/Equinox/Core.fs b/src/Equinox/Core.fs index 2f688f630..92af09335 100755 --- a/src/Equinox/Core.fs +++ b/src/Equinox/Core.fs @@ -2,27 +2,65 @@ // i.e., if you're seeking to understand the main usage flows of the Equinox library, that's in Decider.fs, not here namespace Equinox.Core +open System.Threading +open System.Threading.Tasks + /// Store-agnostic interface representing interactions a Flow can have with the state of a given event stream. Not intended for direct use by consumer code. type IStream<'event, 'state> = /// Generate a stream token that represents a stream one believes to be empty to use as a Null Object when optimizing out the initial load roundtrip - abstract LoadEmpty : unit -> StreamToken * 'state + abstract LoadEmpty : unit -> struct (StreamToken * 'state) /// Obtain the state from the target stream - abstract Load : log: Serilog.ILogger * allowStale : bool -> Async + abstract Load : allowStale : bool * ct : CancellationToken -> Task /// Given the supplied `token` [and related `originState`], attempt to move to state `state'` by appending the supplied `events` to the underlying stream /// SyncResult.Written: implies the state is now the value represented by the Result's value /// SyncResult.Conflict: implies the `events` were not synced; if desired the consumer can use the included resync workflow in order to retry - abstract TrySync : log: Serilog.ILogger * token: StreamToken * originState: 'state * events: 'event list -> Async> + abstract TrySync : attempt : int * originTokenAndState : struct (StreamToken * 'state) * events : 'event list * CancellationToken -> Task> /// Internal type used to represent the outcome of a TrySync operation and [] SyncResult<'state> = /// The write succeeded (the supplied token and state can be used to efficiently continue the processing if, and only if, desired) - | Written of StreamToken * 'state + | Written of w : struct (StreamToken * 'state) /// The set of changes supplied to TrySync conflict with the present state of the underlying stream based on the configured policy for that store /// The inner is Async as some stores (and/or states) are such that determining the conflicting state (if, and only if, required) needs an extra trip to obtain - | Conflict of Async + | Conflict of (CancellationToken -> Task) /// Store-specific opaque token to be used for synchronization purposes -and [] StreamToken = { value : obj; version : int64; streamBytes : int64 } +and [] StreamToken = { value : obj; version : int64; streamBytes : int64 } + +module internal Impl = + + let query struct (stream, fetch, projection) = async { + let! ct = Async.CancellationToken + let! tokenAndState = Async.AwaitTaskCorrect(fetch stream ct) + return projection tokenAndState } + + let private run (stream : IStream<'e, 's>) + (decide : struct (_ * _) -> CancellationToken -> Task) + (validateResync : int -> unit) + (mapResult : 'r -> struct (StreamToken * 's) -> 'v) + originTokenAndState ct : Task<'v>= + let rec loop attempt tokenAndState : Task<'v> = task { + let! result, events = decide tokenAndState ct + if List.isEmpty events then + return mapResult result tokenAndState + else + match! stream.TrySync(attempt, tokenAndState, events, ct) with + | SyncResult.Written tokenAndState' -> + return mapResult result tokenAndState' + | SyncResult.Conflict resync -> + validateResync attempt + let! tokenAndState = resync ct + return! loop (attempt + 1) tokenAndState } + loop 1 originTokenAndState + + let private transactTask stream (fetch : IStream<'e, 's> -> CancellationToken -> Task) + decide reload mapResult ct : Task<'v> = task { + let! originTokenAndState = fetch stream ct + return! run stream decide reload mapResult originTokenAndState ct } + + let transact (stream, fetch, decide, reload, mapResult) = async { + let! ct = Async.CancellationToken + return! Async.AwaitTaskCorrect(transactTask stream fetch decide reload mapResult ct) } diff --git a/src/Equinox/Decider.fs b/src/Equinox/Decider.fs index 55b638d73..d2fa18306 100755 --- a/src/Equinox/Decider.fs +++ b/src/Equinox/Decider.fs @@ -1,135 +1,110 @@ namespace Equinox -open System.Runtime.InteropServices - -/// Exception yielded by Decider.Transact after `count` attempts have yielded conflicts at the point of syncing with the Store -type MaxResyncsExhaustedException(count) = - inherit exn(sprintf "Concurrency violation; aborting after %i attempts." count) +open System.Threading.Tasks /// Central Application-facing API. Wraps the handling of decision or query flows in a manner that is store agnostic -type Decider<'event, 'state> - ( log, stream : Core.IStream<'event, 'state>, maxAttempts : int, - [] ?createAttemptsExhaustedException : int -> exn, - [] ?resyncPolicy) = - - do if maxAttempts < 1 then raise <| System.ArgumentOutOfRangeException("maxAttempts", maxAttempts, "should be >= 1") - let fetch : LoadOption<'state> option -> (Serilog.ILogger -> Async) = function - | None | Some RequireLoad -> fun log -> stream.Load(log, allowStale = false) - | Some AllowStale -> fun log -> stream.Load(log, allowStale = true) - | Some AssumeEmpty -> fun _log -> async { return stream.LoadEmpty() } - | Some (FromMemento (streamToken, state)) -> fun _log -> async { return (streamToken, state) } - let query maybeOption project = async { - let! tokenAndState = fetch maybeOption log - return project tokenAndState } - let run originTokenAndState decide mapResult = - let resyncRetryPolicy = defaultArg resyncPolicy (fun _log _attemptNumber resyncF -> async { return! resyncF }) - let createDefaultAttemptsExhaustedException attempts : exn = MaxResyncsExhaustedException attempts :> exn - let createMaxAttemptsExhaustedException = defaultArg createAttemptsExhaustedException createDefaultAttemptsExhaustedException - let rec loop (token, state) attempt : Async<'view> = async { - let log = if attempt = 1 then log else log.ForContext("syncAttempt", attempt) - match! decide (token, state) with - | result, [] -> - log.Debug "No events generated" - return mapResult result (token, state) - | result, events -> - match! stream.TrySync (log, token, state, events) with - | Core.SyncResult.Conflict resync -> - if attempt <> maxAttempts then - let! streamState' = resyncRetryPolicy log attempt resync - log.Debug "Resyncing and retrying" - return! loop streamState' (attempt + 1) - else - log.Debug "Max Sync Attempts exceeded" - return raise (createMaxAttemptsExhaustedException attempt) - | Core.SyncResult.Written (token', streamState') -> - return mapResult result (token', streamState') } - loop originTokenAndState 1 - let transact maybeOption decide mapResult = async { - let! originTokenAndState = fetch maybeOption log - return! run originTokenAndState decide mapResult } - let (|Context|) (token : Core.StreamToken, state) = - { new ISyncContext<'state> with - member _.State = state - member _.Version = token.version - member _.StreamEventBytes = match token.streamBytes with -1L -> None | b -> Some b - member _.CreateMemento() = token, state } +type Decider<'event, 'state>(stream : Core.IStream<'event, 'state>) = + + let (|Context|) = SyncContext<'state>.Map /// 1. Invoke the supplied interpret function with the present state to determine whether any write is to occur. /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) - member _.Transact(interpret : 'state -> 'event list, ?option) : Async = - transact option (fun (_token, state) -> async { return (), interpret state }) (fun () _context -> ()) + member _.Transact(interpret : 'state -> 'event list, ?load, ?attempts) : Async = + let inline decide struct (_t : Core.StreamToken, state) _ct = Task.FromResult struct ((), interpret state) + let inline mapRes () struct (_t : Core.StreamToken, _s : 'state) = () + Core.Impl.transact(stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied interpret function with the present state /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Uses render to generate a 'view from the persisted final state - member _.Transact(interpret : 'state -> 'event list, render : 'state -> 'view, ?option) : Async<'view> = - transact option (fun (_token, state) -> async { return (), interpret state }) (fun () (_token, state) -> render state) + member _.Transact(interpret : 'state -> 'event list, render : 'state -> 'view, ?load, ?attempts) : Async<'view> = + let inline decide struct (_token, state) _ct = Task.FromResult struct ((), interpret state) + let inline mapRes () struct (_token, state) = render state + Core.Impl.transact(stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied decide function with the present state, holding the 'result /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Yield result - member _.Transact(decide : 'state -> 'result * 'event list, ?option) : Async<'result> = - transact option (fun (_token, state) -> async { return decide state }) (fun result _context -> result) + member _.Transact(decide : 'state -> 'result * 'event list, ?load, ?attempts) : Async<'result> = + let inline decide struct (_token, state) _ct = let r, e = decide state in Task.FromResult struct (r, e) + let inline mapRes r _ = r + Core.Impl.transact(stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied decide function with the present state, holding the 'result /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Yields a final 'view produced by mapResult from the 'result and/or the final persisted 'state - member _.Transact(decide : 'state -> 'result * 'event list, mapResult : 'result -> 'state -> 'view, ?option) : Async<'view> = - transact option (fun (_token, state) -> async { return decide state }) (fun r (_token, state) -> mapResult r state) + member _.Transact(decide : 'state -> 'result * 'event list, mapResult : 'result -> 'state -> 'view, ?load, ?attempts) : Async<'view> = + let inline decide struct (_token, state) _ct = let r, e = decide state in Task.FromResult struct (r, e) + let inline mapRes r struct (_, s) = mapResult r s + Core.Impl.transact (stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied decide function with the current complete context, holding the 'result /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Yields result - member _.TransactEx(decide : ISyncContext<'state> -> 'result * 'event list, ?option) : Async<'result> = - transact option (fun (Context c) -> async { return decide c }) (fun result _context -> result) + member _.TransactEx(decide : ISyncContext<'state> -> 'result * 'event list, ?load, ?attempts) : Async<'result> = + let inline decide (Context c) _ct = let r, e = decide c in Task.FromResult struct (r, e) + let inline mapRes r _ = r + Core.Impl.transact (stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied decide function with the current complete context, holding the 'result /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Yields a final 'view produced by mapResult from the 'result and/or the final persisted ISyncContext - member _.TransactEx(decide : ISyncContext<'state> -> 'result * 'event list, mapResult : 'result -> ISyncContext<'state> -> 'view, ?option) : Async<'view> = - transact option (fun (Context c) -> async { return decide c }) (fun r (Context c) -> mapResult r c) + member _.TransactEx(decide : ISyncContext<'state> -> 'result * 'event list, mapResult : 'result -> ISyncContext<'state> -> 'view, ?load, ?attempts) : Async<'view> = + let inline decide (Context c) _ct = let r, e = decide c in Task.FromResult struct (r, e) + let rec inline mapRes r (Context c) = mapResult r c + Core.Impl.transact (stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// Project from the folded 'state, but without executing a decision flow as Transact does - member _.Query(render : 'state -> 'view, ?option) : Async<'view> = - query option (fun (_token, state) -> render state) + member _.Query(render : 'state -> 'view, ?load) : Async<'view> = + Core.Impl.query struct (stream, LoadPolicy.Fetch load, fun struct (_token, state) -> render state) /// Project from the stream's complete context, but without executing a decision flow as TransactEx does - member _.QueryEx(render : ISyncContext<'state> -> 'view, ?option) : Async<'view> = - query option (fun (Context c) -> render c) + member _.QueryEx(render : ISyncContext<'state> -> 'view, ?load) : Async<'view> = + Core.Impl.query struct (stream, LoadPolicy.Fetch load, fun (Context c) -> render c) /// 1. Invoke the supplied Async interpret function with the present state /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Uses render to generate a 'view from the persisted final state - member _.TransactAsync(interpret : 'state -> Async<'event list>, render : 'state -> 'view, ?option) : Async<'view> = - transact option (fun (_token, state) -> async { let! es = interpret state in return (), es }) (fun () (_token, state) -> render state) + member _.TransactAsync(interpret : 'state -> Async<'event list>, render : 'state -> 'view, ?load, ?attempts) : Async<'view> = + let inline decide struct (_token, state) _ct = task { let! es = interpret state in return struct ((), es) } + let rec inline mapRes () struct (_token, state) = render state + Core.Impl.transact (stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied Async decide function with the present state, holding the 'result /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Yield result - member _.TransactAsync(decide : 'state -> Async<'result * 'event list>, ?option) : Async<'result> = - transact option (fun (_token, state) -> decide state) (fun result _context -> result) + member _.TransactAsync(decide : 'state -> Async<'result * 'event list>, ?load, ?attempts) : Async<'result> = + let inline decide struct (_token, state) _ct = task { let! r, e = decide state in return struct (r, e) } + let rec inline mapRes r _ = r + Core.Impl.transact (stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied Async decide function with the current complete context, holding the 'result /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Yield result - member _.TransactExAsync(decide : ISyncContext<'state> -> Async<'result * 'event list>, ?option) : Async<'result> = - transact option (fun (Context c) -> decide c) (fun r _c -> r) + member _.TransactExAsync(decide : ISyncContext<'state> -> Async<'result * 'event list>, ?load, ?attempts) : Async<'result> = + let inline decide (Context c) _ct = task { let! r, e = decide c in return struct (r, e) } + let rec inline mapRes r _ = r + Core.Impl.transact (stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) /// 1. Invoke the supplied Async decide function with the current complete context, holding the 'result /// 2. (if events yielded) Attempt to sync the yielded events to the stream. /// (Restarts up to maxAttempts times with updated state per attempt, throwing MaxResyncsExhaustedException on failure of final attempt.) /// 3. Yields a final 'view produced by mapResult from the 'result and/or the final persisted ISyncContext - member _.TransactExAsync(decide : ISyncContext<'state> -> Async<'result * 'event list>, mapResult : 'result -> ISyncContext<'state> -> 'view, ?option) : Async<'view> = - transact option (fun (Context c) -> decide c) (fun r (Context c) -> mapResult r c) + member _.TransactExAsync(decide : ISyncContext<'state> -> Async<'result * 'event list>, mapResult : 'result -> ISyncContext<'state> -> 'view, ?load, ?attempts) : Async<'view> = + let inline decide (Context c) _ct = task { let! r, e = decide c in return struct (r, e) } + let rec inline mapRes r (Context c) = mapResult r c + Core.Impl.transact (stream, LoadPolicy.Fetch load, decide, AttemptsPolicy.Validate attempts, mapRes) + +(* Options to tune loading policy - default is RequireLoad*) /// Store-agnostic Loading Options and [] LoadOption<'state> = @@ -142,7 +117,33 @@ and [] LoadOption<'state> = /// Inhibit load from database based on the fact that the stream is likely not to have been initialized yet, and we will be generating events | AssumeEmpty /// Instead of loading from database, seed the loading process with the supplied memento, obtained via ISyncContext.CreateMemento() - | FromMemento of memento : (Core.StreamToken * 'state) + | FromMemento of memento : struct (Core.StreamToken * 'state) +and internal LoadPolicy() = + static member Fetch<'state, 'event>(x : LoadOption<'state> option) + : Core.IStream<'event, 'state> -> System.Threading.CancellationToken -> Task = + match x with + | None | Some RequireLoad -> fun stream ct -> stream.Load(allowStale = false, ct = ct) + | Some AllowStale -> fun stream ct -> stream.Load(allowStale = true, ct = ct) + | Some AssumeEmpty -> fun stream _ct -> Task.FromResult(stream.LoadEmpty()) + | Some (FromMemento (streamToken, state)) -> fun _stream _ct -> Task.FromResult(streamToken, state) + +(* Retry / Attempts policy used to define policy for resyncing state when there's an Append conflict (default 3 retries) *) + +and [] Attempts = + | Max of count : int + +and internal AttemptsPolicy() = + + static member Validate(opt : Attempts option) = + let maxAttempts = match opt with Some (Attempts.Max n) -> n | None -> 3 + if maxAttempts < 1 then raise <| System.ArgumentOutOfRangeException(nameof opt, maxAttempts, "should be >= 1") + fun attempt -> if attempt = maxAttempts then raise (MaxResyncsExhaustedException attempt) + +/// Exception yielded by Decider.Transact after `count` attempts have yielded conflicts at the point of syncing with the Store +and MaxResyncsExhaustedException(count) = + inherit exn(sprintf "Concurrency violation; aborting after %i attempts." count) + +(* Extended context interface exposed by TransactEx / QueryEx *) /// Exposed by TransactEx / QueryEx, providing access to extended state information for cases where that's required and ISyncContext<'state> = @@ -155,10 +156,19 @@ and ISyncContext<'state> = /// The Storage occupied by the Events written to the underlying stream at the present time. /// Specific stores may vary whether this is available, the basis and preciseness for how it is computed. - abstract member StreamEventBytes : int64 option + abstract member StreamEventBytes : int64 voption /// The present State of the stream within the context of this Flow abstract member State : 'state /// Represents a Checkpoint position on a Stream's timeline; Can be used to manage continuations via LoadOption.FromMemento - abstract member CreateMemento : unit -> Core.StreamToken * 'state + abstract member CreateMemento : unit -> struct (Core.StreamToken * 'state) + +and internal SyncContext<'state> = + + static member Map(struct (token : Core.StreamToken, state : 'state)) = + { new ISyncContext<'state> with + member _.State = state + member _.Version = token.version + member _.StreamEventBytes = match token.streamBytes with -1L -> ValueNone | b -> ValueSome b + member _.CreateMemento() = token, state } diff --git a/src/Equinox/Equinox.fsproj b/src/Equinox/Equinox.fsproj index 40a6dd57a..cb5512b0c 100644 --- a/src/Equinox/Equinox.fsproj +++ b/src/Equinox/Equinox.fsproj @@ -5,15 +5,18 @@ + - + - - + + + contentFiles + diff --git a/tests/Equinox.CosmosStore.Integration/AccessStrategies.fs b/tests/Equinox.CosmosStore.Integration/AccessStrategies.fs index edb5db36b..799a5c752 100644 --- a/tests/Equinox.CosmosStore.Integration/AccessStrategies.fs +++ b/tests/Equinox.CosmosStore.Integration/AccessStrategies.fs @@ -13,7 +13,6 @@ open System [] module WiringHelpers = - let createDecider log stream = Equinox.Decider(log, stream, maxAttempts = 3) let private createCategoryUncached codec initial fold accessStrategy context = let noCachingCacheStrategy = CachingStrategy.NoCaching StoreCategory(context, codec, fold, initial, noCachingCacheStrategy, accessStrategy) @@ -33,7 +32,7 @@ module WiringHelpers = /// This is especially relevant when events are spread between a Tip page and preceding pages as the Tip reading logic is special cased compared to querying module SequenceCheck = - let streamName (id : Guid) = FsCodec.StreamName.create "_SequenceCheck" (id.ToString "N") + let streamName (id : Guid) = struct ("_SequenceCheck", id.ToString "N") module Events = @@ -69,18 +68,15 @@ module SequenceCheck = let decider = resolve instance decider.Transact(decide (value, count), id) - let private create log resolveStream = - let resolve = streamName >> resolveStream >> createDecider log - Service(resolve) + let private create resolve = + Service(streamName >> resolve) module Config = let createUncached log context = - let cat = createCategoryUnoptimizedUncached Events.codec Fold.initial Fold.fold context - create log cat.Resolve + createCategoryUnoptimizedUncached Events.codec Fold.initial Fold.fold context |> Equinox.Decider.resolve log |> create let create log (context, cache) = - let cat = createCategoryUnoptimized Events.codec Fold.initial Fold.fold (context, cache) - create log cat.Resolve + createCategoryUnoptimized Events.codec Fold.initial Fold.fold (context, cache) |> Equinox.Decider.resolve log |> create module Props = diff --git a/tests/Equinox.CosmosStore.Integration/CacheCellTests.fs b/tests/Equinox.CosmosStore.Integration/CacheCellTests.fs index 7aff5e3f3..28f855afc 100644 --- a/tests/Equinox.CosmosStore.Integration/CacheCellTests.fs +++ b/tests/Equinox.CosmosStore.Integration/CacheCellTests.fs @@ -4,16 +4,17 @@ open Equinox.Core open Swensen.Unquote open System open System.Threading +open System.Threading.Tasks open Xunit [] let ``AsyncLazy correctness`` () = async { // ensure that the encapsulated computation fires only once let mutable count = 0 - let cell = AsyncLazy (async { return Interlocked.Increment &count }) - false =! cell.IsValid() - let! accessResult = [|1 .. 100|] |> Array.map (fun _ -> cell.AwaitValue()) |> Async.Parallel - true =! cell.IsValid() + let cell = AsyncLazy(fun () -> task { return Interlocked.Increment &count }) + false =! cell.IsValid(ValueNone) + let! accessResult = [|1 .. 100|] |> Array.map (fun _ -> cell.Await() |> Async.AwaitTask) |> Async.Parallel + true =! cell.IsValid(ValueNone) test <@ accessResult |> Array.forall ((=) 1) @> } @@ -22,16 +23,17 @@ let ``AsyncCacheCell correctness`` () = async { // ensure that the encapsulated computation fires only once and that expiry functions as expected let mutable state = 0 let mutable expectedValue = 1 - let cell = AsyncCacheCell (async { return Interlocked.Increment &state }, fun value -> value <> expectedValue) + let cell = AsyncCacheCell((fun _ct -> task { return Interlocked.Increment &state }), fun value -> value <> expectedValue) + false =! cell.IsValid() - let! accessResult = [|1 .. 100|] |> Array.map (fun _i -> cell.AwaitValue()) |> Async.Parallel + let! accessResult = [|1 .. 100|] |> Array.map (fun _i -> cell.Await CancellationToken.None |> Async.AwaitTask) |> Async.Parallel test <@ accessResult |> Array.forall ((=) 1) @> true =! cell.IsValid() expectedValue <- expectedValue + 1 - let! accessResult = [|1 .. 100|] |> Array.map (fun _i -> cell.AwaitValue()) |> Async.Parallel + let! accessResult = [|1 .. 100|] |> Array.map (fun _i -> cell.Await CancellationToken.None |> Async.AwaitTask) |> Async.Parallel test <@ accessResult |> Array.forall ((=) 2) @> true =! cell.IsValid() } @@ -42,32 +44,32 @@ let ``AsyncCacheCell correctness with throwing`` initiallyThrowing = async { let mutable state = 0 let mutable expectedValue = 1 let mutable throwing = initiallyThrowing - let update = async { + let update ct = task { let r = Interlocked.Increment &state if throwing then - do! Async.Sleep 2000 + do! Task.Delay(2000, ct) invalidOp "fails" return r } - let cell = AsyncCacheCell (update, fun value -> value <> expectedValue) + let cell = AsyncCacheCell(update, fun value -> value <> expectedValue) false =! cell.IsValid() // If the runner is throwing, we want to be sure it doesn't place us in a failed state forever, per the semantics of Lazy // However, we _do_ want to be sure that the function only runs once if initiallyThrowing then - let! accessResult = [|1 .. 10|] |> Array.map (fun _ -> cell.AwaitValue() |> Async.Catch) |> Async.Parallel + let! accessResult = [|1 .. 10|] |> Array.map (fun _ -> cell.Await CancellationToken.None |> Async.AwaitTaskCorrect |> Async.Catch) |> Async.Parallel test <@ accessResult |> Array.forall (function Choice2Of2 (:? InvalidOperationException) -> true | _ -> false) @> throwing <- false false =! cell.IsValid() else - let! r = cell.AwaitValue() + let! r = cell.Await CancellationToken.None |> Async.AwaitTask true =! cell.IsValid() test <@ 1 = r @> expectedValue <- expectedValue + 1 - let! accessResult = [|1 .. 100|] |> Array.map (fun _ -> cell.AwaitValue()) |> Async.Parallel + let! accessResult = [|1 .. 100|] |> Array.map (fun _ -> cell.Await CancellationToken.None |> Async.AwaitTaskCorrect) |> Async.Parallel test <@ accessResult |> Array.forall ((=) 2) @> true =! cell.IsValid() @@ -77,7 +79,7 @@ let ``AsyncCacheCell correctness with throwing`` initiallyThrowing = async { // but make the computation ultimately fail throwing <- true // All share the failure - let! accessResult = [|1 .. 10|] |> Array.map (fun _ -> cell.AwaitValue() |> Async.Catch) |> Async.Parallel + let! accessResult = [|1 .. 10|] |> Array.map (fun _ -> cell.Await CancellationToken.None |> Async.AwaitTaskCorrect |> Async.Catch) |> Async.Parallel test <@ accessResult |> Array.forall (function Choice2Of2 (:? InvalidOperationException) -> true | _ -> false) @> // Restore normality throwing <- false @@ -85,7 +87,7 @@ let ``AsyncCacheCell correctness with throwing`` initiallyThrowing = async { expectedValue <- expectedValue + 1 - let! accessResult = [|1 .. 10|] |> Array.map (fun _ -> cell.AwaitValue()) |> Async.Parallel + let! accessResult = [|1 .. 10|] |> Array.map (fun _ -> cell.Await CancellationToken.None |> Async.AwaitTask) |> Async.Parallel test <@ accessResult |> Array.forall ((=) 4) @> true =! cell.IsValid() } diff --git a/tests/Equinox.CosmosStore.Integration/CosmosFixtures.fs b/tests/Equinox.CosmosStore.Integration/CosmosFixtures.fs index 863746dc5..91493ce14 100644 --- a/tests/Equinox.CosmosStore.Integration/CosmosFixtures.fs +++ b/tests/Equinox.CosmosStore.Integration/CosmosFixtures.fs @@ -58,7 +58,7 @@ type DocStoreCollection() = interface Xunit.ICollectionFixture type StoreContext = DynamoStoreContext -type StoreCategory<'E, 'S> = DynamoStoreCategory<'E, 'S, obj> +type StoreCategory<'E, 'S> = DynamoStoreCategory<'E, 'S, unit> #else [] module Equinox.CosmosStore.Integration.CosmosFixtures @@ -105,7 +105,7 @@ type DocStoreCollection() = do () type StoreContext = CosmosStoreContext -type StoreCategory<'E, 'S> = CosmosStoreCategory<'E, 'S, obj> +type StoreCategory<'E, 'S> = CosmosStoreCategory<'E, 'S, unit> #endif let createPrimaryContextIgnoreMissing client queryMaxItems tipMaxEvents ignoreMissing = diff --git a/tests/Equinox.CosmosStore.Integration/DocumentStoreIntegration.fs b/tests/Equinox.CosmosStore.Integration/DocumentStoreIntegration.fs index 4f79b6e59..641050e75 100644 --- a/tests/Equinox.CosmosStore.Integration/DocumentStoreIntegration.fs +++ b/tests/Equinox.CosmosStore.Integration/DocumentStoreIntegration.fs @@ -22,24 +22,29 @@ module Cart = let codec = Cart.Events.codecJe #endif let createServiceWithoutOptimization log context = - let resolve = StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, AccessStrategy.Unoptimized).Resolve - Cart.create log resolve + StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, AccessStrategy.Unoptimized) + |> Equinox.Decider.resolve log + |> Cart.create /// Trigger looking in Tip (we want those calls to occur, but without leaning on snapshots, which would reduce the paths covered) let createServiceWithEmptyUnfolds log context = let unfArgs = Cart.Fold.isOrigin, fun _ -> Seq.empty - let resolve = StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, AccessStrategy.MultiSnapshot unfArgs).Resolve - Cart.create log resolve + StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, AccessStrategy.MultiSnapshot unfArgs) + |> Equinox.Decider.resolve log + |> Cart.create let createServiceWithSnapshotStrategy log context = - let resolve = StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, AccessStrategy.Snapshot snapshot).Resolve - Cart.create log resolve + StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, AccessStrategy.Snapshot snapshot) + |> Equinox.Decider.resolve log + |> Cart.create let createServiceWithSnapshotStrategyAndCaching log context cache = let sliding20m = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) - let resolve = StoreCategory(context, codec, fold, initial, sliding20m, AccessStrategy.Snapshot snapshot).Resolve - Cart.create log resolve + StoreCategory(context, codec, fold, initial, sliding20m, AccessStrategy.Snapshot snapshot) + |> Equinox.Decider.resolve log + |> Cart.create let createServiceWithRollingState log context = let access = AccessStrategy.RollingState Cart.Fold.snapshot - let resolve = StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, access).Resolve - Cart.create log resolve + StoreCategory(context, codec, fold, initial, CachingStrategy.NoCaching, access) + |> Equinox.Decider.resolve log + |> Cart.create module ContactPreferences = let fold, initial = ContactPreferences.Fold.fold, ContactPreferences.Fold.initial @@ -49,8 +54,9 @@ module ContactPreferences = let codec = ContactPreferences.Events.codecJe #endif let private createServiceWithLatestKnownEvent context log cachingStrategy = - let resolveStream = StoreCategory(context, codec, fold, initial, cachingStrategy, AccessStrategy.LatestKnownEvent).Resolve - ContactPreferences.create log resolveStream + StoreCategory(context, codec, fold, initial, cachingStrategy, AccessStrategy.LatestKnownEvent) + |> Equinox.Decider.resolve log + |> ContactPreferences.create let createServiceWithoutCaching log context = createServiceWithLatestKnownEvent context log CachingStrategy.NoCaching let createServiceWithCaching log context cache = @@ -236,7 +242,7 @@ type Tests(testOutputHelper) = // Needs to share the same context (with inner CosmosClient) for the session token to be threaded through // If we run on an independent context, we won't see (and hence prune) the full set of events let ctx = Core.EventsContext(context, log) - let streamName = ContactPreferences.streamName id |> FsCodec.StreamName.toString + let streamName = ContactPreferences.streamName id |> FsCodec.StreamName.Internal.ofCategoryAndStreamId // Prune all the events let! deleted, deferred, trimmedPos = Core.Events.pruneUntil ctx streamName 14L @@ -404,7 +410,7 @@ type Tests(testOutputHelper) = (* Verify pruning does not affect snapshots, though Tip is re-read in this scenario due to lack of caching *) let ctx = Core.EventsContext(context, log) - let streamName = Cart.streamName cartId |> FsCodec.StreamName.toString + let streamName = Cart.streamName cartId |> FsCodec.StreamName.Internal.ofCategoryAndStreamId // Prune all the events let! deleted, deferred, trimmedPos = Core.Events.pruneUntil ctx streamName 11L test <@ deleted = 12 && deferred = 0 && trimmedPos = 12L @> @@ -465,7 +471,7 @@ type Tests(testOutputHelper) = (* Verify pruning does not affect snapshots, and does not touch the Tip *) let ctx = Core.EventsContext(context, log) - let streamName = Cart.streamName cartId |> FsCodec.StreamName.toString + let streamName = Cart.streamName cartId |> FsCodec.StreamName.Internal.ofCategoryAndStreamId // Prune all the events let! deleted, deferred, trimmedPos = Core.Events.pruneUntil ctx streamName 12L test <@ deleted = 13 && deferred = 0 && trimmedPos = 13L @> diff --git a/tests/Equinox.CosmosStore.Integration/Equinox.CosmosStore.Integration.fsproj b/tests/Equinox.CosmosStore.Integration/Equinox.CosmosStore.Integration.fsproj index 416909925..0ffe2bae5 100644 --- a/tests/Equinox.CosmosStore.Integration/Equinox.CosmosStore.Integration.fsproj +++ b/tests/Equinox.CosmosStore.Integration/Equinox.CosmosStore.Integration.fsproj @@ -6,6 +6,7 @@ + diff --git a/tests/Equinox.CosmosStore.Integration/JsonConverterTests.fs b/tests/Equinox.CosmosStore.Integration/JsonConverterTests.fs index be46bb2d3..1bb3d683b 100644 --- a/tests/Equinox.CosmosStore.Integration/JsonConverterTests.fs +++ b/tests/Equinox.CosmosStore.Integration/JsonConverterTests.fs @@ -28,13 +28,13 @@ type Base64ZipUtf8Tests() = [] let ``serializes, achieving expected compression`` () = - let encoded = eventCodec.Encode(None,A { embed = String('x',5000) }) + let encoded = eventCodec.Encode((), A { embed = String('x',5000) }) let res = ser encoded.EventType (Core.JsonElement.deflate encoded.Data) test <@ res.Contains("\"d\":\"") && res.Length < 138 @> [] let roundtrips compress value = - let encoded = eventCodec.Encode(None, value) + let encoded = eventCodec.Encode((), value) let maybeDeflate = if compress then Core.JsonElement.deflate else id let actualData = maybeDeflate encoded.Data let ser = ser encoded.EventType actualData @@ -42,7 +42,7 @@ type Base64ZipUtf8Tests() = else ser.Contains("\"d\":{") @> let des = System.Text.Json.JsonSerializer.Deserialize(ser) let d = FsCodec.Core.TimelineEvent.Create(-1L, des.c, des.d) - let decoded = eventCodec.TryDecode d |> Option.get + let decoded = eventCodec.TryDecode d |> ValueOption.get test <@ value = decoded @> [] diff --git a/tests/Equinox.EventStore.Integration/StoreIntegration.fs b/tests/Equinox.EventStore.Integration/StoreIntegration.fs index 6b814d6a9..d8a82ace9 100644 --- a/tests/Equinox.EventStore.Integration/StoreIntegration.fs +++ b/tests/Equinox.EventStore.Integration/StoreIntegration.fs @@ -84,27 +84,36 @@ module Cart = let codec = Cart.Events.codec let snapshot = Cart.Fold.isOrigin, Cart.Fold.snapshot let createServiceWithoutOptimization log context = - let cat = Category(context, Cart.Events.codec, fold, initial) - Cart.create log cat.Resolve + Category(context, Cart.Events.codec, fold, initial) |> Equinox.Decider.resolve log |> Cart.create let createServiceWithCompaction log context = - let cat = Category(context, codec, fold, initial, access = AccessStrategy.RollingSnapshots snapshot) - Cart.create log cat.Resolve + Category(context, codec, fold, initial, access = AccessStrategy.RollingSnapshots snapshot) + |> Equinox.Decider.resolve log + |> Cart.create let createServiceWithCaching log context cache = let sliding20m = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) - Cart.create log (Category(context, codec, fold, initial, sliding20m).Resolve) + Category(context, codec, fold, initial, sliding20m) + |> Equinox.Decider.resolve log + |> Cart.create + let createServiceWithCompactionAndCaching log context cache = let sliding20m = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) - Cart.create log (Category(context, codec, fold, initial, sliding20m, AccessStrategy.RollingSnapshots snapshot).Resolve) + Category(context, codec, fold, initial, sliding20m, AccessStrategy.RollingSnapshots snapshot) + |> Equinox.Decider.resolve log + |> Cart.create module ContactPreferences = let fold, initial = ContactPreferences.Fold.fold, ContactPreferences.Fold.initial let codec = ContactPreferences.Events.codec let createServiceWithoutOptimization log connection = let context = createContext connection defaultBatchSize - ContactPreferences.create log (Category(context, codec, fold, initial).Resolve) + Category(context, codec, fold, initial) + |> Equinox.Decider.resolve log + |> ContactPreferences.create + let createService log connection = - let cat = Category(createContext connection 1, codec, fold, initial, access = AccessStrategy.LatestKnownEvent) - ContactPreferences.create log cat.Resolve + Category(createContext connection 1, codec, fold, initial, access = AccessStrategy.LatestKnownEvent) + |> Equinox.Decider.resolve log + |> ContactPreferences.create type Tests(testOutputHelper) = diff --git a/tests/Equinox.MemoryStore.Integration/MemoryStoreIntegration.fs b/tests/Equinox.MemoryStore.Integration/MemoryStoreIntegration.fs index 693895725..97d8a3096 100644 --- a/tests/Equinox.MemoryStore.Integration/MemoryStoreIntegration.fs +++ b/tests/Equinox.MemoryStore.Integration/MemoryStoreIntegration.fs @@ -12,9 +12,10 @@ type AutoDataAttribute() = inherit FsCheck.Xunit.PropertyAttribute(Arbitrary = [|typeof|], MaxTest = 1, QuietOnSuccess = true) let createMemoryStore () = VolatileStore<_>() + let createServiceMemory log store = let cat = MemoryStoreCategory(store, FsCodec.Box.Codec.Create(), Cart.Fold.fold, Cart.Fold.initial) - Cart.create log cat.Resolve + cat |> Equinox.Decider.resolve log |> Cart.create type Tests(testOutputHelper) = let log = TestOutput(testOutputHelper).CreateLogger() @@ -53,9 +54,9 @@ type Tests(testOutputHelper) = verifyFoldedStateReflectsCommand actual } -let createFavoritesServiceMemory log store = +let createFavoritesServiceMemory store log : Favorites.Service = let cat = MemoryStoreCategory(store, FsCodec.Box.Codec.Create(), Favorites.Fold.fold, Favorites.Fold.initial) - Favorites.create log cat.Resolve + cat |> Equinox.Decider.resolve log |> Favorites.create type ChangeFeed(testOutputHelper) = let log = TestOutput(testOutputHelper).CreateLogger() @@ -68,8 +69,8 @@ type ChangeFeed(testOutputHelper) = let xs = events.ToArray() events.Clear() List.ofArray xs - use _ = store.Committed.Subscribe(fun (s, xs) -> events.Add((s, List.ofArray xs))) - let service = createFavoritesServiceMemory log store + use _ = store.Committed.Subscribe(fun struct (c, s, xs) -> events.Add((struct (c, s), List.ofArray xs))) + let service = createFavoritesServiceMemory store log let expectedStream = Favorites.streamName clientId do! service.Favorite(clientId, [sku]) @@ -95,7 +96,7 @@ type Versions(testOutputHelper) = [] let ``Post-Version is computed correctly`` (clientId, sku) = Async.RunSynchronously <| async { let store = createMemoryStore () - let service = createFavoritesServiceMemory log store + let service = createFavoritesServiceMemory store log do! service.Favorite(clientId, [sku]) let! postVersion = service.UnfavoriteWithPostVersion(clientId, sku) diff --git a/tools/Equinox.Tool/Equinox.Tool.fsproj b/tools/Equinox.Tool/Equinox.Tool.fsproj index d95f0825c..785fdc8ed 100644 --- a/tools/Equinox.Tool/Equinox.Tool.fsproj +++ b/tools/Equinox.Tool/Equinox.Tool.fsproj @@ -2,7 +2,6 @@ net6.0 - false Exe Equinox.Tool @@ -31,7 +30,10 @@ - + + + + diff --git a/tools/Equinox.Tool/Program.fs b/tools/Equinox.Tool/Program.fs index 8877b1dd1..4773e5ddf 100644 --- a/tools/Equinox.Tool/Program.fs +++ b/tools/Equinox.Tool/Program.fs @@ -469,11 +469,11 @@ module Dump = let storeLog, storeConfig = a.ConfigureStore(log, createStoreLog) let doU, doE = not (p.Contains EventsOnly), not (p.Contains UnfoldsOnly) let doC, doJ, doS, doT = p.Contains Correlation, not (p.Contains JsonSkip), not (p.Contains Blobs), not (p.Contains TimeRegular) - let cat = Services.StreamResolver(storeConfig) + let store = Services.Store(storeConfig) let initial = List.empty let fold state events = (events, state) ||> Seq.foldBack (fun e l -> e :: l) - let tryDecode (x : FsCodec.ITimelineEvent>) = Some x + let tryDecode (x : FsCodec.ITimelineEvent>) = ValueSome x let idCodec = FsCodec.Codec.Create((fun _ -> failwith "No encoding required"), tryDecode, (fun _ -> failwith "No mapCausation")) let isOriginAndSnapshot = (fun (event : FsCodec.ITimelineEvent<_>) -> not doE && event.IsUnfold), fun _state -> failwith "no snapshot required" let formatUnfolds, formatEvents = @@ -494,8 +494,9 @@ module Dump = else $"(%d{s.Length} chars)" with e -> log.Warning(e, "UTF-8 Parse failure - use --Blobs option to inhibit"); reraise() let readStream (streamName : FsCodec.StreamName) = async { - let stream = cat.Resolve(idCodec, fold, initial, isOriginAndSnapshot) streamName - let! token, events = stream.Load(storeLog, allowStale = false) + let resolve = store.Category(idCodec, fold, initial, isOriginAndSnapshot) |> Equinox.Decider.resolve storeLog + let decider = resolve (FsCodec.StreamName.splitCategoryAndStreamId streamName) + let! streamBytes, events = decider.QueryEx(fun c -> c.StreamEventBytes, c.State) let mutable prevTs = None for x in events |> Seq.filter (fun e -> (e.IsUnfold && doU) || (not e.IsUnfold && doE)) do let ty, render = if x.IsUnfold then "U", render formatUnfolds else "E", render formatEvents @@ -513,7 +514,7 @@ module Dump = x.Index, x.Timestamp, interval, ty, x.EventType, render x.Data, render x.Meta) else log.Information("{i,4}@{t:u}+{d,9} Corr {corr} Cause {cause} {u:l} {e:l} {data:l} {meta:l}", x.Index, x.Timestamp, interval, x.CorrelationId, x.CausationId, ty, x.EventType, render x.Data, render x.Meta) - match token.streamBytes with -1L -> () | x -> log.Information("ISyncContext.StreamEventBytes {kib:n1}KiB", float x / 1024.) } + match streamBytes with ValueNone -> () | ValueSome x -> log.Information("ISyncContext.StreamEventBytes {kib:n1}KiB", float x / 1024.) } resetStats () diff --git a/tools/Equinox.Tools.TestHarness/Equinox.Tools.TestHarness.fsproj b/tools/Equinox.Tools.TestHarness/Equinox.Tools.TestHarness.fsproj index 72ec63d0d..a5a053302 100644 --- a/tools/Equinox.Tools.TestHarness/Equinox.Tools.TestHarness.fsproj +++ b/tools/Equinox.Tools.TestHarness/Equinox.Tools.TestHarness.fsproj @@ -14,10 +14,9 @@ - + - - + diff --git a/tools/Equinox.Tools.TestHarness/Infrastructure.fs b/tools/Equinox.Tools.TestHarness/Infrastructure.fs index d2c724976..dd7edc19e 100644 --- a/tools/Equinox.Tools.TestHarness/Infrastructure.fs +++ b/tools/Equinox.Tools.TestHarness/Infrastructure.fs @@ -55,6 +55,7 @@ type Async with let! result = Async.Choice [|Async.map Some a ; Async.map Some b |] return Option.get result } + static member startAsTask ct computation = Async.StartAsTask(computation, cancellationToken = ct) type StringBuilder with member sb.Appendf fmt = Printf.ksprintf (ignore << sb.Append) fmt diff --git a/tools/Equinox.Tools.TestHarness/LoadTestRunner.fs b/tools/Equinox.Tools.TestHarness/LoadTestRunner.fs index ea913be9b..cbd03d1a1 100644 --- a/tools/Equinox.Tools.TestHarness/LoadTestRunner.fs +++ b/tools/Equinox.Tools.TestHarness/LoadTestRunner.fs @@ -142,7 +142,7 @@ module private LocalLoadTestImpl = return! allocatorLoop (n + 1L) } - let _ = Async.StartAsTask(allocatorLoop 1L, cancellationToken = cts.Token) + let _ = allocatorLoop 1L |> Async.startAsTask cts.Token member _.LeaseCount = int leaseCount.Value member _.AllocationCount = sessions.Count @@ -271,8 +271,7 @@ module private LocalLoadTestImpl = let slot = batchCount.Increment() let batchCount = calculateNextBatchSize (abs slot) targetTestsPerSecond for i = 1 to batchCount do - Async.StartAsTask(singleRunner, cancellationToken = innerCts.Token) - |> ignore + singleRunner |> Async.startAsTask innerCts.Token |> ignore do eventSink LoadTestStarted let d = runOnInterval batchIntervalMilliseconds runSingleBatch