From 5ca1d1f179fab6d10ef384a79b3d17f5384b4b76 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 23 Nov 2018 14:53:59 +0000 Subject: [PATCH] Cosmos core events API (#49), remove rolling snapshots * Reorganize, adding Batch structure * Rework stored procedure * Remove rolling snapshots * Add explicit non-indexed mode --- cli/Equinox.Cli/Program.fs | 89 +- samples/Store/Domain/Cart.fs | 2 +- samples/Store/Domain/ContactPreferences.fs | 4 +- samples/Store/Integration/CartIntegration.fs | 18 +- .../ContactPreferencesIntegration.fs | 14 +- .../Store/Integration/FavoritesIntegration.fs | 6 +- samples/Store/Integration/LogIntegration.fs | 18 +- src/Equinox.Cosmos/Backoff.fs | 105 ++ src/Equinox.Cosmos/Cosmos.fs | 1610 ++++++++++------- src/Equinox.Cosmos/Equinox.Cosmos.fsproj | 1 + .../CosmosCoreIntegration.fs | 270 +++ .../CosmosFixtures.fs | 20 +- .../CosmosFixturesInfrastructure.fs | 71 +- .../CosmosIntegration.fs | 245 +-- .../Equinox.Cosmos.Integration.fsproj | 5 +- ...onverterTests.fs => JsonConverterTests.fs} | 43 +- .../EventStoreIntegration.fs | 2 +- 17 files changed, 1553 insertions(+), 970 deletions(-) create mode 100644 src/Equinox.Cosmos/Backoff.fs create mode 100644 tests/Equinox.Cosmos.Integration/CosmosCoreIntegration.fs rename tests/Equinox.Cosmos.Integration/{VerbatimUtf8JsonConverterTests.fs => JsonConverterTests.fs} (60%) diff --git a/cli/Equinox.Cli/Program.fs b/cli/Equinox.Cli/Program.fs index 58ac59471..9ae1ccde4 100644 --- a/cli/Equinox.Cli/Program.fs +++ b/cli/Equinox.Cli/Program.fs @@ -2,7 +2,7 @@ open Argu open Domain -open Equinox.Cosmos +open Equinox.Cosmos.Builder open Equinox.EventStore open Infrastructure open Serilog @@ -119,7 +119,7 @@ module Cosmos = let connect (log: ILogger) discovery operationTimeout (maxRetryForThrottling, maxRetryWaitTime) = EqxConnector(log=log, requestTimeout=operationTimeout, maxRetryAttemptsOnThrottledRequests=maxRetryForThrottling, maxRetryWaitTimeInSeconds=maxRetryWaitTime) .Connect("equinox-cli", discovery) - let createGateway connection batchSize = EqxGateway(connection, EqxBatchingPolicy(maxBatchSize = batchSize)) + let createGateway connection maxItems = EqxGateway(connection, EqxBatchingPolicy(defaultMaxItems=maxItems)) [] type Store = @@ -147,22 +147,19 @@ module Test = else None let eqxCache = if targs.Contains Cached then - let c = Equinox.Cosmos.Caching.Cache("Cli", sizeMb = 50) - Equinox.Cosmos.CachingStrategy.SlidingWindow (c, TimeSpan.FromMinutes 20.) |> Some + let c = Equinox.Cosmos.Builder.Caching.Cache("Cli", sizeMb = 50) + Equinox.Cosmos.Builder.CachingStrategy.SlidingWindow (c, TimeSpan.FromMinutes 20.) |> Some else None let resolveStream = match store with | Store.Mem store -> Equinox.MemoryStore.MemoryStreamBuilder(store, fold, initial).Create | Store.Es gateway -> - GesStreamBuilder(gateway, codec, fold, initial, Equinox.EventStore.AccessStrategy.RollingSnapshots snapshot, ?caching = esCache).Create(streamName) + GesStreamBuilder(gateway, codec, fold, initial, Equinox.EventStore.AccessStrategy.RollingSnapshots snapshot, ?caching = esCache).Create | Store.Cosmos (gateway, databaseId, connectionId) -> - if targs.Contains Indexed then - EqxStreamBuilder(gateway, codec, fold, initial, Equinox.Cosmos.AccessStrategy.IndexedSearch index, ?caching = cache) - .Create(databaseId, connectionId, streamName) - else - EqxStreamBuilder(gateway, codec, fold, initial, Equinox.Cosmos.AccessStrategy.RollingSnapshots snapshot, ?caching = cache) - .Create(databaseId, connectionId, streamName) + let store = EqxStore(gateway, EqxCollections(databaseId, connectionId)) + if targs.Contains Indexed then EqxStreamBuilder(store, codec, fold, initial, AccessStrategy.Projection snapshot, ?caching = eqxCache).Create + else EqxStreamBuilder(store, codec, fold, initial, ?access=None, ?caching = eqxCache).Create Backend.Favorites.Service(log, resolveStream) let runFavoriteTest (service : Backend.Favorites.Service) clientId = async { let sku = Guid.NewGuid() |> SkuId @@ -172,18 +169,18 @@ module Test = [] module SerilogHelpers = - let (|CosmosReadRu|CosmosWriteRu|CosmosSliceRu|) (evt : Equinox.Cosmos.Log.Event) = + let inline (|Stats|) ({ interval = i; ru = ru }: Equinox.Cosmos.Log.Measurement) = ru, let e = i.Elapsed in int64 e.TotalMilliseconds + let (|CosmosReadRu|CosmosWriteRu|CosmosResyncRu|CosmosSliceRu|) (evt : Equinox.Cosmos.Log.Event) = match evt with - | Equinox.Cosmos.Log.Index { ru = ru } - | Equinox.Cosmos.Log.IndexNotFound { ru = ru } - | Equinox.Cosmos.Log.IndexNotModified { ru = ru } - | Equinox.Cosmos.Log.Batch (Equinox.Cosmos.Direction.Forward,_, { ru = ru }) - | Equinox.Cosmos.Log.Batch (Equinox.Cosmos.Direction.Backward,_, { ru = ru }) -> CosmosReadRu ru - | Equinox.Cosmos.Log.WriteSuccess {ru = ru } - | Equinox.Cosmos.Log.WriteConflict {ru = ru } -> CosmosWriteRu ru + | Equinox.Cosmos.Log.Index (Stats s) + | Equinox.Cosmos.Log.IndexNotFound (Stats s) + | Equinox.Cosmos.Log.IndexNotModified (Stats s) + | Equinox.Cosmos.Log.Batch (_,_, (Stats s)) -> CosmosReadRu s + | Equinox.Cosmos.Log.WriteSuccess (Stats s) + | Equinox.Cosmos.Log.WriteConflict (Stats s) -> CosmosWriteRu s + | Equinox.Cosmos.Log.WriteResync (Stats s) -> CosmosResyncRu s // slices are rolled up into batches so be sure not to double-count - | Equinox.Cosmos.Log.Slice (Equinox.Cosmos.Direction.Forward,{ ru = ru }) - | Equinox.Cosmos.Log.Slice (Equinox.Cosmos.Direction.Backward,{ ru = ru }) -> CosmosSliceRu ru + | Equinox.Cosmos.Log.Slice (_,{ ru = ru }) -> CosmosSliceRu ru let (|SerilogScalar|_|) : Serilog.Events.LogEventPropertyValue -> obj option = function | (:? ScalarValue as x) -> Some x.Value | _ -> None @@ -191,15 +188,22 @@ module SerilogHelpers = match logEvent.Properties.TryGetValue("cosmosEvt") with | true, SerilogScalar (:? Equinox.Cosmos.Log.Event as e) -> Some e | _ -> None + type RuCounter = + { mutable rux100: int64; mutable count: int64; mutable ms: int64 } + static member Create() = { rux100 = 0L; count = 0L; ms = 0L } + member __.Ingest (ru, ms) = + Interlocked.Increment(&__.count) |> ignore + Interlocked.Add(&__.rux100, int64 (ru*100.)) |> ignore + Interlocked.Add(&__.ms, ms) |> ignore type RuCounterSink() = - static let mutable readX10 = 0L - static let mutable writeX10 = 0L - static member Read = readX10 / 10L - static member Write = writeX10 / 10L + static member val Read = RuCounter.Create() + static member val Write = RuCounter.Create() + static member val Resync = RuCounter.Create() interface Serilog.Core.ILogEventSink with member __.Emit logEvent = logEvent |> function - | CosmosMetric (CosmosReadRu ru) -> Interlocked.Add(&readX10, int64 (ru*10.)) |> ignore - | CosmosMetric (CosmosWriteRu ru) -> Interlocked.Add(&writeX10, int64 (ru*10.)) |> ignore + | CosmosMetric (CosmosReadRu stats) -> RuCounterSink.Read.Ingest stats + | CosmosMetric (CosmosWriteRu stats) -> RuCounterSink.Write.Ingest stats + | CosmosMetric (CosmosResyncRu stats) -> RuCounterSink.Resync.Ingest stats | _ -> () let createStoreLog verbose verboseConsole maybeSeqEndpoint = @@ -260,7 +264,7 @@ let main argv = let resultFile = createResultLog report for r in results do resultFile.Information("Aggregate: {aggregate}", r) - log.Information("Run completed; Current memory allocation: {bytes:n0}", GC.GetTotalMemory(true)) + log.Information("Run completed; Current memory allocation: {bytes:n2}MB", (GC.GetTotalMemory(true) |> float) / 1024./1024.) 0 match args.GetSubCommand() with @@ -309,15 +313,34 @@ let main argv = match sargs.TryGetSubCommand() with | Some (Provision args) -> let rus = args.GetResult(Rus) - log.Information("Configuring CosmosDb with Request Units (RU) Provision: {rus:n0}", rus) - Equinox.Cosmos.Initialization.initialize conn.Client dbName collName rus |> Async.RunSynchronously + log.Information("Configuring CosmosDb Collection with Throughput Provision: {rus:n0} RU/s", rus) + Equinox.Cosmos.Sync.Initialization.initialize log conn.Client dbName collName rus |> Async.RunSynchronously 0 | Some (Run targs) -> let conn = Store.Cosmos (Cosmos.createGateway conn defaultBatchSize, dbName, collName) let res = runTest log conn targs - let read, write = RuCounterSink.Read, RuCounterSink.Write - let total = read+write - log.Information("Total Request Charges sustained in test: {totalRus:n0} (R:{readRus:n0}, W:{writeRus:n0})", total, read, write) + let stats = + [ "Read", RuCounterSink.Read + "Write", RuCounterSink.Write + "Resync", RuCounterSink.Resync ] + let mutable totalCount, totalRc, totalMs = 0L, 0., 0L + let logActivity name count rc lat = + log.Information("{name}: {count:n0} requests costing {ru:n0} RU (average: {avg:n2}); Average latency: {lat:n0}ms", + name, count, rc, (if count = 0L then Double.NaN else rc/float count), (if count = 0L then Double.NaN else float lat/float count)) + for name, stat in stats do + let ru = float stat.rux100 / 100. + totalCount <- totalCount + stat.count + totalRc <- totalRc + ru + totalMs <- totalMs + stat.ms + logActivity name stat.count ru stat.ms + logActivity "TOTAL" totalCount totalRc totalMs + let measures : (string * (TimeSpan -> float)) list = + [ "s", fun x -> x.TotalSeconds + "m", fun x -> x.TotalMinutes + "h", fun x -> x.TotalHours ] + let logPeriodicRate name count ru = log.Information("rp{name} {count:n0} = ~{ru:n0} RU", name, count, ru) + let duration = targs.GetResult(DurationM,1.) |> TimeSpan.FromMinutes + for uom, f in measures do let d = f duration in if d <> 0. then logPeriodicRate uom (float totalCount/d |> int64) (totalRc/d) res | _ -> failwith "init or run is required" | _ -> failwith "ERROR: please specify memory, es or cosmos Store" diff --git a/samples/Store/Domain/Cart.fs b/samples/Store/Domain/Cart.fs index 5a82ff355..e866bf6e5 100644 --- a/samples/Store/Domain/Cart.fs +++ b/samples/Store/Domain/Cart.fs @@ -29,7 +29,7 @@ module Folds = let toSnapshot (s: State) : Events.Compaction.State = { items = [| for i in s.items -> { skuId = i.skuId; quantity = i.quantity; returnsWaived = i.returnsWaived } |] } let ofCompacted (s: Events.Compaction.State) : State = - { items = [ for i in s.items -> { skuId = i.skuId; quantity = i.quantity; returnsWaived = i.returnsWaived } ] } + { items = if s.items = null then [] else [ for i in s.items -> { skuId = i.skuId; quantity = i.quantity; returnsWaived = i.returnsWaived } ] } let initial = { items = [] } let evolve (state : State) event = let updateItems f = { state with items = f state.items } diff --git a/samples/Store/Domain/ContactPreferences.fs b/samples/Store/Domain/ContactPreferences.fs index 45ce4acd0..88cf9ded7 100644 --- a/samples/Store/Domain/ContactPreferences.fs +++ b/samples/Store/Domain/ContactPreferences.fs @@ -7,9 +7,11 @@ module Events = type Preferences = { manyPromotions : bool; littlePromotions : bool; productReview : bool; quickSurveys : bool } type Value = { email : string; preferences : Preferences } + let [] EventTypeName = "contactPreferencesChanged" type Event = - | []Updated of Value + | []Updated of Value interface TypeShape.UnionContract.IUnionContract + let eventTypeNames = System.Collections.Generic.HashSet([EventTypeName]) module Folds = type State = Events.Preferences diff --git a/samples/Store/Integration/CartIntegration.fs b/samples/Store/Integration/CartIntegration.fs index 79adde467..80f088804 100644 --- a/samples/Store/Integration/CartIntegration.fs +++ b/samples/Store/Integration/CartIntegration.fs @@ -1,6 +1,6 @@ module Samples.Store.Integration.CartIntegration -open Equinox.Cosmos +open Equinox.Cosmos.Builder open Equinox.Cosmos.Integration open Equinox.EventStore open Equinox.MemoryStore @@ -22,10 +22,10 @@ let resolveGesStreamWithRollingSnapshots gateway = let resolveGesStreamWithoutCustomAccessStrategy gateway = GesStreamBuilder(gateway, codec, fold, initial).Create -let resolveEqxStreamWithCompactionEventType gateway (StreamArgs args) = - EqxStreamBuilder(gateway, codec, fold, initial, Equinox.Cosmos.AccessStrategy.RollingSnapshots compact).Create(args) -let resolveEqxStreamWithoutCompactionSemantics gateway (StreamArgs args) = - EqxStreamBuilder(gateway, codec, fold, initial).Create(args) +let resolveEqxStreamWithProjection gateway = + EqxStreamBuilder(gateway, codec, fold, initial, AccessStrategy.Projection snapshot).Create +let resolveEqxStreamWithoutCustomAccessStrategy gateway = + EqxStreamBuilder(gateway, codec, fold, initial).Create let addAndThenRemoveItemsManyTimesExceptTheLastOne context cartId skuId (service: Backend.Cart.Service) count = service.FlowAsync(cartId, fun _ctx execute -> @@ -71,13 +71,13 @@ type Tests(testOutputHelper) = } [] - let ``Can roundtrip against Cosmos, correctly folding the events without compaction semantics`` args = Async.RunSynchronously <| async { - let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxGateway resolveEqxStreamWithoutCompactionSemantics + let ``Can roundtrip against Cosmos, correctly folding the events without custom access strategy`` args = Async.RunSynchronously <| async { + let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxStore resolveEqxStreamWithoutCustomAccessStrategy do! act service args } [] - let ``Can roundtrip against Cosmos, correctly folding the events with compaction`` args = Async.RunSynchronously <| async { - let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxGateway resolveEqxStreamWithCompactionEventType + let ``Can roundtrip against Cosmos, correctly folding the events with With Projection`` args = Async.RunSynchronously <| async { + let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxStore resolveEqxStreamWithProjection do! act service args } \ No newline at end of file diff --git a/samples/Store/Integration/ContactPreferencesIntegration.fs b/samples/Store/Integration/ContactPreferencesIntegration.fs index 03636bad7..3f6777a3e 100644 --- a/samples/Store/Integration/ContactPreferencesIntegration.fs +++ b/samples/Store/Integration/ContactPreferencesIntegration.fs @@ -1,6 +1,6 @@ module Samples.Store.Integration.ContactPreferencesIntegration -open Equinox.Cosmos +open Equinox.Cosmos.Builder open Equinox.Cosmos.Integration open Equinox.EventStore open Equinox.MemoryStore @@ -21,10 +21,10 @@ let resolveStreamGesWithOptimizedStorageSemantics gateway = let resolveStreamGesWithoutAccessStrategy gateway = GesStreamBuilder(gateway defaultBatchSize, codec, fold, initial).Create -let resolveStreamEqxWithCompactionSemantics gateway (StreamArgs args) = - EqxStreamBuilder(gateway 1, codec, fold, initial, Equinox.Cosmos.AccessStrategy.EventsAreState).Create(args) -let resolveStreamEqxWithoutCompactionSemantics gateway (StreamArgs args) = - EqxStreamBuilder(gateway defaultBatchSize, codec, fold, initial).Create(args) +let resolveStreamEqxWithCompactionSemantics gateway = + EqxStreamBuilder(gateway 1, codec, fold, initial, AccessStrategy.AnyKnownEventType Domain.ContactPreferences.Events.eventTypeNames).Create +let resolveStreamEqxWithoutCompactionSemantics gateway = + EqxStreamBuilder(gateway defaultBatchSize, codec, fold, initial).Create type Tests(testOutputHelper) = let testOutput = TestOutputAdapter testOutputHelper @@ -63,12 +63,12 @@ type Tests(testOutputHelper) = [] let ``Can roundtrip against Cosmos, correctly folding the events with normal semantics`` args = Async.RunSynchronously <| async { - let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxGateway resolveStreamEqxWithoutCompactionSemantics + let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxStore resolveStreamEqxWithoutCompactionSemantics do! act service args } [] let ``Can roundtrip against Cosmos, correctly folding the events with compaction semantics`` args = Async.RunSynchronously <| async { - let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxGateway resolveStreamEqxWithCompactionSemantics + let! service = arrange connectToSpecifiedCosmosOrSimulator createEqxStore resolveStreamEqxWithCompactionSemantics do! act service args } \ No newline at end of file diff --git a/samples/Store/Integration/FavoritesIntegration.fs b/samples/Store/Integration/FavoritesIntegration.fs index 827ceb540..00e69d062 100644 --- a/samples/Store/Integration/FavoritesIntegration.fs +++ b/samples/Store/Integration/FavoritesIntegration.fs @@ -1,6 +1,6 @@ module Samples.Store.Integration.FavoritesIntegration -open Equinox.Cosmos +open Equinox.Cosmos.Builder open Equinox.Cosmos.Integration open Equinox.EventStore open Equinox.MemoryStore @@ -21,7 +21,7 @@ let createServiceGes gateway log = Backend.Favorites.Service(log, resolveStream) let createServiceEqx gateway log = - let resolveStream (StreamArgs args) = EqxStreamBuilder(gateway, codec, fold, initial, Equinox.Cosmos.AccessStrategy.RollingSnapshots compact).Create(args) + let resolveStream = EqxStreamBuilder(gateway, codec, fold, initial, AccessStrategy.Projection compact).Create Backend.Favorites.Service(log, resolveStream) type Tests(testOutputHelper) = @@ -58,7 +58,7 @@ type Tests(testOutputHelper) = let ``Can roundtrip against Cosmos, correctly folding the events`` args = Async.RunSynchronously <| async { let log = createLog () let! conn = connectToSpecifiedCosmosOrSimulator log - let gateway = createEqxGateway conn defaultBatchSize + let gateway = createEqxStore conn defaultBatchSize let service = createServiceEqx gateway log do! act service args } \ No newline at end of file diff --git a/samples/Store/Integration/LogIntegration.fs b/samples/Store/Integration/LogIntegration.fs index 06a1e10a0..832172573 100644 --- a/samples/Store/Integration/LogIntegration.fs +++ b/samples/Store/Integration/LogIntegration.fs @@ -31,7 +31,8 @@ module EquinoxCosmosInterop = let action, metric, batches, ru = match evt with | Log.WriteSuccess m -> "EqxAppendToStreamAsync", m, None, m.ru - | Log.WriteConflict m -> "EqxAppendToStreamAsync", m, None, m.ru + | Log.WriteConflict m -> "EqxAppendToStreamConflictAsync", m, None, m.ru + | Log.WriteResync m -> "EqxAppendToStreamResyncAsync", m, None, m.ru | Log.Slice (Direction.Forward,m) -> "EqxReadStreamEventsForwardAsync", m, None, m.ru | Log.Slice (Direction.Backward,m) -> "EqxReadStreamEventsBackwardAsync", m, None, m.ru | Log.Batch (Direction.Forward,c,m) -> "EqxLoadF", m, Some c, m.ru @@ -117,13 +118,14 @@ type Tests() = } [] - let ``Can roundtrip against Cosmos, hooking, extracting and substituting metrics in the logging information`` context cartId skuId = Async.RunSynchronously <| async { - let buffer = ResizeArray() + let ``Can roundtrip against Cosmos, hooking, extracting and substituting metrics in the logging information`` context skuId = Async.RunSynchronously <| async { let batchSize = defaultBatchSize - let (log,capture) = createLoggerWithMetricsExtraction buffer.Add + let buffer = ConcurrentQueue() + let log = createLoggerWithMetricsExtraction buffer.Enqueue let! conn = connectToSpecifiedCosmosOrSimulator log - let gateway = createEqxGateway conn batchSize - let service = Backend.Cart.Service(log, CartIntegration.resolveEqxStreamWithCompactionEventType gateway) - let itemCount, cartId = batchSize / 2 + 1, cartId () - do! act buffer capture service itemCount context cartId skuId "ReadStreamEventsBackwardAsync-Duration" + let gateway = createEqxStore conn batchSize + let service = Backend.Cart.Service(log, CartIntegration.resolveEqxStreamWithProjection gateway) + let itemCount = batchSize / 2 + 1 + let cartId = Guid.NewGuid() |> CartId + do! act buffer service itemCount context cartId skuId "Eqx Index " // one is a 404, one is a 200 } \ No newline at end of file diff --git a/src/Equinox.Cosmos/Backoff.fs b/src/Equinox.Cosmos/Backoff.fs new file mode 100644 index 000000000..c3d5d1a88 --- /dev/null +++ b/src/Equinox.Cosmos/Backoff.fs @@ -0,0 +1,105 @@ +namespace Equinox.Cosmos + +// NB this is a copy of the one in Backend - there is also one in Equinox/Infrastrcture.fs which this will be merged into + +open System + +/// Given a value, creates a function with one ignored argument which returns the value. + +/// A backoff strategy. +/// Accepts the attempt number and returns an interval in milliseconds to wait. +/// If None then backoff should stop. +type Backoff = int -> int option + +/// Operations on back off strategies represented as functions (int -> int option) +/// which take an attempt number and produce an interval. +module Backoff = + + let inline konst x _ = x + let private checkOverflow x = + if x = System.Int32.MinValue then 2000000000 + else x + + /// Stops immediately. + let never : Backoff = konst None + + /// Always returns a fixed interval. + let linear i : Backoff = konst (Some i) + + /// Modifies the interval. + let bind (f:int -> int option) (b:Backoff) = + fun i -> + match b i with + | Some x -> f x + | None -> None + + /// Modifies the interval. + let map (f:int -> int) (b:Backoff) : Backoff = + fun i -> + match b i with + | Some x -> f x |> checkOverflow |> Some + | None -> None + + /// Bounds the interval. + let bound mx = map (min mx) + + /// Creates a back-off strategy which increases the interval exponentially. + let exp (initialIntervalMs:int) (multiplier:float) : Backoff = + fun i -> (float initialIntervalMs) * (pown multiplier i) |> int |> checkOverflow |> Some + + /// Randomizes the output produced by a back-off strategy: + /// randomizedInterval = retryInterval * (random in range [1 - randomizationFactor, 1 + randomizationFactor]) + let rand (randomizationFactor:float) = + let rand = new System.Random() + let maxRand,minRand = (1.0 + randomizationFactor), (1.0 - randomizationFactor) + map (fun x -> (float x) * (rand.NextDouble() * (maxRand - minRand) + minRand) |> int) + + /// Uses a fibonacci sequence to genereate timeout intervals starting from the specified initial interval. + let fib (initialIntervalMs:int) : Backoff = + let rec fib n = + if n < 2 then initialIntervalMs + else fib (n - 1) + fib (n - 2) + fib >> checkOverflow >> Some + + /// Creates a stateful back-off strategy which keeps track of the number of attempts, + /// and a reset function which resets attempts to zero. + let keepCount (b:Backoff) : (unit -> int option) * (unit -> unit) = + let i = ref -1 + (fun () -> System.Threading.Interlocked.Increment i |> b), + (fun () -> i := -1) + + /// Bounds a backoff strategy to a specified maximum number of attempts. + let maxAttempts (max:int) (b:Backoff) : Backoff = + fun n -> if n > max then None else b n + + + // ------------------------------------------------------------------------------------------------------------------------ + // defaults + + /// 500ms + let [] DefaultInitialIntervalMs = 500 + + /// 60000ms + let [] DefaultMaxIntervalMs = 60000 + + /// 0.5 + let [] DefaultRandomizationFactor = 0.5 + + /// 1.5 + let [] DefaultMultiplier = 1.5 + + /// The default exponential and randomized back-off strategy with a provided initial interval. + /// DefaultMaxIntervalMs = 60,000 + /// DefaultRandomizationFactor = 0.5 + /// DefaultMultiplier = 1.5 + let DefaultExponentialBoundedRandomizedOf initialInternal = + exp initialInternal DefaultMultiplier + |> rand DefaultRandomizationFactor + |> bound DefaultMaxIntervalMs + + /// The default exponential and randomized back-off strategy. + /// DefaultInitialIntervalMs = 500 + /// DefaultMaxIntervalMs = 60,000 + /// DefaultRandomizationFactor = 0.5 + /// DefaultMultiplier = 1.5 + let DefaultExponentialBoundedRandomized = DefaultExponentialBoundedRandomizedOf DefaultInitialIntervalMs \ No newline at end of file diff --git a/src/Equinox.Cosmos/Cosmos.fs b/src/Equinox.Cosmos/Cosmos.fs index 8e7700306..ae5929741 100644 --- a/src/Equinox.Cosmos/Cosmos.fs +++ b/src/Equinox.Cosmos/Cosmos.fs @@ -1,17 +1,310 @@ -namespace Equinox.Cosmos +namespace Equinox.Cosmos.Internal.Json + +open Newtonsoft.Json.Linq +open Newtonsoft.Json + +/// Manages injecting prepared json into the data being submitted to DocDb as-is, on the basis we can trust it to be valid json as DocDb will need it to be +type VerbatimUtf8JsonConverter() = + inherit JsonConverter() + + override __.ReadJson(reader, _, _, _) = + let token = JToken.Load(reader) + if token.Type = JTokenType.Object then token.ToString() |> System.Text.Encoding.UTF8.GetBytes |> box + else Array.empty |> box + + override __.CanConvert(objectType) = + typeof.Equals(objectType) + + override __.WriteJson(writer, value, serializer) = + let array = value :?> byte[] + if array = null || Array.length array = 0 then serializer.Serialize(writer, null) + else writer.WriteRawValue(System.Text.Encoding.UTF8.GetString(array)) + +open System.IO +open System.IO.Compression + +/// Manages zipping of the UTF-8 json bytes to make the index record minimal from the perspective of the writer stored proc +/// Only applied to snapshots in the Index +type Base64ZipUtf8JsonConverter() = + inherit JsonConverter() + let pickle (input : byte[]) : string = + if input = null then null else + + use output = new MemoryStream() + use compressor = new DeflateStream(output, CompressionLevel.Optimal) + compressor.Write(input,0,input.Length) + compressor.Close() + System.Convert.ToBase64String(output.ToArray()) + let unpickle str : byte[] = + if str = null then null else + + let compressedBytes = System.Convert.FromBase64String str + use input = new MemoryStream(compressedBytes) + use decompressor = new DeflateStream(input, CompressionMode.Decompress) + use output = new MemoryStream() + decompressor.CopyTo(output) + output.ToArray() + + override __.CanConvert(objectType) = + typeof.Equals(objectType) + override __.ReadJson(reader, _, _, serializer) = + //( if reader.TokenType = JsonToken.Null then null else + serializer.Deserialize(reader, typedefof) :?> string |> unpickle |> box + override __.WriteJson(writer, value, serializer) = + let pickled = value |> unbox |> pickle + serializer.Serialize(writer, pickled) + +namespace Equinox.Cosmos.Events + +/// Common form for either a raw Event or a Projection +type IEvent = + /// The Event Type, used to drive deserialization + abstract member EventType : string + /// Event body, as UTF-8 encoded json ready to be injected into the Json being rendered for DocDb + abstract member Data : byte[] + /// Optional metadata (null, or same as d, not written if missing) + abstract member Meta : byte[] + +/// Represents an Event or Projection and its relative position in the event sequence +type IOrderedEvent = + inherit IEvent + /// The index into the event sequence of this event + abstract member Index : int64 + /// Indicates whether this is a primary event or a projection based on the events <= up to `Index` + abstract member IsProjection: bool + +/// Position and Etag to which an operation is relative +type [] Position = { index: int64; etag: string option } with + /// If we have strong reason to suspect a stream is empty, we won't have an etag (and Writer Stored Procedure special cases this) + static member internal FromKnownEmpty = Position.FromI 0L + /// NB very inefficient compared to FromDocument or using one already returned to you + static member internal FromI(i: int64) = { index = i; etag = None } + /// Just Do It mode + static member internal FromAppendAtEnd = Position.FromI -1L // sic - needs to yield -1 + /// NB very inefficient compared to FromDocument or using one already returned to you + static member internal FromMaxIndex(xs: IOrderedEvent[]) = + if Array.isEmpty xs then Position.FromKnownEmpty + else Position.FromI (1L + Seq.max (seq { for x in xs -> x.Index })) + +namespace Equinox.Cosmos.Store + +open Equinox.Cosmos.Events +open Newtonsoft.Json + +/// A 'normal' (frozen, not Pending) Batch of Events, without any Projections +type [] + Event = + { /// DocDb-mandated Partition Key, must be maintained within the document + /// Not actually required if running in single partition mode, but for simplicity, we always write it + p: string // "{streamName}" + + /// DocDb-mandated unique row key; needs to be unique within any partition it is maintained; must be string + /// At the present time, one can't perform an ORDER BY on this field, hence we also have i shadowing it + /// NB WipBatch uses a well known value here while it's actively 'open' + id: string // "{index}" + + /// When we read, we need to capture the value so we can retain it for caching purposes + /// NB this is not relevant to fill in when we pass it to the writing stored procedure + /// as it will do: 1. read 2. merge 3. write merged version contingent on the _etag not having changed + [] + _etag: string + + /// Same as `id`; necessitated by fact that it's not presently possible to do an ORDER BY on the row key + i: int64 // {index} + + /// Creation date (as opposed to system-defined _lastUpdated which is touched by triggers, replication etc.) + c: System.DateTimeOffset // ISO 8601 + + /// The Event Type, used to drive deserialization + t: string // required + + /// Event body, as UTF-8 encoded json ready to be injected into the Json being rendered for DocDb + [)>] + d: byte[] // required + + /// Optional metadata, as UTF-8 encoded json, ready to emit directly (null, not written if missing) + [)>] + [] + m: byte[] } // optional + /// Unless running in single partion mode (which would restrict us to 10GB per collection) + /// we need to nominate a partition key that will be in every document + static member PartitionKeyField = "p" + /// As one cannot sort by the implicit `id` field, we have an indexed `i` field for sort and range query use + static member IndexedFields = [Event.PartitionKeyField; "i"] + /// If we encounter a -1 doc, we're interested in its etag so we can re-read for one RU + member x.TryToPosition() = + if x.id <> WipBatch.WellKnownDocumentId then None + else Some { index = (let ``x.e.LongLength`` = 1L in x.i+``x.e.LongLength``); etag = match x._etag with null -> None | x -> Some x } + +/// The Special 'Pending' Batch Format +/// NB this Type does double duty as +/// a) transport for when we read it +/// b) a way of encoding a batch that the stored procedure will write in to the actual document +/// The stored representation has the following differences vs a 'normal' (frozen/completed) Batch +/// a) `id` and `i` = `-1` as WIP document currently always is +/// b) events are retained as in an `e` array, not top level fields +/// c) contains projections (`c`) +and [] + WipBatch = + { /// Partition key, as per Batch + p: string // "{streamName}" + /// Document Id within partition, as per Batch + id: string // "{-1}" - Well known IdConstant used while this remains the pending batch + + /// When we read, we need to capture the value so we can retain it for caching purposes + /// NB this is not relevant to fill in when we pass it to the writing stored procedure + /// as it will do: 1. read 2. merge 3. write merged version contingent on the _etag not having changed + [] + _etag: string + + /// base 'i' value for the Events held herein + _i: int64 + + /// Events + e: BatchEvent[] + + /// Projections + c: Projection[] } + /// arguably this should be a high nember to reflect fact it is the freshest ? + static member WellKnownDocumentId = "-1" + /// Create Position from [Wip]Batch record context (facilitating 1 RU reads) + member x.ToPosition() = { index = x._i+x.e.LongLength; etag = match x._etag with null -> None | x -> Some x } +/// A single event from the array held in a batch +and [] + BatchEvent = + { /// Creation date (as opposed to system-defined _lastUpdated which is touched by triggers, replication etc.) + c: System.DateTimeOffset // ISO 8601 + + /// The Event Type, used to drive deserialization + t: string // required + + /// Event body, as UTF-8 encoded json ready to be injected into the Json being rendered for DocDb + [)>] + d: byte[] // required + + /// Optional metadata, as UTF-8 encoded json, ready to emit directly (null, not written if missing) + [)>] + [] + m: byte[] } // optional +/// Projection based on the state at a given point in time `i` +and Projection = + { /// Base: Max index rolled into this projection + i: int64 + + ///// Indicates whether this is actually an event being retained to support a lagging projection + //x: bool + + /// The Event Type of this compaction/snapshot, used to drive deserialization + t: string // required + + /// Event body - Json -> UTF-8 -> Deflate -> Base64 + [)>] + d: byte[] // required + + /// Optional metadata, same encoding as `d` (can be null; not written if missing) + [)>] + [] + m: byte[] } // optional + +type Enum() = + static member Events (b:WipBatch) = + b.e |> Seq.mapi (fun offset x -> + { new IOrderedEvent with + member __.Index = b._i + int64 offset + member __.IsProjection = false + member __.EventType = x.t + member __.Data = x.d + member __.Meta = x.m }) + static member Events (i: int64, e:BatchEvent[]) = + e |> Seq.mapi (fun offset x -> + { new IOrderedEvent with + member __.Index = i + int64 offset + member __.IsProjection = false + member __.EventType = x.t + member __.Data = x.d + member __.Meta = x.m }) + static member Event (x:Event) = + Seq.singleton + { new IOrderedEvent with + member __.Index = x.i + member __.IsProjection = false + member __.EventType = x.t + member __.Data = x.d + member __.Meta = x.m } + static member Projections (xs: Projection[]) = seq { + for x in xs -> { new IOrderedEvent with + member __.Index = x.i + member __.IsProjection = true + member __.EventType = x.t + member __.Data = x.d + member __.Meta = x.m } } + static member EventsAndProjections (x:WipBatch): IOrderedEvent seq = + Enum.Projections x.c + +/// Reference to Collection and name that will be used as the location for the stream +type [] CollectionStream = { collectionUri: System.Uri; name: string } with + static member Create(collectionUri, name) = { collectionUri = collectionUri; name = name } + +namespace Equinox.Cosmos open Equinox +open Equinox.Cosmos.Events +open Equinox.Cosmos.Store open Equinox.Store open FSharp.Control open Microsoft.Azure.Documents -open Microsoft.Azure.Documents.Linq -open Newtonsoft.Json -open Newtonsoft.Json.Linq open Serilog open System +[] +type Direction = Forward | Backward with + override this.ToString() = match this with Forward -> "Forward" | Backward -> "Backward" + +module Log = + [] + type Measurement = { stream: string; interval: StopwatchInterval; bytes: int; count: int; ru: float } + [] + type Event = + | WriteSuccess of Measurement + | WriteResync of Measurement + | WriteConflict of Measurement + /// Individual read request in a Batch + | Slice of Direction * Measurement + /// Individual read request for the Index + | Index of Measurement + /// Individual read request for the Index, not found + | IndexNotFound of Measurement + /// Index read with Single RU Request Charge due to correct use of etag in cache + | IndexNotModified of Measurement + /// Summarizes a set of Slices read together + | Batch of Direction * slices: int * Measurement + let prop name value (log : ILogger) = log.ForContext(name, value) + let propData name (events: #IEvent seq) (log : ILogger) = + let items = seq { for e in events do yield sprintf "{\"%s\": %s}" e.EventType (System.Text.Encoding.UTF8.GetString e.Data) } + log.ForContext(name, sprintf "[%s]" (String.concat ",\n\r" items)) + let propEvents = propData "events" + let propDataProjections = Enum.Projections >> propData "projections" + + let withLoggedRetries<'t> retryPolicy (contextLabel : string) (f : ILogger -> Async<'t>) log: Async<'t> = + match retryPolicy with + | None -> f log + | Some retryPolicy -> + let withLoggingContextWrapping count = + let log = if count = 1 then log else log |> prop contextLabel count + f log + retryPolicy withLoggingContextWrapping + /// Attach a property to the log context to hold the metrics + // Sidestep Log.ForContext converting to a string; see https://github.com/serilog/serilog/issues/1124 + open Serilog.Events + let event (value : Event) (log : ILogger) = + let enrich (e : LogEvent) = e.AddPropertyIfAbsent(LogEventProperty("cosmosEvt", ScalarValue(value))) + log.ForContext({ new Serilog.Core.ILogEventEnricher with member __.Enrich(evt,_) = enrich evt }) + let (|BlobLen|) = function null -> 0 | (x : byte[]) -> x.Length + let (|EventLen|) (x: #IEvent) = let (BlobLen bytes), (BlobLen metaBytes) = x.Data, x.Meta in bytes+metaBytes + let (|BatchLen|) = Seq.sumBy (|EventLen|) + [] -module private DocDbExtensions = +module private DocDb = /// Extracts the innermost exception from a nested hierarchy of Aggregate Exceptions let (|AggregateException|) (exn : exn) = let rec aux (e : exn) = @@ -51,306 +344,207 @@ module private DocDbExtensions = // NB while the docs suggest you may see a 412, the NotModified in the body of the try/with is actually what happens | DocDbException (DocDbStatusCode System.Net.HttpStatusCode.PreconditionFailed as e) -> return e.RequestCharge, NotModified } -module Store = - open System.IO - open System.IO.Compression - [] - type Position = - { collectionUri: Uri; streamName: string; index: int64 option; etag: string option } - member __.Index : int64 = defaultArg __.index -1L - member __.IndexRel (offset: int) : int64 = __.index |> function - | Some index -> index+int64 offset - | None -> failwithf "Cannot IndexRel %A" __ - - type EventData = { eventType: string; data: byte[]; metadata: byte[] } - type IEventData = - /// The Event Type, used to drive deserialization - abstract member EventType : string - /// Event body, as UTF-8 encoded json ready to be injected into the Json being rendered for DocDb - abstract member DataUtf8 : byte[] - /// Optional metadata (null, or same as d, not written if missing) - abstract member MetaUtf8 : byte[] - - [] - type Event = - { (* DocDb-mandated essential elements *) - - // DocDb-mandated Partition Key, must be maintained within the document - // Not actually required if running in single partition mode, but for simplicity, we always write it - p: string // "{streamName}" - - // DocDb-mandated unique row key; needs to be unique within any partition it is maintained; must be a string - // At the present time, one can't perform an ORDER BY on this field, hence we also have i, which is identical - id: string // "{index}" - - // Same as `id`; necessitated by fact that it's not presently possible to do an ORDER BY on the row key - i: int64 // {index} - - (* Event payload elements *) - - /// Creation date (as opposed to sytem-defined _lastUpdated which is rewritten by triggers adnd/or replication) - c: DateTimeOffset // ISO 8601 - - /// The Event Type, used to drive deserialization - t: string // required - - /// Event body, as UTF-8 encoded json ready to be injected into the Json being rendered for DocDb - [)>] - d: byte[] // required - - /// Optional metadata (null, or same as d, not written if missing) - [); JsonProperty(Required=Required.Default, NullValueHandling=NullValueHandling.Ignore)>] - m: byte[] } // optional - /// Unless running in single partion mode (which would restrict us to 10GB per collection) - /// we need to nominate a partition key that will be in every document - static member PartitionKeyField = "p" - /// As one cannot sort by the implicit `id` field, we have an indexed `i` field which we use for sort and range query purporses - static member IndexedFields = [Event.PartitionKeyField; "i"] - static member Create (pos: Position) offset (ed: EventData) : Event = - { p = pos.streamName; id = string (pos.IndexRel offset); i = pos.IndexRel offset - c = DateTimeOffset.UtcNow - t = ed.eventType; d = ed.data; m = ed.metadata } - interface IEventData with - member __.EventType = __.t - member __.DataUtf8 = __.d - member __.MetaUtf8 = __.m - - /// Manages injecting prepared json into the data being submitted to DocDb as-is, on the basis we can trust it to be valid json as DocDb will need it to be - and VerbatimUtf8JsonConverter() = - inherit JsonConverter() - - override __.ReadJson(reader, _, _, _) = - let token = JToken.Load(reader) - if token.Type = JTokenType.Object then token.ToString() |> System.Text.Encoding.UTF8.GetBytes |> box - else Array.empty |> box - - override __.CanConvert(objectType) = - typeof.Equals(objectType) - - override __.WriteJson(writer, value, serializer) = - let array = value :?> byte[] - if array = null || Array.length array = 0 then serializer.Serialize(writer, null) - else writer.WriteRawValue(System.Text.Encoding.UTF8.GetString(array)) - - [] - type IndexEvent = - { p: string // "{streamName}" - id: string // "{-1}" - - /// When we read, we need to capture the value so we can retain it for caching purposes; when we write, there's no point sending it as it would not be honored - [] - _etag: string - - //w: int64 // 100: window size - /// last index/i value - m: int64 // {index} - - /// Compacted projections based on version identified by `m` - c: IndexProjection[] - - (*// Potential schema to manage Pending Events together with compaction events based on each one - // This scheme is more complete than the simple `c` encoding, which relies on every writer being able to write all salient snapshots - // For instance, in the case of blue/green deploys, older versions need to be able to coexist without destroying the perf for eachother - "x": [ - { "i":0, - "c":"ISO 8601" - "e":[ - [{"t":"added","d":"..."},{"t":"compacted/1","d":"..."}], - [{"t":"removed","d":"..."}], - ] - } - ] *) - //x: JObject[][] - } - static member IdConstant = "-1" - static member Create (pos: Position) eventCount (eds: EventData[]) : IndexEvent = - { p = pos.streamName; id = IndexEvent.IdConstant; m = pos.IndexRel eventCount; _etag = null - c = [| for ed in eds -> { t = ed.eventType; d = ed.data; m = ed.metadata } |] } - and [] IndexProjection = - { /// The Event Type, used to drive deserialization - t: string // required - - /// Event body, as UTF-8 encoded json ready to be injected into the Json being rendered for DocDb - [)>] - d: byte[] // required - - /// Optional metadata (null, or same as d, not written if missing) - [); JsonProperty(Required=Required.Default, NullValueHandling=NullValueHandling.Ignore)>] - m: byte[] } // optional - interface IEventData with - member __.EventType = __.t - member __.DataUtf8 = __.d - member __.MetaUtf8 = __.m - - /// Manages zipping of the UTF-8 json bytes to make the index record minimal from the perspective of the writer stored proc - /// Only applied to snapshots in the Index - and Base64ZipUtf8JsonConverter() = - inherit JsonConverter() - let pickle (input : byte[]) : string = - if input = null then null else - - use output = new MemoryStream() - use compressor = new DeflateStream(output, CompressionLevel.Optimal) - compressor.Write(input,0,input.Length) - compressor.Close() - Convert.ToBase64String(output.ToArray()) - let unpickle str : byte[] = - if str = null then null else - - let compressedBytes = Convert.FromBase64String str - use input = new MemoryStream(compressedBytes) - use decompressor = new DeflateStream(input, CompressionMode.Decompress) - use output = new MemoryStream() - decompressor.CopyTo(output) - decompressor.Close() - output.ToArray() - - override __.CanConvert(objectType) = - typeof.Equals(objectType) - override __.ReadJson(reader, _, _, serializer) = - //( if reader.TokenType = JsonToken.Null then null else - serializer.Deserialize(reader, typedefof) :?> string |> unpickle |> box - override __.WriteJson(writer, value, serializer) = - let pickled = value |> unbox |> pickle - serializer.Serialize(writer, pickled) - - (* Pseudocode: - function sync(p, expectedVersion, windowSize, events) { - if (i == 0) then { - coll.insert(p,0,{ p:p, id:-1, w:windowSize, m:flatLen(events)}) +module Sync = + // NB don't nest in a private module, or serialization will fail miserably ;) + [] + type SyncResponse = { etag: string; nextI: int64; conflicts: BatchEvent[] } + let [] sprocName = "EquinoxSync-SingleEvents-021" // NB need to renumber for any breaking change + let [] sprocBody = """ + +// Manages the merging of the supplied Request Batch, fulfilling one of the following end-states +// 1 Verify no current WIP batch, the incoming `req` becomes the WIP batch (the caller is entrusted to provide a valid and complete set of inputs, or it's GIGO) +// 2 Current WIP batch has space to accommodate the incoming projections (req.c) and events (req.e) - merge them in, replacing any superseded projections +// 3. Current WIP batch would become too large - remove WIP state from active document by replacing the well known id with a correct one; proceed as per 1 +function sync(req, expectedVersion) { + if (!req) throw new Error("Missing req argument"); + const collection = getContext().getCollection(); + const collectionLink = collection.getSelfLink(); + const response = getContext().getResponse(); + + // Locate the WIP (-1) batch (which may not exist) + const wipDocId = collection.getAltLink() + "/docs/" + req.id; + const isAccepted = collection.readDocument(wipDocId, {}, function (err, current) { + // Verify we dont have a conflicting write + if (expectedVersion === -1) { + executeUpsert(current); + } else if (!current && expectedVersion !== 0) { + // If there is no WIP page, the writer has no possible reason for writing at an index other than zero + response.setBody({ etag: null, nextI: 0, conflicts: [] }); + } else if (current && expectedVersion !== current._i + current.e.length) { + // Where possible, we extract conflicting events from e and/or c in order to avoid another read cycle + // yielding [] triggers the client to go loading the events itself + const conflicts = expectedVersion < current._i ? [] : current.e.slice(expectedVersion - current._i); + const nextI = current._i + current.e.length; + response.setBody({ etag: current._etag, nextI: nextI, conflicts: conflicts }); } else { - const i = doc.find(p=p && id=-1) - if(i.m <> expectedVersion) then emit from expectedVersion else - i.x.append(events) - for (var (i, c, e: [ {e1}, ...]) in events) { - coll.insert({p:p, id:i, i:i, c:c, e:e1) - } - // trim i.x to w total items in i.[e] - coll.update(p,id,i) + executeUpsert(current); } - } *) -[] -type Direction = Forward | Backward with - override this.ToString() = match this with Forward -> "Forward" | Backward -> "Backward" + }); + if (!isAccepted) throw new Error("readDocument not Accepted"); -module Log = - [] - type Measurement = { stream: string; interval: StopwatchInterval; bytes: int; count: int; ru: float } - [] - type Event = - | WriteSuccess of Measurement - | WriteConflict of Measurement - /// Individual read request in a Batch - | Slice of Direction * Measurement - /// Individual read request for the Index - | Index of Measurement - /// Individual read request for the Index, not found - | IndexNotFound of Measurement - /// Index read with Single RU Request Charge due to correct use of etag in cache - | IndexNotModified of Measurement - /// Summarizes a set of Slices read together - | Batch of Direction * slices: int * Measurement - let prop name value (log : ILogger) = log.ForContext(name, value) - let propEvents name (kvps : System.Collections.Generic.KeyValuePair seq) (log : ILogger) = - let items = seq { for kv in kvps do yield sprintf "{\"%s\": %s}" kv.Key kv.Value } - log.ForContext(name, sprintf "[%s]" (String.concat ",\n\r" items)) - let propEventData name (events : Store.EventData[]) (log : ILogger) = - log |> propEvents name (seq { for x in events -> Collections.Generic.KeyValuePair<_,_>(x.eventType, System.Text.Encoding.UTF8.GetString x.data)}) - let propResolvedEvents name (events : Store.Event[]) (log : ILogger) = - log |> propEvents name (seq { for x in events -> Collections.Generic.KeyValuePair<_,_>(x.t, System.Text.Encoding.UTF8.GetString x.d)}) - let propIEventDatas name (events : Store.IEventData[]) (log : ILogger) = - log |> propEvents name (seq { for x in events -> Collections.Generic.KeyValuePair<_,_>(x.EventType, System.Text.Encoding.UTF8.GetString x.DataUtf8)}) - let propProjectionEvents name (events : Store.IndexProjection[]) (log : ILogger) = - log |> propEvents name (seq { for x in events -> Collections.Generic.KeyValuePair<_,_>(x.t, System.Text.Encoding.UTF8.GetString x.d)}) - - open Serilog.Events - /// Attach a property to the log context to hold the metrics - // Sidestep Log.ForContext converting to a string; see https://github.com/serilog/serilog/issues/1124 - let event (value : Event) (log : ILogger) = - let enrich (e : LogEvent) = e.AddPropertyIfAbsent(LogEventProperty("cosmosEvt", ScalarValue(value))) - log.ForContext({ new Serilog.Core.ILogEventEnricher with member __.Enrich(evt,_) = enrich evt }) - let withLoggedRetries<'t> retryPolicy (contextLabel : string) (f : ILogger -> Async<'t>) log: Async<'t> = - match retryPolicy with - | None -> f log - | Some retryPolicy -> - let withLoggingContextWrapping count = - let log = if count = 1 then log else log |> prop contextLabel count - f log - retryPolicy withLoggingContextWrapping - let (|BlobLen|) = function null -> 0 | (x : byte[]) -> x.Length - -[] -type EqxSyncResult = - | Written of Store.Position - | ConflictUnknown of Store.Position - | Conflict of Store.Position * events: Store.IEventData[] - -// NB don't nest in a private module, or serialization will fail miserably ;) -[] -type WriteResponse = { etag: string; conflicts: Store.IndexProjection[] } - -module private Write = - let [] sprocName = "EquinoxIndexedWrite" + function executeUpsert(current) { + function callback(err, doc) { + if (err) throw err; + response.setBody({ etag: doc._etag, nextI: doc._i + doc.e.length, conflicts: null }); + } + // If we have hit a sensible limit for a slice in the WIP document, trim the events + if (current && current.e.length + req.e.length > 10) { + current._i = current._i + current.e.length; + current.e = req.e; + current.c = req.c; + + // as we've mutated the document in a manner that can conflict with other writers, out write needs to be contingent on no competing updates having taken place + finalize(current); + const isAccepted = collection.replaceDocument(current._self, current, { etag: current._etag }, callback); + if (!isAccepted) throw new Error("Unable to restart WIP batch."); + } else if (current) { + // Append the new events into the current batch + Array.prototype.push.apply(current.e, req.e); + // Replace all the projections + current.c = req.c; + // TODO: should remove only projections being superseded + + // as we've mutated the document in a manner that can conflict with other writers, out write needs to be contingent on no competing updates having taken place + finalize(current); + const isAccepted = collection.replaceDocument(current._self, current, { etag: current._etag }, callback); + if (!isAccepted) throw new Error("Unable to replace WIP batch."); + } else { + current = req; + current._i = 0; + // concurrency control is by virtue of fact that any conflicting writer will encounter a primary key violation (which will result in a retry) + finalize(current); + const isAccepted = collection.createDocument(collectionLink, current, { disableAutomaticIdGeneration: true }, callback); + if (!isAccepted) throw new Error("Unable to create WIP batch."); + } + for (i = 0; i < req.e.length; i++) { + const e = req.e[i]; + const eventI = current._i + current.e.length - req.e.length + i; + const doc = { + p: req.p, + id: eventI.toString(), + i: eventI, + c: e.c, + t: e.t, + d: e.d, + m: e.m + }; + const isAccepted = collection.createDocument(collectionLink, doc, function (err) { + if (err) throw err; + }); + if (!isAccepted) throw new Error("Unable to add event " + doc.i); + } + } - let private writeEventsAsync (client: IDocumentClient) (pos: Store.Position) (events: Store.EventData seq,maybeIndexEvents): Async = async { - let sprocLink = sprintf "%O/sprocs/%s" pos.collectionUri sprocName - let opts = Client.RequestOptions(PartitionKey=PartitionKey(pos.streamName)) + function finalize(current) { + current.i = -1; + current.id = current.i.toString(); + } +}""" + + [] + type Result = + | Written of Position + | Conflict of Position * events: IOrderedEvent[] + | ConflictUnknown of Position + + let private run (client: IDocumentClient) (stream: CollectionStream) (expectedVersion: int64 option, req: WipBatch) + : Async = async { + let sprocLink = sprintf "%O/sprocs/%s" stream.collectionUri sprocName + let opts = Client.RequestOptions(PartitionKey=PartitionKey(stream.name)) let! ct = Async.CancellationToken - let events = events |> Seq.mapi (fun i ed -> Store.Event.Create pos (i+1) ed |> JsonConvert.SerializeObject) |> Seq.toArray - if events.Length = 0 then invalidArg "eventsData" "must be non-empty" - let index : Store.IndexEvent = - match maybeIndexEvents with - | None | Some [||] -> Unchecked.defaultof<_> - | Some eds -> Store.IndexEvent.Create pos (events.Length) eds - try - let! (res : Client.StoredProcedureResponse) = client.ExecuteStoredProcedureAsync(sprocLink, opts, ct, box events, box pos.Index, box pos.etag, box index) |> Async.AwaitTaskCorrect - match res.RequestCharge, (match res.Response.etag with null -> None | x -> Some x), res.Response.conflicts with - | rc,e,null -> return rc, EqxSyncResult.Written { pos with index = Some (pos.IndexRel events.Length); etag=e } - | rc,e,[||] -> return rc, EqxSyncResult.ConflictUnknown { pos with etag=e } - | rc,e, xs -> return rc, EqxSyncResult.Conflict ({ pos with index = Some (pos.IndexRel xs.Length); etag=e }, Array.map (fun x -> x :> _) xs) - with DocDbException ex when ex.Message.Contains "already" -> // TODO this does not work for the SP - return ex.RequestCharge, EqxSyncResult.ConflictUnknown { pos with etag=None } } - - let bytes events = - let eventDataLen ({ data = Log.BlobLen bytes; metadata = Log.BlobLen metaBytes } : Store.EventData) = bytes + metaBytes - events |> Array.sumBy eventDataLen - - let private writeEventsLogged client (pos : Store.Position) (events : Store.EventData[], maybeIndexEvents) (log : ILogger): Async = async { - let log = if (not << log.IsEnabled) Events.LogEventLevel.Debug then log else log |> Log.propEventData "Json" events - let bytes, count = bytes events, events.Length + let ev = match expectedVersion with Some ev -> Position.FromI ev | None -> Position.FromAppendAtEnd + let! (res : Client.StoredProcedureResponse) = + client.ExecuteStoredProcedureAsync(sprocLink, opts, ct, box req, box ev.index) |> Async.AwaitTaskCorrect + + let newPos = { index = res.Response.nextI; etag = Option.ofObj res.Response.etag } + return res.RequestCharge, res.Response.conflicts |> function + | null -> Result.Written newPos + | [||] when newPos.index = 0L -> Result.Conflict (newPos, Array.empty) + | [||] -> Result.ConflictUnknown newPos + | xs -> Result.Conflict (newPos, Enum.Events (ev.index, xs) |> Array.ofSeq) } + + let private logged client (stream: CollectionStream) (expectedVersion, req: WipBatch) (log : ILogger) + : Async = async { + let verbose = log.IsEnabled Events.LogEventLevel.Debug + let log = if verbose then log |> Log.propEvents (Enum.Events req) |> Log.propDataProjections req.c else log + let (Log.BatchLen bytes), count = Enum.Events req, req.e.Length let log = log |> Log.prop "bytes" bytes - let writeLog = log |> Log.prop "stream" pos.streamName |> Log.prop "expectedVersion" pos.Index |> Log.prop "count" count - let! t, (ru,result) = writeEventsAsync client pos (events,maybeIndexEvents) |> Stopwatch.Time + let writeLog = + log |> Log.prop "stream" stream.name |> Log.prop "expectedVersion" expectedVersion + |> Log.prop "count" req.e.Length |> Log.prop "pcount" req.c.Length + let! t, (ru,result) = run client stream (expectedVersion, req) |> Stopwatch.Time let resultLog = - let mkMetric ru : Log.Measurement = { stream = pos.streamName; interval = t; bytes = bytes; count = count; ru = ru } - let logConflict () = writeLog.Information("Eqx TrySync WrongExpectedVersion writing {EventTypes}", [| for x in events -> x.eventType |]) + let mkMetric ru : Log.Measurement = { stream = stream.name; interval = t; bytes = bytes; count = count; ru = ru } + let logConflict () = writeLog.Information("Eqx TrySync Conflict writing {eventTypes}", [| for x in req.e -> x.t |]) match result with - | EqxSyncResult.Written pos -> + | Result.Written pos -> log |> Log.event (Log.WriteSuccess (mkMetric ru)) |> Log.prop "nextExpectedVersion" pos - | EqxSyncResult.ConflictUnknown pos -> + | Result.ConflictUnknown pos -> logConflict () log |> Log.event (Log.WriteConflict (mkMetric ru)) |> Log.prop "nextExpectedVersion" pos |> Log.prop "conflict" true - | EqxSyncResult.Conflict (pos, xs) -> + | Result.Conflict (pos, xs) -> logConflict () - let log = if (not << log.IsEnabled) Events.LogEventLevel.Debug then log else log |> Log.prop "nextExpectedVersion" pos |> Log.propIEventDatas "conflictJson" xs - log |> Log.event (Log.WriteConflict (mkMetric ru)) |> Log.prop "conflict" true - resultLog.Information("Eqx {action:l} {count} {ms}ms rc={ru}", "Write", events.Length, (let e = t.Elapsed in e.TotalMilliseconds), ru) + let log = if verbose then log |> Log.prop "nextExpectedVersion" pos |> Log.propData "conflicts" xs else log + log |> Log.event (Log.WriteResync(mkMetric ru)) |> Log.prop "conflict" true + resultLog.Information("Eqx {action:l} {count}+{pcount} {ms}ms rc={ru}", "Write", req.e.Length, req.c.Length, (let e = t.Elapsed in e.TotalMilliseconds), ru) return result } - let writeEvents (log : ILogger) retryPolicy client pk (events : Store.EventData[],maybeIndexEvents): Async = - let call = writeEventsLogged client pk (events,maybeIndexEvents) + let batch (log : ILogger) retryPolicy client pk batch: Async = + let call = logged client pk batch Log.withLoggedRetries retryPolicy "writeAttempt" call log - -module private Read = - let private getIndex (client : IDocumentClient) (pos:Store.Position) = - let coll = DocDbCollection(client, pos.collectionUri) - let ac = match pos.etag with None -> null | Some etag-> Client.AccessCondition(Type=Client.AccessConditionType.IfNoneMatch, Condition=etag) - let ro = Client.RequestOptions(PartitionKey=PartitionKey(pos.streamName), AccessCondition = ac) - coll.TryReadDocument(Store.IndexEvent.IdConstant, ro) - let private loggedGetIndex (getIndex : Store.Position -> Async<_>) (pos:Store.Position) (log: ILogger) = async { - let log = log |> Log.prop "stream" pos.streamName - let! t, (ru, res : ReadResult) = getIndex pos |> Stopwatch.Time - let log count bytes (f : Log.Measurement -> _) = log |> Log.event (f { stream = pos.streamName; interval = t; bytes = bytes; count = count; ru = ru }) + let mkBatch (stream: Store.CollectionStream) (events: IEvent[]) projections: WipBatch = + { p = stream.name; id = Store.WipBatch.WellKnownDocumentId; _i = -1L(*Server-managed*); _etag = null + e = [| for e in events -> { c = DateTimeOffset.UtcNow; t = e.EventType; d = e.Data; m = e.Meta } |] + c = Array.ofSeq projections } + let mkProjections baseIndex (projectionEvents: IEvent seq) : Store.Projection seq = + projectionEvents |> Seq.mapi (fun offset x -> { i = baseIndex + int64 offset; t = x.EventType; d = x.Data; m = x.Meta } : Store.Projection) + + module Initialization = + open System.Collections.ObjectModel + let createDatabase (client:IDocumentClient) dbName = async { + let opts = Client.RequestOptions(ConsistencyLevel = Nullable ConsistencyLevel.Session) + let! db = client.CreateDatabaseIfNotExistsAsync(Database(Id=dbName), options = opts) |> Async.AwaitTaskCorrect + return db.Resource.Id } + + let createCollection (client: IDocumentClient) (dbUri: Uri) collName ru = async { + let pkd = PartitionKeyDefinition() + pkd.Paths.Add(sprintf "/%s" Store.Event.PartitionKeyField) + let colld = DocumentCollection(Id = collName, PartitionKey = pkd) + + colld.IndexingPolicy.IndexingMode <- IndexingMode.Consistent + colld.IndexingPolicy.Automatic <- true + // Can either do a blacklist or a whitelist + // Given how long and variable the blacklist would be, we whitelist instead + colld.IndexingPolicy.ExcludedPaths <- Collection [|ExcludedPath(Path="/*")|] + // NB its critical to index the nominated PartitionKey field defined above or there will be runtime errors + colld.IndexingPolicy.IncludedPaths <- Collection [| for k in Store.Event.IndexedFields -> IncludedPath(Path=sprintf "/%s/?" k) |] + let! coll = client.CreateDocumentCollectionIfNotExistsAsync(dbUri, colld, Client.RequestOptions(OfferThroughput=Nullable ru)) |> Async.AwaitTaskCorrect + return coll.Resource.Id } + + let createProc (log: ILogger) (client: IDocumentClient) (collectionUri: Uri) = async { + let def = new StoredProcedure(Id = sprocName, Body = sprocBody) + log.Information("Creating stored procedure {sprocId}", def.Id) + // TODO ifnotexist semantics + return! client.CreateStoredProcedureAsync(collectionUri, def) |> Async.AwaitTaskCorrect |> Async.Ignore } + + let initialize log (client : IDocumentClient) dbName collName ru = async { + let! dbId = createDatabase client dbName + let dbUri = Client.UriFactory.CreateDatabaseUri dbId + let! collId = createCollection client dbUri collName ru + let collUri = Client.UriFactory.CreateDocumentCollectionUri (dbName, collId) + //let! _aux = createAux client dbUri collName auxRu + return! createProc log client collUri } + +module private Index = + let private get (client: IDocumentClient) (stream: CollectionStream, maybePos: Position option) = + let coll = DocDbCollection(client, stream.collectionUri) + let ac = match maybePos with Some { etag=Some etag } -> Client.AccessCondition(Type=Client.AccessConditionType.IfNoneMatch, Condition=etag) | _ -> null + let ro = Client.RequestOptions(PartitionKey=PartitionKey(stream.name), AccessCondition = ac) + coll.TryReadDocument(WipBatch.WellKnownDocumentId, ro) + let private loggedGet (get : CollectionStream * Position option -> Async<_>) (stream: CollectionStream, maybePos: Position option) (log: ILogger) = async { + let log = log |> Log.prop "stream" stream.name + let! t, (ru, res : ReadResult) = get (stream,maybePos) |> Stopwatch.Time + let log count bytes (f : Log.Measurement -> _) = log |> Log.event (f { stream = stream.name; interval = t; bytes = bytes; count = count; ru = ru }) match res with | ReadResult.NotModified -> (log 0 0 Log.IndexNotModified).Information("Eqx {action:l} {res} {ms}ms rc={ru}", "Index", 302, (let e = t.Elapsed in e.TotalMilliseconds), ru) @@ -358,353 +552,269 @@ module private Read = (log 0 0 Log.IndexNotFound).Information("Eqx {action:l} {res} {ms}ms rc={ru}", "Index", 404, (let e = t.Elapsed in e.TotalMilliseconds), ru) | ReadResult.Found doc -> let log = - let (|EventLen|) (x : Store.IndexProjection) = match x.d, x.m with Log.BlobLen bytes, Log.BlobLen metaBytes -> bytes + metaBytes - let bytes, count = doc.c |> Array.sumBy (|EventLen|), doc.c.Length + let (Log.BatchLen bytes), count = Enum.Projections doc.c, doc.c.Length log bytes count Log.Index - let log = if (not << log.IsEnabled) Events.LogEventLevel.Debug then log else log |> Log.propProjectionEvents "Json" doc.c |> Log.prop "etag" doc._etag + let log = if (not << log.IsEnabled) Events.LogEventLevel.Debug then log else log |> Log.propDataProjections doc.c |> Log.prop "etag" doc._etag log.Information("Eqx {action:l} {res} {ms}ms rc={ru}", "Index", 200, (let e = t.Elapsed in e.TotalMilliseconds), ru) return ru, res } - type [] IndexResult = NotModified | NotFound | Found of Store.Position * Store.IndexProjection[] + type [] Result = NotModified | NotFound | Found of Position * IOrderedEvent[] /// `pos` being Some implies that the caller holds a cached value and hence is ready to deal with IndexResult.UnChanged - let loadIndex (log : ILogger) retryPolicy client (pos : Store.Position): Async = async { - let getIndex = getIndex client - let! _rc, res = Log.withLoggedRetries retryPolicy "readAttempt" (loggedGetIndex getIndex pos) log + let tryLoad (log : ILogger) retryPolicy client (stream: CollectionStream) (maybePos: Position option): Async = async { + let get = get client + let! _rc, res = Log.withLoggedRetries retryPolicy "readAttempt" (loggedGet get (stream,maybePos)) log match res with - | ReadResult.NotModified -> return IndexResult.NotModified - | ReadResult.NotFound -> return IndexResult.NotFound - | ReadResult.Found index -> return IndexResult.Found ({ pos with index = Some index.m; etag=if index._etag=null then None else Some index._etag }, index.c) } + | ReadResult.NotModified -> return Result.NotModified + | ReadResult.NotFound -> return Result.NotFound + | ReadResult.Found doc -> return Result.Found (doc.ToPosition(), Enum.EventsAndProjections doc |> Array.ofSeq) } - let private getQuery (client : IDocumentClient) (pos:Store.Position) (direction: Direction) batchSize = + module private Query = + open Microsoft.Azure.Documents.Linq + let private mkQuery (client : IDocumentClient) maxItems (stream: CollectionStream) (direction: Direction) (startPos: Position option) = let querySpec = - match pos.index with - | None -> SqlQuerySpec(if direction = Direction.Forward then "SELECT * FROM c ORDER BY c.i ASC" else "SELECT * FROM c ORDER BY c.i DESC") - | Some index -> + match startPos with + | None -> SqlQuerySpec("SELECT * FROM c WHERE c.i!=-1 ORDER BY c.i " + if direction = Direction.Forward then "ASC" else "DESC") + | Some p -> let f = if direction = Direction.Forward then "c.i >= @id ORDER BY c.i ASC" else "c.i < @id ORDER BY c.i DESC" - SqlQuerySpec( "SELECT * FROM c WHERE " + f, SqlParameterCollection (Seq.singleton (SqlParameter("@id", index)))) - let feedOptions = new Client.FeedOptions(PartitionKey=PartitionKey(pos.streamName), MaxItemCount=Nullable batchSize) - client.CreateDocumentQuery(pos.collectionUri, querySpec, feedOptions).AsDocumentQuery() - - let (|EventLen|) (x : Store.Event) = match x.d, x.m with Log.BlobLen bytes, Log.BlobLen metaBytes -> bytes + metaBytes - let bytes events = events |> Array.sumBy (|EventLen|) + SqlQuerySpec("SELECT * FROM c WHERE c.i != -1 AND " + f, SqlParameterCollection [SqlParameter("@id", p.index)]) + let feedOptions = new Client.FeedOptions(PartitionKey=PartitionKey(stream.name), MaxItemCount=Nullable maxItems) + client.CreateDocumentQuery(stream.collectionUri, querySpec, feedOptions).AsDocumentQuery() - let private loggedQueryExecution (pos:Store.Position) direction (query: IDocumentQuery) (log: ILogger): Async = async { + // Unrolls the Batches in a response - note when reading backawards, the events are emitted in reverse order of index + let private handleSlice direction (stream: CollectionStream) (startPos: Position option) (query: IDocumentQuery) (log: ILogger) + : Async = async { let! ct = Async.CancellationToken - let! t, (res : Client.FeedResponse) = query.ExecuteNextAsync(ct) |> Async.AwaitTaskCorrect |> Stopwatch.Time - let slice, ru = Array.ofSeq res, res.RequestCharge - let bytes, count = bytes slice, slice.Length - let reqMetric : Log.Measurement = { stream = pos.streamName; interval = t; bytes = bytes; count = count; ru = ru } - let evt = Log.Slice (direction, reqMetric) - let log = if (not << log.IsEnabled) Events.LogEventLevel.Debug then log else log |> Log.propResolvedEvents "Json" slice - let index = match slice |> Array.tryHead with Some head -> head.id | None -> null - (log |> Log.prop "startIndex" pos.Index |> Log.prop "bytes" bytes |> Log.event evt) - .Information("Eqx {action:l} {count} {direction} {ms}ms i={index} rc={ru}", "Query", count, direction, (let e = t.Elapsed in e.TotalMilliseconds), index, ru) - return slice, ru } - - let private readBatches (log : ILogger) (readSlice: IDocumentQuery -> ILogger -> Async) + let! t, (res : Client.FeedResponse) = query.ExecuteNextAsync(ct) |> Async.AwaitTaskCorrect |> Stopwatch.Time + let batches, ru = Array.ofSeq res, res.RequestCharge + let events = batches |> Seq.collect Enum.Event |> Array.ofSeq + let (Log.BatchLen bytes), count = events, events.Length + let reqMetric : Log.Measurement = { stream = stream.name; interval = t; bytes = bytes; count = count; ru = ru } + // TODO investigate whether there is a way to avoid the potential cost (or whether there is significance to it) of these null responses + let log = if batches.Length = 0 && count = 0 && ru = 0. then log else let evt = Log.Slice (direction, reqMetric) in log |> Log.event evt + let log = if (not << log.IsEnabled) Events.LogEventLevel.Debug then log else log |> Log.propEvents events + let index = if count = 0 then Nullable () else Nullable <| Seq.min (seq { for x in batches -> x.i }) + (log |> Log.prop "startIndex" (match startPos with Some { index = i } -> Nullable i | _ -> Nullable()) |> Log.prop "bytes" bytes) + .Information("Eqx {action:l} {count}/{batches} {direction} {ms}ms i={index} rc={ru}", + "Query", count, batches.Length, direction, (let e = t.Elapsed in e.TotalMilliseconds), index, ru) + let maybePosition = batches |> Array.tryPick (fun x -> x.TryToPosition()) + return events, maybePosition, ru } + + let private runQuery (log : ILogger) (readSlice: IDocumentQuery -> ILogger -> Async) (maxPermittedBatchReads: int option) - (query: IDocumentQuery) - : AsyncSeq = - let rec loop batchCount : AsyncSeq = asyncSeq { + (query: IDocumentQuery) + : AsyncSeq = + let rec loop batchCount : AsyncSeq = asyncSeq { match maxPermittedBatchReads with | Some mpbr when batchCount >= mpbr -> log.Information "batch Limit exceeded"; invalidOp "batch Limit exceeded" | _ -> () let batchLog = log |> Log.prop "batchIndex" batchCount - let! slice = readSlice query batchLog + let! (slice : IOrderedEvent[] * Position option * float) = readSlice query batchLog yield slice if query.HasMoreResults then yield! loop (batchCount + 1) } loop 0 - let logBatchRead direction streamName interval events batchSize version (ru: float) (log : ILogger) = - let bytes, count = bytes events, events.Length + let private logBatchRead direction batchSize streamName interval (responsesCount, events : IOrderedEvent []) nextI (ru: float) (log : ILogger) = + let (Log.BatchLen bytes), count = events, events.Length let reqMetric : Log.Measurement = { stream = streamName; interval = interval; bytes = bytes; count = count; ru = ru } - let batches = (events.Length - 1)/batchSize + 1 let action = match direction with Direction.Forward -> "LoadF" | Direction.Backward -> "LoadB" - let evt = Log.Event.Batch (direction, batches, reqMetric) - (log |> Log.prop "bytes" bytes |> Log.event evt).Information( - "Eqx {action:l} stream={stream} {count}/{batches} {ms}ms i={index} rc={ru}", - action, streamName, count, batches, (let e = interval.Elapsed in e.TotalMilliseconds), version, ru) - - let private lastEventIndex (xs:Store.Event seq) : int64 = - match xs |> Seq.tryLast with - | None -> -1L - | Some last -> int64 last.id - - let loadForwardsFrom (log : ILogger) retryPolicy client batchSize maxPermittedBatchReads (pos): Async = async { - let mutable ru = 0.0 - let mergeBatches (batches: AsyncSeq) = async { - let! (events : Store.Event[]) = - batches - |> AsyncSeq.map (fun (events, r) -> ru <- ru + r; events) - |> AsyncSeq.concatSeq - |> AsyncSeq.toArrayAsync - return events, ru } - use query = getQuery client pos Direction.Forward batchSize - let call q = loggedQueryExecution pos Direction.Forward q - let retryingLoggingReadSlice q = Log.withLoggedRetries retryPolicy "readAttempt" (call q) - let direction = Direction.Forward - let log = log |> Log.prop "batchSize" batchSize |> Log.prop "direction" direction |> Log.prop "stream" pos.streamName - let batches : AsyncSeq = readBatches log retryingLoggingReadSlice maxPermittedBatchReads query - let! t, (events, ru) = mergeBatches batches |> Stopwatch.Time - query.Dispose() - let version = lastEventIndex events - log |> logBatchRead direction pos.streamName t events batchSize version ru - return { pos with index = Some version }, events } - - let partitionPayloadFrom firstUsedEventNumber : Store.Event[] -> int * int = - let acc (tu,tr) ((EventLen bytes) as y) = if y.id < firstUsedEventNumber then tu, tr + bytes else tu + bytes, tr - Array.fold acc (0,0) - let loadBackwardsUntilCompactionOrStart (log : ILogger) retryPolicy client batchSize maxPermittedBatchReads isCompactionEvent (pos : Store.Position) - : Async = async { - let mergeFromCompactionPointOrStartFromBackwardsStream (log : ILogger) (batchesBackward : AsyncSeq) - : Async = async { - let lastBatch = ref None + // TODO investigate whether there is a way to avoid the potential cost (or whether there is significance to it) of these null responses + let log = if count = 0 && ru = 0. then log else let evt = Log.Event.Batch (direction, responsesCount, reqMetric) in log |> Log.event evt + (log |> Log.prop "bytes" bytes |> Log.prop "batchSize" batchSize).Information( + "Eqx {action:l} {stream} v{nextI} {count}/{responses} {ms}ms rc={ru}", + action, streamName, nextI, count, responsesCount, (let e = interval.Elapsed in e.TotalMilliseconds), ru) + + let private inferPosition maybeIndexDocument (events: IOrderedEvent[]): Position = match maybeIndexDocument with Some p -> p | None -> Position.FromMaxIndex events + + let private calculateUsedVersusDroppedPayload stopIndex (xs: IOrderedEvent[]) : int * int = + let mutable used, dropped = 0, 0 + let mutable found = false + for x in xs do + let (Log.EventLen bytes) = x + if found then dropped <- dropped + bytes + else used <- used + bytes + if x.Index = stopIndex then found <- true + used, dropped + + let walk (log : ILogger) client retryPolicy maxItems maxRequests direction (stream: CollectionStream) startPos predicate + : Async = async { + let responseCount = ref 0 + let mergeBatches (log : ILogger) (batchesBackward : AsyncSeq) + : Async = async { + let mutable lastResponse = None + let mutable maybeIndexDocument = None let mutable ru = 0.0 - let! tempBackward = + let! events = batchesBackward - |> AsyncSeq.map (fun (events, r) -> lastBatch := Some events; ru <- ru + r; events) + |> AsyncSeq.map (fun (events, maybePos, r) -> + if maybeIndexDocument = None then maybeIndexDocument <- maybePos + lastResponse <- Some events; ru <- ru + r + incr responseCount + events) |> AsyncSeq.concatSeq |> AsyncSeq.takeWhileInclusive (fun x -> - if not (isCompactionEvent x) then true // continue the search + if not (predicate x) then true // continue the search else - match !lastBatch with - | None -> log.Information("Eqx Stop stream={stream} at={eventNumber}", pos.streamName, x.id) + match lastResponse with + | None -> log.Information("Eqx Stop stream={stream} at={index}", stream.name, x.Index) | Some batch -> - let used, residual = batch |> partitionPayloadFrom x.id - log.Information("Eqx Stop stream={stream} at={eventNumber} used={used} residual={residual}", pos.streamName, x.id, used, residual) + let used, residual = batch |> calculateUsedVersusDroppedPayload x.Index + log.Information("Eqx Stop stream={stream} at={index} used={used} residual={residual}", stream.name, x.Index, used, residual) false) |> AsyncSeq.toArrayAsync - let eventsForward = Array.Reverse(tempBackward); tempBackward // sic - relatively cheap, in-place reverse of something we own - return eventsForward, ru } - use query = getQuery client pos Direction.Backward batchSize - let call q = loggedQueryExecution pos Direction.Backward q - let retryingLoggingReadSlice q = Log.withLoggedRetries retryPolicy "readAttempt" (call q) - let log = log |> Log.prop "batchSize" batchSize |> Log.prop "stream" pos.streamName - let direction = Direction.Backward + return events, maybeIndexDocument, ru } + use query = mkQuery client maxItems stream direction startPos + let pullSlice = handleSlice direction stream startPos + let retryingLoggingReadSlice query = Log.withLoggedRetries retryPolicy "readAttempt" (pullSlice query) + let log = log |> Log.prop "batchSize" maxItems |> Log.prop "stream" stream.name let readlog = log |> Log.prop "direction" direction - let batchesBackward : AsyncSeq = readBatches readlog retryingLoggingReadSlice maxPermittedBatchReads query - let! t, (events, ru) = mergeFromCompactionPointOrStartFromBackwardsStream log batchesBackward |> Stopwatch.Time + let batches : AsyncSeq = runQuery readlog retryingLoggingReadSlice maxRequests query + let! t, (events, maybeIndexDocument, ru) = mergeBatches log batches |> Stopwatch.Time query.Dispose() - let version = lastEventIndex events - log |> logBatchRead direction pos.streamName t events batchSize version ru - return { pos with index = Some version } , events } + let pos = inferPosition maybeIndexDocument events -module UnionEncoderAdapters = - let private encodedEventOfStoredEvent (x : Store.Event) : UnionCodec.EncodedUnion = - { caseName = x.t; payload = x.d } - let private encodedEventOfStoredEventI (x : Store.IEventData) : UnionCodec.EncodedUnion = - { caseName = x.EventType; payload = x.DataUtf8 } - let private eventDataOfEncodedEvent (x : UnionCodec.EncodedUnion) : Store.EventData = - { eventType = x.caseName; data = x.payload; metadata = null } - let encodeEvents (codec : UnionCodec.IUnionEncoder<'event, byte[]>) (xs : 'event seq) : Store.EventData[] = - xs |> Seq.map (codec.Encode >> eventDataOfEncodedEvent) |> Seq.toArray - let decodeKnownEventsI (codec : UnionCodec.IUnionEncoder<'event, byte[]>) (xs : Store.IEventData seq) : 'event seq = - xs |> Seq.map encodedEventOfStoredEventI |> Seq.choose codec.TryDecode - let decodeKnownEvents (codec : UnionCodec.IUnionEncoder<'event, byte[]>) (xs : Store.Event seq) : 'event seq = - xs |> Seq.map encodedEventOfStoredEvent |> Seq.choose codec.TryDecode - -type []Token = { pos: Store.Position; compactionEventNumber: int64 option } + log |> logBatchRead direction maxItems stream.name t (!responseCount,events) pos.index ru + return pos, events } +module UnionEncoderAdapters = + let encodeEvent (codec : UnionCodec.IUnionEncoder<'event, byte[]>) (x : 'event) : IEvent = + let e = codec.Encode x + { new IEvent with + member __.EventType = e.caseName + member __.Data = e.payload + member __.Meta = null } + let decodeKnownEvents (codec : UnionCodec.IUnionEncoder<'event, byte[]>): IOrderedEvent seq -> 'event seq = + Seq.choose (fun x -> codec.TryDecode { caseName = x.EventType; payload = x.Data }) + +type [] Token = { stream: CollectionStream; pos: Position } module Token = - let private create compactionEventNumber batchCapacityLimit pos : Storage.StreamToken = - { value = box { pos = pos; compactionEventNumber = compactionEventNumber }; batchCapacityLimit = batchCapacityLimit } - /// No batching / compaction; we only need to retain the StreamVersion - let ofNonCompacting (pos : Store.Position) : Storage.StreamToken = - create None None pos - // headroom before compaction is necessary given the stated knowledge of the last (if known) `compactionEventNumberOption` - let private batchCapacityLimit compactedEventNumberOption unstoredEventsPending (batchSize : int) (streamVersion : int64) : int = - match compactedEventNumberOption with - | Some (compactionEventNumber : int64) -> (batchSize - unstoredEventsPending) - int (streamVersion - compactionEventNumber + 1L) |> max 0 - | None -> (batchSize - unstoredEventsPending) - (int streamVersion + 1) - 1 |> max 0 - let (*private*) ofCompactionEventNumber compactedEventNumberOption unstoredEventsPending batchSize (pos : Store.Position) : Storage.StreamToken = - let batchCapacityLimit = batchCapacityLimit compactedEventNumberOption unstoredEventsPending batchSize pos.Index - create compactedEventNumberOption (Some batchCapacityLimit) pos - /// Assume we have not seen any compaction events; use the batchSize and version to infer headroom - let ofUncompactedVersion batchSize pos : Storage.StreamToken = - ofCompactionEventNumber None 0 batchSize pos - /// Use previousToken plus the data we are adding and the position we are adding it to infer a headroom - let ofPreviousTokenAndEventsLength (previousToken : Storage.StreamToken) eventsLength batchSize pos : Storage.StreamToken = - let compactedEventNumber = (unbox previousToken.value).compactionEventNumber - ofCompactionEventNumber compactedEventNumber eventsLength batchSize pos - let ofPreviousTokenWithUpdatedPosition (previousToken : Storage.StreamToken) batchSize pos : Storage.StreamToken = - let compactedEventNumber = (unbox previousToken.value).compactionEventNumber - ofCompactionEventNumber compactedEventNumber 0 batchSize pos - /// Use an event just read from the stream to infer headroom - let ofCompactionResolvedEventAndVersion (compactionEvent: Store.Event) batchSize pos : Storage.StreamToken = - ofCompactionEventNumber (Some (int64 compactionEvent.id)) 0 batchSize pos - /// Use an event we are about to write to the stream to infer headroom - let ofPreviousStreamVersionAndCompactionEventDataIndex prevStreamVersion compactionEventDataIndex eventsLength batchSize streamVersion' : Storage.StreamToken = - ofCompactionEventNumber (Some (prevStreamVersion + 1L + int64 compactionEventDataIndex)) eventsLength batchSize streamVersion' - let private unpackEqxStreamVersion (x : Storage.StreamToken) = let x : Token = unbox x.value in x.pos.Index - let private unpackEqxETag (x : Storage.StreamToken) = let x : Token = unbox x.value in x.pos.etag - let supersedes current x = - let currentVersion, newVersion = unpackEqxStreamVersion current, unpackEqxStreamVersion x - let currentETag, newETag = unpackEqxETag current, unpackEqxETag x + let create stream pos : Storage.StreamToken = { value = box { stream = stream; pos = pos } } + let (|Unpack|) (token: Storage.StreamToken) : CollectionStream*Position = let t = unbox token.value in t.stream,t.pos + let supersedes (Unpack (_,currentPos)) (Unpack (_,xPos)) = + let currentVersion, newVersion = currentPos.index, xPos.index + let currentETag, newETag = currentPos.etag, xPos.etag newVersion > currentVersion || currentETag <> newETag +namespace Equinox.Cosmos.Builder + +open Equinox +open Equinox.Cosmos.Events // NB needs to be shadow by Equinox.Cosmos +open Equinox.Cosmos +open Equinox.Store.Infrastructure +open FSharp.Control +open Microsoft.Azure.Documents +open Serilog +open System +open System.Collections.Generic + +[] +module Internal = + [] + type InternalSyncResult = Written of Storage.StreamToken | ConflictUnknown of Storage.StreamToken | Conflict of Storage.StreamToken * IOrderedEvent[] + + [] + type LoadFromTokenResult = Unchanged | Found of Storage.StreamToken * IOrderedEvent[] + +/// Defines the policies in force for retrying with regard to transient failures calling CosmosDb (as opposed to application level concurrency conflicts) type EqxConnection(client: IDocumentClient, ?readRetryPolicy (*: (int -> Async<'T>) -> Async<'T>*), ?writeRetryPolicy) = member __.Client = client member __.ReadRetryPolicy = readRetryPolicy member __.WriteRetryPolicy = writeRetryPolicy - member __.Close = (client :?> Client.DocumentClient).Dispose() - -type EqxBatchingPolicy(getMaxBatchSize : unit -> int, ?batchCountLimit) = - new (maxBatchSize) = EqxBatchingPolicy(fun () -> maxBatchSize) - member __.BatchSize = getMaxBatchSize() - member __.MaxBatches = batchCountLimit - -[] -type GatewaySyncResult = Written of Storage.StreamToken | ConflictUnknown of Storage.StreamToken | Conflict of Storage.StreamToken * Store.IEventData[] - -[] -type LoadFromTokenResult = Unchanged | Found of Storage.StreamToken * Store.IEventData[] + //member __.Close = (client :?> Client.DocumentClient).Dispose() + +/// Defines the policies in force regarding how to constrain query responses +type EqxBatchingPolicy + ( // Max items to request in query response. Defaults to 10. + ?defaultMaxItems : int, + // Dynamic version of `defaultMaxItems`, allowing one to react to dynamic configuration changes. Default to using `defaultMaxItems` + ?getDefaultMaxItems : unit -> int, + /// Maximum number of trips to permit when slicing the work into multiple responses based on `MaxSlices`. Default: unlimited. + ?maxRequests) = + let getdefaultMaxItems = defaultArg getDefaultMaxItems (fun () -> defaultArg defaultMaxItems 10) + /// Limit for Maximum number of `Batch` records in a single query batch response + member __.MaxItems = getdefaultMaxItems () + /// Maximum number of trips to permit when slicing the work into multiple responses based on `MaxSlices` + member __.MaxRequests = maxRequests type EqxGateway(conn : EqxConnection, batching : EqxBatchingPolicy) = - let isResolvedEventEventType predicate (x:Store.Event) = predicate x.t - let tryIsResolvedEventEventType predicateOption = predicateOption |> Option.map isResolvedEventEventType - //let isResolvedEventDataEventType predicate (x:Store.Event) = predicate x.t - //let tryIsEventDataEventType predicateOption = predicateOption |> Option.map isResolvedEventDataEventType - let (|Pos|) (token: Storage.StreamToken) : Store.Position = (unbox token.value).pos - let (|IEventDataArray|) events = [| for e in events -> e :> Store.IEventData |] - member private __.InterpretIndexOrFallback log isCompactionEventType pos res: Async = async { + let eventTypesPredicate resolved = + let acc = HashSet() + fun (x: IOrderedEvent) -> + acc.Add x.EventType |> ignore + resolved acc + let (|Satisfies|_|) predicate (xs:IOrderedEvent[]) = + match Array.tryFindIndexBack predicate xs with + | None -> None + | Some index -> Array.sub xs index (xs.Length - index) |> Some + let loadBackwardsStopping log predicate stream: Async = async { + let! pos, events = Query.walk log conn.Client conn.ReadRetryPolicy batching.MaxItems batching.MaxRequests Direction.Backward stream None predicate + Array.Reverse events + return Token.create stream pos, events } + member __.LoadBackwardsStopping log predicate stream: Async = + let predicate = eventTypesPredicate predicate + loadBackwardsStopping log predicate stream + member __.Read log batchingOverride stream direction startPos predicate: Async = async { + let batching = defaultArg batchingOverride batching + let! pos, events = Query.walk log conn.Client conn.ReadRetryPolicy batching.MaxItems batching.MaxRequests direction stream startPos predicate + return Token.create stream pos, events } + member __.LoadFromProjectionsOrRollingSnapshots log predicate (stream,maybePos): Async = async { + let! res = Index.tryLoad log None(* TODO conn.ReadRetryPolicy*) conn.Client stream maybePos + let predicate = eventTypesPredicate predicate + match res with + | Index.Result.NotFound -> return Token.create stream Position.FromKnownEmpty, Array.empty + | Index.Result.NotModified -> return invalidOp "Not handled" + | Index.Result.Found (pos, Satisfies predicate enoughEvents) -> return Token.create stream pos, enoughEvents + | _ -> return! loadBackwardsStopping log predicate stream } + member __.GetPosition(log, stream, ?pos): Async = async { + let! res = Index.tryLoad log None(* TODO conn.ReadRetryPolicy*) conn.Client stream pos match res with - | Read.IndexResult.NotModified -> return invalidOp "Not handled" - | Read.IndexResult.Found (pos, projectionsAndEvents) when projectionsAndEvents |> Array.exists (fun x -> isCompactionEventType x.t) -> - return Token.ofNonCompacting pos, projectionsAndEvents |> Seq.cast |> Array.ofSeq + | Index.Result.NotFound -> return Token.create stream Position.FromKnownEmpty + | Index.Result.NotModified -> return Token.create stream pos.Value + | Index.Result.Found (pos, _projectionsAndEvents) -> return Token.create stream pos } + member __.LoadFromToken log (stream,pos) predicate: Async = async { + let predicate = eventTypesPredicate predicate + let! res = Index.tryLoad log None(* TODO conn.ReadRetryPolicy*) conn.Client stream (Some pos) + match res with + | Index.Result.NotFound -> return LoadFromTokenResult.Found (Token.create stream Position.FromKnownEmpty,Array.empty) + | Index.Result.NotModified -> return LoadFromTokenResult.Unchanged + | Index.Result.Found (pos, Satisfies predicate enoughEvents) -> return LoadFromTokenResult.Found (Token.create stream pos, enoughEvents) | _ -> - let! streamToken, events = __.LoadBackwardsStoppingAtCompactionEvent log isCompactionEventType pos - return streamToken, events |> Seq.cast |> Array.ofSeq } - member __.LoadBatched log isCompactionEventType (pos : Store.Position): Async = async { - let! pos, events = Read.loadForwardsFrom log conn.ReadRetryPolicy conn.Client batching.BatchSize batching.MaxBatches pos - match tryIsResolvedEventEventType isCompactionEventType with - | None -> return Token.ofNonCompacting pos, events - | Some isCompactionEvent -> - match events |> Array.tryFindBack isCompactionEvent with - | None -> return Token.ofUncompactedVersion batching.BatchSize pos, events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize pos, events } - member __.LoadBackwardsStoppingAtCompactionEvent log isCompactionEventType pos: Async = async { - let isCompactionEvent = isResolvedEventEventType isCompactionEventType - let! pos, events = - Read.loadBackwardsUntilCompactionOrStart log conn.ReadRetryPolicy conn.Client batching.BatchSize batching.MaxBatches isCompactionEvent pos - match Array.tryHead events |> Option.filter isCompactionEvent with - | None -> return Token.ofUncompactedVersion batching.BatchSize pos, events - | Some resolvedEvent -> return Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize pos, events } - member __.IndexedOrBatched log isCompactionEventType pos: Async = async { - let! res = Read.loadIndex log None(* TODO conn.ReadRetryPolicy*) conn.Client pos - return! __.InterpretIndexOrFallback log isCompactionEventType pos res } - member __.LoadFromToken log (Pos pos as token) isCompactionEventType tryIndex: Async = async { - let ok r = LoadFromTokenResult.Found r - if not tryIndex then - let! pos, ((IEventDataArray xs) as events) = Read.loadForwardsFrom log conn.ReadRetryPolicy conn.Client batching.BatchSize batching.MaxBatches pos - let ok t = ok (t,xs) - match tryIsResolvedEventEventType isCompactionEventType with - | None -> return ok (Token.ofNonCompacting pos) - | Some isCompactionEvent -> - match events |> Array.tryFindBack isCompactionEvent with - | None -> return ok (Token.ofPreviousTokenAndEventsLength token events.Length batching.BatchSize pos) - | Some resolvedEvent -> return ok (Token.ofCompactionResolvedEventAndVersion resolvedEvent batching.BatchSize pos) - else - let! res = Read.loadIndex log None(* TODO conn.ReadRetryPolicy*) conn.Client pos - match res with - | Read.IndexResult.NotModified -> - return LoadFromTokenResult.Unchanged - | _ -> - let! loaded = __.InterpretIndexOrFallback log isCompactionEventType.Value pos res - return ok loaded } - member __.TrySync log (Pos pos as token) (encodedEvents: Store.EventData[],maybeIndexEvents) isCompactionEventType: Async = async { - let! wr = Write.writeEvents log conn.WriteRetryPolicy conn.Client pos (encodedEvents,maybeIndexEvents) + let! res = __.Read log None stream Direction.Forward (Some pos) (fun _ -> false) + return LoadFromTokenResult.Found res } + member __.Sync log stream (expectedVersion, batch: Store.WipBatch): Async = async { + let! wr = Sync.batch log conn.WriteRetryPolicy conn.Client stream (expectedVersion,batch) match wr with - | EqxSyncResult.Conflict (pos',events) -> - return GatewaySyncResult.Conflict (Token.ofPreviousTokenAndEventsLength token events.Length batching.BatchSize pos',events) - | EqxSyncResult.ConflictUnknown pos' -> - return GatewaySyncResult.ConflictUnknown (Token.ofPreviousTokenWithUpdatedPosition token batching.BatchSize pos') - | EqxSyncResult.Written pos' -> - - let token = - match isCompactionEventType with - | None -> Token.ofNonCompacting pos' - | Some isCompactionEvent -> - let isEventDataEventType predicate (x:Store.EventData) = predicate x.eventType - match encodedEvents |> Array.tryFindIndexBack (isEventDataEventType isCompactionEvent) with - | None -> Token.ofPreviousTokenAndEventsLength token encodedEvents.Length batching.BatchSize pos' - | Some compactionEventIndex -> - Token.ofPreviousStreamVersionAndCompactionEventDataIndex pos.Index compactionEventIndex encodedEvents.Length batching.BatchSize pos' - return GatewaySyncResult.Written token } - -type private Collection(gateway : EqxGateway, databaseId, collectionId) = - member __.Gateway = gateway - member __.CollectionUri = Client.UriFactory.CreateDocumentCollectionUri(databaseId, collectionId) - -[] -type SearchStrategy<'event> = - | EventType of string - | Predicate of ('event -> bool) - -[] -type AccessStrategy<'event,'state> = - | EventsAreState - | //[] - RollingSnapshots of eventType: string * compact: ('state -> 'event) - | IndexedSearch of (string -> bool) * index: ('state -> 'event seq) - -type private CompactionContext(eventsLen : int, capacityBeforeCompaction : int) = - /// Determines whether writing a Compaction event is warranted (based on the existing state and the current `Accumulated` changes) - member __.IsCompactionDue = eventsLen > capacityBeforeCompaction - -type private Category<'event, 'state>(coll : Collection, codec : UnionCodec.IUnionEncoder<'event, byte[]>, ?access : AccessStrategy<'event,'state>) = - let (|Pos|) streamName : Store.Position = { collectionUri = coll.CollectionUri; streamName = streamName; index = None; etag = None } - let compactionPredicate = - match access with - | None -> None - | Some (AccessStrategy.IndexedSearch (predicate,_)) -> Some predicate - | Some AccessStrategy.EventsAreState -> Some (fun _ -> true) - | Some (AccessStrategy.RollingSnapshots (et,_)) -> Some ((=) et) - let load (fold: 'state -> 'event seq -> 'state) initial loadF = async { - let! token, events = loadF - return token, fold initial (UnionEncoderAdapters.decodeKnownEvents codec events) } - let foldI (fold: 'state -> 'event seq -> 'state) initial token events = - token, fold initial (UnionEncoderAdapters.decodeKnownEventsI codec events) - let loadI (fold: 'state -> 'event seq -> 'state) initial loadF = async { - let! token, events = loadF - return foldI fold initial token events } - let loadAlgorithm fold (pos : Store.Position) initial log = - let batched = load fold initial (coll.Gateway.LoadBatched log None pos) - let compacted predicate = load fold initial (coll.Gateway.LoadBackwardsStoppingAtCompactionEvent log predicate pos) - let indexed predicate = loadI fold initial (coll.Gateway.IndexedOrBatched log predicate pos) - match access with - | Some (AccessStrategy.IndexedSearch (predicate,_)) -> indexed predicate - | None -> batched - | Some AccessStrategy.EventsAreState -> compacted (fun _ -> true) - | Some (AccessStrategy.RollingSnapshots (et,_)) -> compacted ((=) et) - member __.Load (fold: 'state -> 'event seq -> 'state) (initial: 'state) (Pos pos) (log : ILogger) : Async = - loadAlgorithm fold pos initial log - member __.LoadFromToken (fold: 'state -> 'event seq -> 'state) (initial: 'state) (state: 'state) token (log : ILogger) - : Async = async { - let indexed = match access with Some (AccessStrategy.IndexedSearch _) -> true | _ -> false - let! res = coll.Gateway.LoadFromToken log token compactionPredicate indexed + | Sync.Result.Conflict (pos',events) -> return InternalSyncResult.Conflict (Token.create stream pos',events) + | Sync.Result.ConflictUnknown pos' -> return InternalSyncResult.ConflictUnknown (Token.create stream pos') + | Sync.Result.Written pos' -> return InternalSyncResult.Written (Token.create stream pos') } + +type private Category<'event, 'state>(gateway : EqxGateway, codec : UnionCodec.IUnionEncoder<'event, byte[]>) = + let respond (fold: 'state -> 'event seq -> 'state) initial events : 'state = + fold initial (UnionEncoderAdapters.decodeKnownEvents codec events) + member __.Load includeProjections collectionStream fold initial predicate (log : ILogger): Async = async { + let! token, events = + if not includeProjections then gateway.LoadBackwardsStopping log predicate collectionStream + else gateway.LoadFromProjectionsOrRollingSnapshots log predicate (collectionStream,None) + return token, respond fold initial events } + member __.LoadFromToken (Token.Unpack streamPos, state: 'state as current) fold predicate (log : ILogger): Async = async { + let! res = gateway.LoadFromToken log streamPos predicate match res with - | LoadFromTokenResult.Unchanged -> return token, state - | LoadFromTokenResult.Found (token,events ) -> return foldI fold initial token events } - member __.TrySync (fold: 'state -> 'event seq -> 'state) initial (log : ILogger) - (token : Storage.StreamToken, state : 'state) - (events : 'event list, state' : 'state) : Async> = async { - let events, index = - match access with - | None | Some AccessStrategy.EventsAreState -> - events, None - | Some (AccessStrategy.RollingSnapshots (_,f)) -> - let cc = CompactionContext(List.length events, token.batchCapacityLimit.Value) - (if cc.IsCompactionDue then events @ [f state'] else events), None - | Some (AccessStrategy.IndexedSearch (_,index)) -> - events, Some (index state') - let encodedEvents : Store.EventData[] = UnionEncoderAdapters.encodeEvents codec (Seq.ofList events) - let maybeIndexEvents : Store.EventData[] option = index |> Option.map (UnionEncoderAdapters.encodeEvents codec) - let! syncRes = coll.Gateway.TrySync log token (encodedEvents,maybeIndexEvents) compactionPredicate - match syncRes with - | GatewaySyncResult.Conflict (token',events) -> return Storage.SyncResult.Conflict (async { return foldI fold initial token' events }) - | GatewaySyncResult.ConflictUnknown token' -> return Storage.SyncResult.Conflict (__.LoadFromToken fold initial state token' log) - | GatewaySyncResult.Written token' -> return Storage.SyncResult.Written (token', fold state (Seq.ofList events)) } + | LoadFromTokenResult.Unchanged -> return current + | LoadFromTokenResult.Found (token',events) -> return token', respond fold state events } + member __.Sync (Token.Unpack (stream,pos), state as current) (project: 'state -> 'event seq -> 'event seq) + (expectedVersion : int64 option, events, state') + fold predicate log + : Async> = async { + let encode = UnionEncoderAdapters.encodeEvent codec + let eventsEncoded, projectionsEncoded = Seq.map encode events |> Array.ofSeq, Seq.map encode (project state' events) + let baseIndex = pos.index + int64 (List.length events) + let projections = Sync.mkProjections baseIndex projectionsEncoded + let batch = Sync.mkBatch stream eventsEncoded projections + let! res = gateway.Sync log stream (expectedVersion,batch) + match res with + | InternalSyncResult.Conflict (token',events') -> return Storage.SyncResult.Conflict (async { return token', respond fold state events' }) + | InternalSyncResult.ConflictUnknown _token' -> return Storage.SyncResult.Conflict (__.LoadFromToken current fold predicate log) + | InternalSyncResult.Written token' -> return Storage.SyncResult.Written (token', state') } module Caching = open System.Runtime.Caching @@ -748,11 +858,12 @@ module Caching = interface ICategory<'event, 'state> with member __.Load (streamName : string) (log : ILogger) : Async = interceptAsync (inner.Load streamName log) streamName - member __.TrySync streamName (log : ILogger) (token, state) (events : 'event list, state' : 'state) : Async> = async { - let! syncRes = inner.TrySync streamName log (token, state) (events,state') + member __.TrySync (log : ILogger) (Token.Unpack (stream,_) as streamToken,state) (events : 'event list, state': 'state) + : Async> = async { + let! syncRes = inner.TrySync log (streamToken, state) (events,state') match syncRes with - | Storage.SyncResult.Conflict resync -> return Storage.SyncResult.Conflict (interceptAsync resync streamName) - | Storage.SyncResult.Written (token', state') -> return Storage.SyncResult.Written (intercept streamName (token', state')) } + | Storage.SyncResult.Conflict resync -> return Storage.SyncResult.Conflict (interceptAsync resync stream.name) + | Storage.SyncResult.Written (token', state') ->return Storage.SyncResult.Written (intercept stream.name (token', state')) } let applyCacheUpdatesWithSlidingExpiration (cache: Cache) @@ -764,111 +875,91 @@ module Caching = let addOrUpdateSlidingExpirationCacheEntry streamName = CacheEntry >> cache.UpdateIfNewer policy (prefix + streamName) CategoryTee<'event,'state>(category, addOrUpdateSlidingExpirationCacheEntry) :> _ -type private Folder<'event, 'state>(category : Category<'event, 'state>, fold: 'state -> 'event seq -> 'state, initial: 'state, ?readCache) = - let loadAlgorithm streamName initial log = - let batched = category.Load fold initial streamName log - let cached token state = category.LoadFromToken fold initial state token log - match readCache with - | None -> batched - | Some (cache : Caching.Cache, prefix : string) -> - match cache.TryGet(prefix + streamName) with - | None -> batched - | Some (token, state) -> cached token state +type private Folder<'event, 'state> + ( category : Category<'event, 'state>, fold: 'state -> 'event seq -> 'state, initial: 'state, + predicate : HashSet -> bool, + mkCollectionStream : string -> Store.CollectionStream, + // Whether or not a projection function is supplied controls whether reads consult the index or not + ?project: ('state -> 'event seq -> 'event seq), + ?readCache) = interface ICategory<'event, 'state> with - member __.Load (streamName : string) (log : ILogger) : Async = - loadAlgorithm streamName initial log - member __.TrySync _streamName(* TODO remove from main interface *) (log : ILogger) (token, state) (events : 'event list, state': 'state) : Async> = async { - let! syncRes = category.TrySync fold initial log (token, state) (events,state') + member __.Load streamName (log : ILogger): Async = + let collStream = mkCollectionStream streamName + let batched = category.Load (Option.isSome project) collStream fold initial predicate log + let cached tokenAndState = category.LoadFromToken tokenAndState fold predicate log + match readCache with + | None -> batched + | Some (cache : Caching.Cache, prefix : string) -> + match cache.TryGet(prefix + streamName) with + | None -> batched + | Some tokenAndState -> cached tokenAndState + member __.TrySync (log : ILogger) (Token.Unpack (_stream,pos) as streamToken,state) (events : 'event list, state': 'state) + : Async> = async { + let! syncRes = category.Sync (streamToken,state) (defaultArg project (fun _ _ -> Seq.empty)) (Some pos.index, events, state') fold predicate log match syncRes with - | Storage.SyncResult.Conflict resync -> return Storage.SyncResult.Conflict resync - | Storage.SyncResult.Written (token',state') -> return Storage.SyncResult.Written (token',state') } + | Storage.SyncResult.Conflict resync -> return Storage.SyncResult.Conflict resync + | Storage.SyncResult.Written (token',state') -> return Storage.SyncResult.Written (token',state') } + +/// Defines a process for mapping from a Stream Name to the appropriate storage area, allowing control over segregation / co-locating of data +type EqxCollections(selectDatabaseAndCollection : string -> string*string) = + new (databaseId, collectionId) = EqxCollections(fun _streamName -> databaseId, collectionId) + member __.CollectionForStream streamName = + let databaseId, collectionId = selectDatabaseAndCollection streamName + Store.CollectionStream.Create(Client.UriFactory.CreateDocumentCollectionUri(databaseId, collectionId), streamName) + +/// Pairs a Gateway, defining the retry policies for CosmosDb with an EqxCollections to +type EqxStore(gateway: EqxGateway, collections: EqxCollections) = + member __.Gateway = gateway + member __.Collections = collections [] type CachingStrategy = + /// Retain a single set of State, together with the associated etags + /// NB while a strategy like EventStore.Caching.SlidingWindowPrefixed is obviously easy to implement, the recommended approach is to + /// track all relevant data in the state, and/or have the `project` function ensure all relevant events get indexed quickly | SlidingWindow of Caching.Cache * window: TimeSpan - /// Prefix is used to distinguish multiple folds per stream - | SlidingWindowPrefixed of Caching.Cache * window: TimeSpan * prefix: string - -type EqxStreamBuilder<'event, 'state>(gateway : EqxGateway, codec, fold, initial, ?access, ?caching) = - member __.Create (databaseId, collectionId, streamName) : Equinox.IStream<'event, 'state> = - let category = Category<'event, 'state>(Collection(gateway, databaseId, collectionId), codec, ?access = access) +[] +type AccessStrategy<'event,'state> = + /// Require a configurable Set of Event Types to have been accumulated from a) projections + b) searching backward in the event stream + /// until `resolved` deems it so; fold foward based on those + /// When saving, `project` the 'state to seed the set of events that `resolved` will see first + | Projections of resolved: (ISet -> bool) * project: ('state -> 'event seq) + /// Simplified version of projection that only has a single Projection Event Type + /// Provides equivalent performance to Projections, just simplified function signatures + | Projection of eventType: string * ('state -> 'event) + /// Simplified version + | AnyKnownEventType of eventTypes: ISet + +type EqxStreamBuilder<'event, 'state>(store : EqxStore, codec, fold, initial, ?access, ?caching) = + member __.Create streamName : Equinox.IStream<'event, 'state> = let readCacheOption = match caching with | None -> None | Some (CachingStrategy.SlidingWindow(cache, _)) -> Some(cache, null) - | Some (CachingStrategy.SlidingWindowPrefixed(cache, _, prefix)) -> Some(cache, prefix) - let folder = Folder<'event, 'state>(category, fold, initial, ?readCache = readCacheOption) + let predicate, projectOption = + match access with + | None -> (fun _ -> false), None + | Some (AccessStrategy.Projections (predicate,project)) -> + predicate, + Some (fun state _events -> project state) + | Some (AccessStrategy.Projection (et,compact)) -> + (fun (ets: HashSet) -> ets.Contains et), + Some (fun state _events -> seq [compact state]) + | Some (AccessStrategy.AnyKnownEventType knownEventTypes) -> + (fun (ets: HashSet) -> knownEventTypes.Overlaps ets), + Some (fun _ events -> Seq.last events |> Seq.singleton) + let category = Category<'event, 'state>(store.Gateway, codec) + let folder = Folder<'event, 'state>(category, fold, initial, predicate, store.Collections.CollectionForStream, ?project=projectOption, ?readCache = readCacheOption) let category : ICategory<_,_> = match caching with | None -> folder :> _ | Some (CachingStrategy.SlidingWindow(cache, window)) -> Caching.applyCacheUpdatesWithSlidingExpiration cache null window folder - | Some (CachingStrategy.SlidingWindowPrefixed(cache, window, prefix)) -> - Caching.applyCacheUpdatesWithSlidingExpiration cache prefix window folder Equinox.Stream.create category streamName -module Initialization = - let createDatabase (client:IDocumentClient) dbName = async { - let opts = Client.RequestOptions(ConsistencyLevel = Nullable ConsistencyLevel.Session) - let! db = client.CreateDatabaseIfNotExistsAsync(Database(Id=dbName), options = opts) |> Async.AwaitTaskCorrect - return db.Resource.Id } - - let createCollection (client: IDocumentClient) (dbUri: Uri) collName ru = async { - let pkd = PartitionKeyDefinition() - pkd.Paths.Add(sprintf "/%s" Store.Event.PartitionKeyField) - let colld = DocumentCollection(Id = collName, PartitionKey = pkd) - - colld.IndexingPolicy.IndexingMode <- IndexingMode.Consistent - colld.IndexingPolicy.Automatic <- true - // Can either do a blacklist or a whitelist - // Given how long and variable the blacklist would be, we whitelist instead - colld.IndexingPolicy.ExcludedPaths <- System.Collections.ObjectModel.Collection [|ExcludedPath(Path="/*")|] - // NB its critical to index the nominated PartitionKey field defined above or there will be runtime errors - colld.IndexingPolicy.IncludedPaths <- System.Collections.ObjectModel.Collection [| for k in Store.Event.IndexedFields -> IncludedPath(Path=sprintf "/%s/?" k) |] - let! coll = client.CreateDocumentCollectionIfNotExistsAsync(dbUri, colld, Client.RequestOptions(OfferThroughput=Nullable ru)) |> Async.AwaitTaskCorrect - return coll.Resource.Id } - - let createProc (client: IDocumentClient) (collectionUri: Uri) = async { - let f = """function indexedWrite(docs, expectedVersion, etag, index) { - var response = getContext().getResponse(); - var collection = getContext().getCollection(); - var collectionLink = collection.getSelfLink(); - if (!docs) throw new Error("docs argument is missing."); - if (index) { - function callback(err, doc, options) { - if (err) throw err; - response.setBody({ etag: doc._etag, conflicts: null }); - } - if (-1 == expectedVersion) { - collection.createDocument(collectionLink, index, { disableAutomaticIdGeneration : true}, callback); - } else { - collection.replaceDocument(collection.getAltLink() + "/docs/" + index.id, index, callback); - } - } else { - // call always expects a parseable json response with `etag` and `conflicts` - // can also contain { conflicts: [{t, d}] } representing conflicting events since expectedVersion - // null/missing signifies events have been written, with no conflict - response.setBody({ etag: null, conflicts: null }); - } - for (var i=0; i Async.AwaitTaskCorrect |> Async.Ignore } - - let initialize (client : IDocumentClient) dbName collName ru = async { - let! dbId = createDatabase client dbName - let dbUri = Client.UriFactory.CreateDatabaseUri dbId - let! collId = createCollection client dbUri collName ru - let collUri = Client.UriFactory.CreateDocumentCollectionUri (dbName, collId) - //let! _aux = createAux client dbUri collName auxRu - return! createProc client collUri - } - [] type Discovery = | UriAndKey of databaseUri:Uri * key:string @@ -942,4 +1033,165 @@ type EqxConnector /// Yields a DocDbConnection configured per the specified strategy member __.Connect(name, discovery : Discovery) : Async = async { let! conn = connect(name, discovery) - return EqxConnection(conn, ?readRetryPolicy=readRetryPolicy, ?writeRetryPolicy=writeRetryPolicy) } \ No newline at end of file + return EqxConnection(conn, ?readRetryPolicy=readRetryPolicy, ?writeRetryPolicy=writeRetryPolicy) } + +namespace Equinox.Cosmos.Core + +open Equinox.Cosmos +open Equinox.Cosmos.Builder +open Equinox.Cosmos.Events +open FSharp.Control +open Equinox + +/// Outcome of appending events, specifying the new and/or conflicting events, together with the updated Target write position +[] +type AppendResult<'t> = + | Ok of pos: 't + | Conflict of index: 't * conflictingEvents: IOrderedEvent[] + | ConflictUnknown of index: 't + +/// Encapsulates the core facilites Equinox.Cosmos offers for operating directly on Events in Streams. +type EqxContext + ( /// Connection to CosmosDb with DocumentDb Transient Read and Write Retry policies + conn : EqxConnection, + /// Database + Collection selector + collections: EqxCollections, + /// Logger to write to - see https://github.com/serilog/serilog/wiki/Provided-Sinks for how to wire to your logger + logger : Serilog.ILogger, + /// Optional maximum number of Store.Batch records to retrieve as a set (how many Events are placed therein is controlled by maxEventsPerSlice). + /// Defaults to 10 + ?defaultMaxItems, + /// Alternate way of specifying defaultMaxItems which facilitates reading it from a cached dynamic configuration + ?getDefaultMaxItems) = + let getDefaultMaxItems = match getDefaultMaxItems with Some f -> f | None -> fun () -> defaultArg defaultMaxItems 10 + let batching = EqxBatchingPolicy(getDefaultMaxItems=getDefaultMaxItems) + let gateway = EqxGateway(conn, batching) + + let maxCountPredicate count = + let acc = ref (max (count-1) 0) + fun _ -> + if !acc = 0 then true else + decr acc + false + + let yieldPositionAndData res = async { + let! (Token.Unpack (_,pos')), data = res + return pos', data } + + member __.CreateStream(streamName) = collections.CollectionForStream streamName + + member internal __.GetInternal((stream, startPos), ?maxCount, ?direction) = async { + let direction = defaultArg direction Direction.Forward + if maxCount = Some 0 then + // Search semantics include the first hit so we need to special case this anyway + return Token.create stream (defaultArg startPos Position.FromKnownEmpty), Array.empty + else + let predicate = + match maxCount with + | Some limit -> maxCountPredicate limit + | None -> fun _ -> false + return! gateway.Read logger None stream direction startPos predicate } + + /// Establishes the current position of the stream in as effficient a manner as possible + /// (The ideal situation is that the preceding token is supplied as input in order to avail of 1RU low latency state checks) + member __.Sync(stream, ?position: Position) : Async = async { + //let indexed predicate = load fold initial (coll.Gateway.IndexedOrBatched log predicate (stream,None)) + let! (Token.Unpack (_,pos')) = gateway.GetPosition(logger, stream, ?pos=position) + return pos' } + + /// Reads in batches of `batchSize` from the specified `Position`, allowing the reader to efficiently walk away from a running query + /// ... NB as long as they Dispose! + member __.Walk(stream, batchSize, ?position, ?direction) : AsyncSeq = asyncSeq { + let! _pos,data = __.GetInternal((stream, position), batchSize, ?direction=direction) + // TODO add laziness + return AsyncSeq.ofSeq data } + + /// Reads all Events from a `Position` in a given `direction` + member __.Read(stream, ?position, ?maxCount, ?direction) : Async = + __.GetInternal((stream, position), ?maxCount=maxCount, ?direction=direction) |> yieldPositionAndData + + /// Appends the supplied batch of events, subject to a consistency check based on the `position` + /// Callers should implement appropriate idempotent handling, or use Equinox.Handler for that purpose + member __.Sync(stream, position, events: IEvent[]) : Async> = async { + let batch = Sync.mkBatch stream events Seq.empty + let! res = gateway.Sync logger stream (Some position.index,batch) + match res with + | Builder.Internal.InternalSyncResult.Written (Token.Unpack (_,pos)) -> return AppendResult.Ok pos + | Builder.Internal.InternalSyncResult.Conflict (Token.Unpack (_,pos),events) -> return AppendResult.Conflict (pos, events) + | Builder.Internal.InternalSyncResult.ConflictUnknown (Token.Unpack (_,pos)) -> return AppendResult.ConflictUnknown pos } + + /// Low level, non-idempotent call appending events to a stream without a concurrency control mechanism in play + /// NB Should be used sparingly; Equinox.Handler enables building equivalent equivalent idempotent handling with minimal code. + member __.NonIdempotentAppend(stream, events: IEvent[]) : Async = async { + let! res = __.Sync(stream, Position.FromAppendAtEnd, events) + match res with + | AppendResult.Ok token -> return token + | x -> return x |> sprintf "Conflict despite it being disabled %A" |> invalidOp } + +/// Api as defined in the Equinox Specification +/// Note the EqxContext APIs can yield better performance due to the fact that a Position tracks the etag of the Stream's WipBatch +module Events = + let private (|PositionIndex|) (x: Position) = x.index + let private stripSyncResult (f: Async>): Async> = async { + let! res = f + match res with + | AppendResult.Ok (PositionIndex index)-> return AppendResult.Ok index + | AppendResult.Conflict (PositionIndex index,events) -> return AppendResult.Conflict (index, events) + | AppendResult.ConflictUnknown (PositionIndex index) -> return AppendResult.ConflictUnknown index } + let private stripPosition (f: Async): Async = async { + let! (PositionIndex index) = f + return index } + let private dropPosition (f: Async): Async = async { + let! _,xs = f + return xs } + let (|MinPosition|) = function + | 0L -> None + | i -> Some (Position.FromI i) + let (|MaxPosition|) = function + | int64.MaxValue -> None + | i -> Some (Position.FromI (i + 1L)) + + /// Returns an aFromLastIndexs in the stream starting at the specified sequence number, + /// reading in batches of the specified size. + /// Returns an empty sequence if the stream is empty or if the sequence number is larger than the largest + /// sequence number in the stream. + let getAll (ctx: EqxContext) (streamName: string) (MinPosition index: int64) (batchSize: int): AsyncSeq = + ctx.Walk(ctx.CreateStream streamName, batchSize,?position=index) + + /// Returns an async array of events in the stream starting at the specified sequence number, + /// number of events to read is specified by batchSize + /// Returns an empty sequence if the stream is empty or if the sequence number is larger than the largest + /// sequence number in the stream. + let get (ctx: EqxContext) (streamName: string) (MinPosition index: int64) (maxCount: int): Async = + ctx.Read(ctx.CreateStream streamName, ?position=index, maxCount=maxCount) |> dropPosition + + /// Appends a batch of events to a stream at the specified expected sequence number. + /// If the specified expected sequence number does not match the stream, the events are not appended + /// and a failure is returned. + let append (ctx: EqxContext) (streamName: string) (index: int64) (events: IEvent[]): Async> = + ctx.Sync(ctx.CreateStream streamName, Position.FromI index, events) |> stripSyncResult + + /// Appends a batch of events to a stream at the the present Position without any conflict checks. + /// NB typically, it is recommended to ensure idempotency of operations by using the `append` and related API as + /// this facilitates ensuring consistency is maintained, and yields reduced latency and Request Charges impacts + /// (See equivalent APIs on `Context` that yield `Position` values) + let appendAtEnd (ctx: EqxContext) (streamName: string) (events: IEvent[]): Async = + ctx.NonIdempotentAppend(ctx.CreateStream streamName, events) |> stripPosition + + /// Returns an async sequence of events in the stream backwards starting from the specified sequence number, + /// reading in batches of the specified size. + /// Returns an empty sequence if the stream is empty or if the sequence number is smaller than the smallest + /// sequence number in the stream. + let getAllBackwards (ctx: EqxContext) (streamName: string) (MaxPosition index: int64) (maxCount: int): AsyncSeq = + ctx.Walk(ctx.CreateStream streamName, maxCount, ?position=index, direction=Direction.Backward) + + /// Returns an async array of events in the stream backwards starting from the specified sequence number, + /// number of events to read is specified by batchSize + /// Returns an empty sequence if the stream is empty or if the sequence number is smaller than the smallest + /// sequence number in the stream. + let getBackwards (ctx: EqxContext) (streamName: string) (MaxPosition index: int64) (maxCount: int): Async = + ctx.Read(ctx.CreateStream streamName, ?position=index, maxCount=maxCount, direction=Direction.Backward) |> dropPosition + + /// Obtains the `index` from the current write Position + let getNextIndex (ctx: EqxContext) (streamName: string) : Async = + ctx.Sync(ctx.CreateStream streamName) |> stripPosition \ No newline at end of file diff --git a/src/Equinox.Cosmos/Equinox.Cosmos.fsproj b/src/Equinox.Cosmos/Equinox.Cosmos.fsproj index c577971a0..97c20b955 100644 --- a/src/Equinox.Cosmos/Equinox.Cosmos.fsproj +++ b/src/Equinox.Cosmos/Equinox.Cosmos.fsproj @@ -11,6 +11,7 @@ + diff --git a/tests/Equinox.Cosmos.Integration/CosmosCoreIntegration.fs b/tests/Equinox.Cosmos.Integration/CosmosCoreIntegration.fs new file mode 100644 index 000000000..02b52c051 --- /dev/null +++ b/tests/Equinox.Cosmos.Integration/CosmosCoreIntegration.fs @@ -0,0 +1,270 @@ +module Equinox.Cosmos.Integration.CoreIntegration + +open Equinox.Cosmos.Integration.Infrastructure +open Equinox.Cosmos +open Equinox.Cosmos.Core +open FSharp.Control +open Newtonsoft.Json.Linq +open Swensen.Unquote +open Serilog +open System +open System.Text + +#nowarn "1182" // From hereon in, we may have some 'unused' privates (the tests) + +type EventData = { eventType: string; data: byte[] } with + interface Events.IEvent with + member __.EventType = __.eventType + member __.Data = __.data + member __.Meta = Encoding.UTF8.GetBytes("{\"m\":\"m\"}") + static member private Create(i, ?eventType, ?json) : Events.IEvent = + { eventType = sprintf "%s:%d" (defaultArg eventType "test_event") i + data = System.Text.Encoding.UTF8.GetBytes(defaultArg json "{\"d\":\"d\"}") } :> _ + static member Create(i, c) = Array.init c (fun x -> EventData.Create(x+i)) + +type Tests(testOutputHelper) = + inherit TestsWithLogCapture(testOutputHelper) + let log, capture = base.Log, base.Capture + + /// As we generate side-effects per run, we want each FSCheck-triggered invocation of the test run to work in its own stream + let testIterations = ref 0 + let (|TestStream|) (name: Guid) = + incr testIterations + sprintf "events-%O-%i" name !testIterations + let mkContextWithItemLimit conn defaultBatchSize = + EqxContext(conn,collections,log,?defaultMaxItems=defaultBatchSize) + let mkContext conn = mkContextWithItemLimit conn None + + let verifyRequestChargesMax rus = + let tripRequestCharges = [ for e, c in capture.RequestCharges -> sprintf "%A" e, c ] + test <@ float rus >= Seq.sum (Seq.map snd tripRequestCharges) @> + + [] + let append (TestStream streamName) = Async.RunSynchronously <| async { + let! conn = connectToSpecifiedCosmosOrSimulator log + let ctx = mkContext conn + + let index = 0L + let! res = Events.append ctx streamName index <| EventData.Create(0,1) + test <@ AppendResult.Ok 1L = res @> + test <@ [EqxAct.Append] = capture.ExternalCalls @> + verifyRequestChargesMax 14 // observed 12.03 // was 10 + // Clear the counters + capture.Clear() + + let! res = Events.append ctx streamName 1L <| EventData.Create(1,5) + test <@ AppendResult.Ok 6L = res @> + test <@ [EqxAct.Append] = capture.ExternalCalls @> + // We didnt request small batches or splitting so it's not dramatically more expensive to write N events + verifyRequestChargesMax 30 // observed 26.62 was 11 + } + + let blobEquals (x: byte[]) (y: byte[]) = System.Linq.Enumerable.SequenceEqual(x,y) + let stringOfUtf8 (x: byte[]) = Encoding.UTF8.GetString(x) + let xmlDiff (x: string) (y: string) = + match JsonDiffPatchDotNet.JsonDiffPatch().Diff(JToken.Parse x,JToken.Parse y) with + | null -> "" + | d -> string d + let verifyUtf8JsonEquals i x y = + let sx,sy = stringOfUtf8 x, stringOfUtf8 y + test <@ ignore i; blobEquals x y || "" = xmlDiff sx sy @> + + let add6EventsIn2Batches ctx streamName = async { + let index = 0L + let! res = Events.append ctx streamName index <| EventData.Create(0,1) + + test <@ AppendResult.Ok 1L = res @> + let! res = Events.append ctx streamName 1L <| EventData.Create(1,5) + test <@ AppendResult.Ok 6L = res @> + // Only start counting RUs from here + capture.Clear() + return EventData.Create(0,6) + } + + let verifyCorrectEventsEx direction baseIndex (expected: Events.IEvent []) (xs: Events.IOrderedEvent[]) = + let xs, baseIndex = + if direction = Direction.Forward then xs, baseIndex + else Array.rev xs, baseIndex - int64 (Array.length expected) + 1L + test <@ expected.Length = xs.Length @> + test <@ [for i in 0..expected.Length - 1 -> baseIndex + int64 i] = [for r in xs -> r.Index] @> + test <@ [for e in expected -> e.EventType] = [ for r in xs -> r.EventType ] @> + for i,x,y in Seq.mapi2 (fun i x y -> i,x,y) [for e in expected -> e.Data] [for r in xs -> r.Data] do + verifyUtf8JsonEquals i x y + let verifyCorrectEventsBackward = verifyCorrectEventsEx Direction.Backward + let verifyCorrectEvents = verifyCorrectEventsEx Direction.Forward + + [] + let ``appendAtEnd and getNextIndex`` (extras, TestStream streamName) = Async.RunSynchronously <| async { + let! conn = connectToSpecifiedCosmosOrSimulator log + let ctx = mkContextWithItemLimit conn (Some 1) + + // If a fail triggers a rerun, we need to dump the previous log entries captured + capture.Clear() + let! pos = Events.getNextIndex ctx streamName + test <@ [EqxAct.IndexNotFound] = capture.ExternalCalls @> + 0L =! pos + verifyRequestChargesMax 1 // for a 404 by definition + capture.Clear() + + let mutable pos = 0L + let ae = false // TODO fix bug + for appendBatchSize in [4; 5; 9] do + if ae then + let! res = Events.appendAtEnd ctx streamName <| EventData.Create (int pos,appendBatchSize) + pos <- pos + int64 appendBatchSize + //let! res = Events.append ctx streamName pos (Array.replicate appendBatchSize event) + test <@ [EqxAct.Append] = capture.ExternalCalls @> + pos =! res + else + let! res = Events.append ctx streamName pos <| EventData.Create (int pos,appendBatchSize) + pos <- pos + int64 appendBatchSize + //let! res = Events.append ctx streamName pos (Array.replicate appendBatchSize event) + test <@ [EqxAct.Append] = capture.ExternalCalls @> + AppendResult.Ok pos =! res + verifyRequestChargesMax 50 // was 20, observed 41.64 // 15.59 observed + capture.Clear() + + let! res = Events.appendAtEnd ctx streamName <| EventData.Create (int pos,42) + pos <- pos + 42L + pos =! res + test <@ [EqxAct.Append] = capture.ExternalCalls @> + verifyRequestChargesMax 180 // observed 167.32 // was 20 + capture.Clear() + + let! res = Events.getNextIndex ctx streamName + test <@ [EqxAct.Index] = capture.ExternalCalls @> + verifyRequestChargesMax 2 + capture.Clear() + pos =! res + + // Demonstrate benefit/mechanism for using the Position-based API to avail of the etag tracking + let stream = ctx.CreateStream streamName + + let max = 2000 // observed to time out server side // WAS 5000 + let extrasCount = match extras with x when x * 100 > max -> max | x when x < 1 -> 1 | x -> x*100 + let! _pos = ctx.NonIdempotentAppend(stream, EventData.Create (int pos,extrasCount)) + test <@ [EqxAct.Append] = capture.ExternalCalls @> + verifyRequestChargesMax 7000 // 6867.7 observed // was 300 // 278 observed + capture.Clear() + + let! pos = ctx.Sync(stream,?position=None) + test <@ [EqxAct.Index] = capture.ExternalCalls @> + verifyRequestChargesMax 50 // 41 observed // for a 200, you'll pay a lot (we omitted to include the position that NonIdempotentAppend yielded) + capture.Clear() + + let! _pos = ctx.Sync(stream,pos) + test <@ [EqxAct.IndexNotModified] = capture.ExternalCalls @> + verifyRequestChargesMax 1 // for a 302 by definition - when an etag IfNotMatch is honored, you only pay one RU + capture.Clear() + } + + [] + let ``append - fails on non-matching`` (TestStream streamName) = Async.RunSynchronously <| async { + let! conn = connectToSpecifiedCosmosOrSimulator log + let ctx = mkContext conn + + // Attempt to write, skipping Index 0 + let! res = Events.append ctx streamName 1L <| EventData.Create(0,1) + test <@ [EqxAct.Resync] = capture.ExternalCalls @> + // The response aligns with a normal conflict in that it passes the entire set of conflicting events () + test <@ AppendResult.Conflict (0L,[||]) = res @> + verifyRequestChargesMax 5 + capture.Clear() + + // Now write at the correct position + let expected = EventData.Create(1,1) + let! res = Events.append ctx streamName 0L expected + test <@ AppendResult.Ok 1L = res @> + test <@ [EqxAct.Append] = capture.ExternalCalls @> + verifyRequestChargesMax 12 // was 10, observed 10.57 + capture.Clear() + + // Try overwriting it (a competing consumer would see the same) + let! res = Events.append ctx streamName 0L <| EventData.Create(-42,2) + // This time we get passed the conflicting events - we pay a little for that, but that's unavoidable + match res with + | AppendResult.Conflict (1L, e) -> verifyCorrectEvents 0L expected e + | x -> x |> failwithf "Unexpected %A" + test <@ [EqxAct.Resync] = capture.ExternalCalls @> + verifyRequestChargesMax 5 // observed 4.21 // was 4 + capture.Clear() + } + + (* Forward *) + + [] + let get (TestStream streamName) = Async.RunSynchronously <| async { + let! conn = connectToSpecifiedCosmosOrSimulator log + let ctx = mkContextWithItemLimit conn (Some 3) + + // We're going to ignore the first, to prove we can + let! expected = add6EventsIn2Batches ctx streamName + let expected = Array.tail expected + + let! res = Events.get ctx streamName 1L 10 + + verifyCorrectEvents 1L expected res + + test <@ List.replicate 2 EqxAct.SliceForward @ [EqxAct.BatchForward] = capture.ExternalCalls @> + verifyRequestChargesMax 8 // observed 6.14 // was 3 + } + + [] + let ``get (in 2 batches)`` (TestStream streamName) = Async.RunSynchronously <| async { + let! conn = connectToSpecifiedCosmosOrSimulator log + let ctx = mkContextWithItemLimit conn (Some 2) + + let! expected = add6EventsIn2Batches ctx streamName + let expected = Array.tail expected |> Array.take 3 + + let! res = Events.get ctx streamName 1L 3 + + verifyCorrectEvents 1L expected res + + // 2 items atm + test <@ [EqxAct.SliceForward; EqxAct.SliceForward; EqxAct.BatchForward] = capture.ExternalCalls @> + verifyRequestChargesMax 7 // observed 6.14 // was 6 + } + + [] + let getAll (TestStream streamName) = Async.RunSynchronously <| async { + let! conn = connectToSpecifiedCosmosOrSimulator log + let ctx = mkContextWithItemLimit conn (Some 2) + + let! expected = add6EventsIn2Batches ctx streamName + + let! res = Events.get ctx streamName 1L 4 // Events.getAll >> AsyncSeq.concatSeq |> AsyncSeq.toArrayAsync + let expected = expected |> Array.tail |> Array.take 4 + + verifyCorrectEvents 1L expected res + + // TODO [implement and] prove laziness + test <@ List.replicate 2 EqxAct.SliceForward @ [EqxAct.BatchForward] = capture.ExternalCalls @> + verifyRequestChargesMax 10 // observed 8.99 // was 3 + } + + (* Backward *) + + [] + let getBackwards (TestStream streamName) = Async.RunSynchronously <| async { + let! conn = connectToSpecifiedCosmosOrSimulator log + let ctx = mkContextWithItemLimit conn (Some 2) + + let! expected = add6EventsIn2Batches ctx streamName + + // We want to skip reading the last + let expected = Array.take 5 expected + + let! res = Events.getBackwards ctx streamName 4L 5 + + verifyCorrectEventsBackward 4L expected res + + test <@ List.replicate 3 EqxAct.SliceBackward @ [EqxAct.BatchBackward] = capture.ExternalCalls @> + verifyRequestChargesMax 10 // observed 8.98 // was 3 + } + + // TODO AsyncSeq version + + // TODO 2 batches backward test + + // TODO mine other integration tests \ No newline at end of file diff --git a/tests/Equinox.Cosmos.Integration/CosmosFixtures.fs b/tests/Equinox.Cosmos.Integration/CosmosFixtures.fs index 7a3192c20..467c1bf57 100644 --- a/tests/Equinox.Cosmos.Integration/CosmosFixtures.fs +++ b/tests/Equinox.Cosmos.Integration/CosmosFixtures.fs @@ -1,9 +1,12 @@ [] module Equinox.Cosmos.Integration.CosmosFixtures -open Equinox.Cosmos +open Equinox.Cosmos.Builder open System +module Option = + let defaultValue def option = defaultArg option def + /// Standing up an Equinox instance is necessary to run for test purposes; either: /// - replace connection below with a connection string or Uri+Key for an initialized Equinox instance /// - Create a local Equinox via dotnet run cli/Equinox.cli -s $env:EQUINOX_COSMOS_CONNECTION -d test -c $env:EQUINOX_COSMOS_COLLECTION provision -ru 10000 @@ -11,6 +14,7 @@ let private connectToCosmos (log: Serilog.ILogger) name discovery = EqxConnector(log=log, requestTimeout=TimeSpan.FromSeconds 3., maxRetryAttemptsOnThrottledRequests=2, maxRetryWaitTimeInSeconds=60) .Connect(name, discovery) let private read env = Environment.GetEnvironmentVariable env |> Option.ofObj +let (|Default|) def name = (read name),def ||> defaultArg let connectToSpecifiedCosmosOrSimulator (log: Serilog.ILogger) = match read "EQUINOX_COSMOS_CONNECTION" with @@ -21,9 +25,13 @@ let connectToSpecifiedCosmosOrSimulator (log: Serilog.ILogger) = Discovery.FromConnectionString connectionString |> connectToCosmos log "EQUINOX_COSMOS_CONNECTION" -let (|StreamArgs|) streamName = - let databaseId, collectionId = defaultArg (read "EQUINOX_COSMOS_DATABASE") "equinox-test", defaultArg (read "EQUINOX_COSMOS_COLLECTION") "equinox-test" - databaseId, collectionId, streamName - let defaultBatchSize = 500 -let createEqxGateway connection batchSize = EqxGateway(connection, EqxBatchingPolicy(maxBatchSize = batchSize)) \ No newline at end of file + +let collections = + EqxCollections( + read "EQUINOX_COSMOS_DATABASE" |> Option.defaultValue "equinox-test", + read "EQUINOX_COSMOS_COLLECTION" |> Option.defaultValue "equinox-test") + +let createEqxStore connection batchSize = + let gateway = EqxGateway(connection, EqxBatchingPolicy(defaultMaxItems=batchSize)) + EqxStore(gateway, collections) \ No newline at end of file diff --git a/tests/Equinox.Cosmos.Integration/CosmosFixturesInfrastructure.fs b/tests/Equinox.Cosmos.Integration/CosmosFixturesInfrastructure.fs index 31fc6d2cb..1a88db4e2 100644 --- a/tests/Equinox.Cosmos.Integration/CosmosFixturesInfrastructure.fs +++ b/tests/Equinox.Cosmos.Integration/CosmosFixturesInfrastructure.fs @@ -3,7 +3,9 @@ module Equinox.Cosmos.Integration.Infrastructure open Domain open FsCheck +open Serilog open System +open Serilog.Core type FsCheckGenerators = static member SkuId = Arb.generate |> Gen.map SkuId |> Arb.fromGen @@ -37,30 +39,53 @@ type TestOutputAdapter(testOutput : Xunit.Abstractions.ITestOutputHelper) = [] module SerilogHelpers = - open Serilog open Serilog.Events let createLogger sink = LoggerConfiguration() .WriteTo.Sink(sink) + .WriteTo.Seq("http://localhost:5341") .CreateLogger() let (|SerilogScalar|_|) : Serilog.Events.LogEventPropertyValue -> obj option = function | (:? ScalarValue as x) -> Some x.Value | _ -> None + open Equinox.Cosmos [] - type EqxAct = Append | AppendConflict | SliceForward | SliceBackward | BatchForward | BatchBackward | Indexed | IndexedNotFound | IndexedCached + type EqxAct = Append | Resync | Conflict | SliceForward | SliceBackward | BatchForward | BatchBackward | Index | IndexNotFound | IndexNotModified | SliceWaste let (|EqxAction|) (evt : Equinox.Cosmos.Log.Event) = match evt with - | Equinox.Cosmos.Log.WriteSuccess _ -> EqxAct.Append - | Equinox.Cosmos.Log.WriteConflict _ -> EqxAct.AppendConflict - | Equinox.Cosmos.Log.Slice (Equinox.Cosmos.Direction.Forward,_) -> EqxAct.SliceForward - | Equinox.Cosmos.Log.Slice (Equinox.Cosmos.Direction.Backward,_) -> EqxAct.SliceBackward - | Equinox.Cosmos.Log.Batch (Equinox.Cosmos.Direction.Forward,_,_) -> EqxAct.BatchForward - | Equinox.Cosmos.Log.Batch (Equinox.Cosmos.Direction.Backward,_,_) -> EqxAct.BatchBackward - | Equinox.Cosmos.Log.Index _ -> EqxAct.Indexed - | Equinox.Cosmos.Log.IndexNotFound _ -> EqxAct.IndexedNotFound - | Equinox.Cosmos.Log.IndexNotModified _ -> EqxAct.IndexedCached + | Log.WriteSuccess _ -> EqxAct.Append + | Log.WriteResync _ -> EqxAct.Resync + | Log.WriteConflict _ -> EqxAct.Conflict + | Log.Slice (Direction.Forward,{count = 0}) -> EqxAct.SliceWaste // TODO remove, see comment where these are emitted + | Log.Slice (Direction.Forward,_) -> EqxAct.SliceForward + | Log.Slice (Direction.Backward,{count = 0}) -> EqxAct.SliceWaste // TODO remove, see comment where these are emitted + | Log.Slice (Direction.Backward,_) -> EqxAct.SliceBackward + | Log.Batch (Direction.Forward,_,_) -> EqxAct.BatchForward + | Log.Batch (Direction.Backward,_,_) -> EqxAct.BatchBackward + | Log.Index _ -> EqxAct.Index + | Log.IndexNotFound _ -> EqxAct.IndexNotFound + | Log.IndexNotModified _ -> EqxAct.IndexNotModified + let inline (|Stats|) ({ ru = ru }: Equinox.Cosmos.Log.Measurement) = ru + let (|CosmosReadRu|CosmosWriteRu|CosmosResyncRu|CosmosSliceRu|) (evt : Equinox.Cosmos.Log.Event) = + match evt with + | Log.Index (Stats s) + | Log.IndexNotFound (Stats s) + | Log.IndexNotModified (Stats s) + | Log.Batch (_,_, (Stats s)) -> CosmosReadRu s + | Log.WriteSuccess (Stats s) + | Log.WriteConflict (Stats s) -> CosmosWriteRu s + | Log.WriteResync (Stats s) -> CosmosResyncRu s + // slices are rolled up into batches so be sure not to double-count + | Log.Slice (_,Stats s) -> CosmosSliceRu s + /// Facilitates splitting between events with direct charges vs synthetic events Equinox generates to avoid double counting + let (|CosmosRequestCharge|EquinoxChargeRollup|) c = + match c with + | CosmosSliceRu _ -> + EquinoxChargeRollup + | CosmosReadRu rc | CosmosWriteRu rc | CosmosResyncRu rc as e -> + CosmosRequestCharge (e,rc) let (|EqxEvent|_|) (logEvent : LogEvent) : Equinox.Cosmos.Log.Event option = logEvent.Properties.Values |> Seq.tryPick (function | SerilogScalar (:? Equinox.Cosmos.Log.Event as e) -> Some e @@ -80,6 +105,26 @@ module SerilogHelpers = captured.Add logEvent interface Serilog.Core.ILogEventSink with member __.Emit logEvent = writeSerilogEvent logEvent member __.Clear () = captured.Clear() - member __.Entries = captured.ToArray() member __.ChooseCalls chooser = captured |> Seq.choose chooser |> List.ofSeq - member __.ExternalCalls = __.ChooseCalls (function EqxEvent (EqxAction act) -> Some act | _ -> None) \ No newline at end of file + member __.ExternalCalls = __.ChooseCalls (function EqxEvent (EqxAction act) (*when act <> EqxAct.Waste*) -> Some act | _ -> None) + member __.RequestCharges = __.ChooseCalls (function EqxEvent (CosmosRequestCharge e) -> Some e | _ -> None) + +type TestsWithLogCapture(testOutputHelper) = + let log, capture = TestsWithLogCapture.CreateLoggerWithCapture testOutputHelper + + /// NB the returned Logger must be Dispose()'d to guarantee all log output has been flushed upon completion of a test + static member CreateLoggerWithCapture testOutputHelper : Logger* LogCaptureBuffer = + let testOutput = TestOutputAdapter testOutputHelper + let capture = LogCaptureBuffer() + let logger = + Serilog.LoggerConfiguration() + .WriteTo.Seq("http://localhost:5341") + .WriteTo.Sink(testOutput) + .WriteTo.Sink(capture) + .CreateLogger() + logger, capture + + member __.Capture = capture + member __.Log = log + + interface IDisposable with member __.Dispose() = log.Dispose() \ No newline at end of file diff --git a/tests/Equinox.Cosmos.Integration/CosmosIntegration.fs b/tests/Equinox.Cosmos.Integration/CosmosIntegration.fs index a7ef73ff2..a0019a3d9 100644 --- a/tests/Equinox.Cosmos.Integration/CosmosIntegration.fs +++ b/tests/Equinox.Cosmos.Integration/CosmosIntegration.fs @@ -1,10 +1,10 @@ module Equinox.Cosmos.Integration.CosmosIntegration +open Domain open Equinox.Cosmos.Integration.Infrastructure -open Equinox.Cosmos +open Equinox.Cosmos.Builder open Swensen.Unquote open System.Threading -open Serilog open System let serializationSettings = Newtonsoft.Json.Converters.FSharp.Settings.CreateCorrect() @@ -12,53 +12,38 @@ let genCodec<'Union when 'Union :> TypeShape.UnionContract.IUnionContract>() = Equinox.UnionCodec.JsonUtf8.Create<'Union>(serializationSettings) module Cart = - let fold, initial, compact, index = Domain.Cart.Folds.fold, Domain.Cart.Folds.initial, Domain.Cart.Folds.compact, Domain.Cart.Folds.index + let fold, initial, project = Domain.Cart.Folds.fold, Domain.Cart.Folds.initial, Domain.Cart.Folds.compact let codec = genCodec() let createServiceWithoutOptimization connection batchSize log = - let gateway = createEqxGateway connection batchSize - let resolveStream (StreamArgs args) = - EqxStreamBuilder(gateway, codec, fold, initial).Create(args) + let store = createEqxStore connection batchSize + let resolveStream = EqxStreamBuilder(store, codec, fold, initial).Create Backend.Cart.Service(log, resolveStream) - let createServiceWithCompaction connection batchSize log = - let gateway = createEqxGateway connection batchSize - let resolveStream (StreamArgs args) = - EqxStreamBuilder(gateway, codec, fold, initial, AccessStrategy.RollingSnapshots compact).Create(args) + let createServiceWithProjection connection batchSize log = + let store = createEqxStore connection batchSize + let resolveStream = EqxStreamBuilder(store, codec, fold, initial, AccessStrategy.Projection project).Create Backend.Cart.Service(log, resolveStream) - let createServiceWithCaching connection batchSize log cache = - let gateway = createEqxGateway connection batchSize + let createServiceWithProjectionAndCaching connection batchSize log cache = + let store = createEqxStore connection batchSize let sliding20m = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) - let resolveStream (StreamArgs args) = EqxStreamBuilder(gateway, codec, fold, initial, caching = sliding20m).Create(args) - Backend.Cart.Service(log, resolveStream) - let createServiceIndexed connection batchSize log = - let gateway = createEqxGateway connection batchSize - let resolveStream (StreamArgs args) = EqxStreamBuilder(gateway, codec, fold, initial, AccessStrategy.IndexedSearch index).Create(args) - Backend.Cart.Service(log, resolveStream) - let createServiceWithCachingIndexed connection batchSize log cache = - let gateway = createEqxGateway connection batchSize - let sliding20m = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) - let resolveStream (StreamArgs args) = EqxStreamBuilder(gateway, codec, fold, initial, AccessStrategy.IndexedSearch index, caching=sliding20m).Create(args) - Backend.Cart.Service(log, resolveStream) - let createServiceWithCompactionAndCaching connection batchSize log cache = - let gateway = createEqxGateway connection batchSize - let sliding20m = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) - let resolveStream (StreamArgs args) = EqxStreamBuilder(gateway, codec, fold, initial, AccessStrategy.RollingSnapshots compact, sliding20m).Create(args) + let resolveStream = EqxStreamBuilder(store, codec, fold, initial, AccessStrategy.Projection project, sliding20m).Create Backend.Cart.Service(log, resolveStream) module ContactPreferences = - let fold, initial = Domain.ContactPreferences.Folds.fold, Domain.ContactPreferences.Folds.initial + let fold, initial, eventTypes = Domain.ContactPreferences.Folds.fold, Domain.ContactPreferences.Folds.initial, Domain.ContactPreferences.Events.eventTypeNames let codec = genCodec() let createServiceWithoutOptimization createGateway defaultBatchSize log _ignoreWindowSize _ignoreCompactionPredicate = let gateway = createGateway defaultBatchSize - let resolveStream (StreamArgs args) = EqxStreamBuilder(gateway, codec, fold, initial).Create(args) + let resolveStream = EqxStreamBuilder(gateway, codec, fold, initial).Create Backend.ContactPreferences.Service(log, resolveStream) let createService createGateway log = - let resolveStream (StreamArgs args) = EqxStreamBuilder(createGateway 1, codec, fold, initial, AccessStrategy.EventsAreState).Create(args) + let resolveStream = EqxStreamBuilder(createGateway 1, codec, fold, initial, AccessStrategy.AnyKnownEventType eventTypes).Create Backend.ContactPreferences.Service(log, resolveStream) #nowarn "1182" // From hereon in, we may have some 'unused' privates (the tests) type Tests(testOutputHelper) = - let testOutput = TestOutputAdapter testOutputHelper + inherit TestsWithLogCapture(testOutputHelper) + let log,capture = base.Log, base.Capture let addAndThenRemoveItems exceptTheLastOne context cartId skuId (service: Backend.Cart.Service) count = service.FlowAsync(cartId, fun _ctx execute -> @@ -71,33 +56,19 @@ type Tests(testOutputHelper) = let addAndThenRemoveItemsManyTimesExceptTheLastOne context cartId skuId service count = addAndThenRemoveItems true context cartId skuId service count - let createLoggerWithCapture () = - let capture = LogCaptureBuffer() - let logger = - Serilog.LoggerConfiguration() - .WriteTo.Seq("http://localhost:5341") - .WriteTo.Sink(testOutput) - .WriteTo.Sink(capture) - .CreateLogger() - logger, capture - - let singleSliceForward = EqxAct.SliceForward - let singleBatchForward = [EqxAct.SliceForward; EqxAct.BatchForward] - let batchForwardAndAppend = singleBatchForward @ [EqxAct.Append] - [] - let ``Can roundtrip against Cosmos, correctly batching the reads [without any optimizations]`` context cartId skuId = Async.RunSynchronously <| async { - let log, capture = createLoggerWithCapture () + let ``Can roundtrip against Cosmos, correctly batching the reads [without using the Index for reads]`` context skuId = Async.RunSynchronously <| async { let! conn = connectToSpecifiedCosmosOrSimulator log let batchSize = 3 let service = Cart.createServiceWithoutOptimization conn batchSize log + capture.Clear() // for re-runs of the test + let cartId = Guid.NewGuid() |> CartId // The command processing should trigger only a single read and a single write call let addRemoveCount = 6 do! addAndThenRemoveItemsManyTimesExceptTheLastOne context cartId skuId service addRemoveCount - test <@ batchForwardAndAppend = capture.ExternalCalls @> - + test <@ [EqxAct.SliceWaste; EqxAct.BatchBackward; EqxAct.Append] = capture.ExternalCalls @> // Restart the counting capture.Clear() @@ -108,20 +79,24 @@ type Tests(testOutputHelper) = // Need to read 4 batches to read 11 events in batches of 3 let expectedBatches = ceil(float expectedEventCount/float batchSize) |> int - test <@ List.replicate (expectedBatches-1) singleSliceForward @ singleBatchForward = capture.ExternalCalls @> + test <@ List.replicate (expectedBatches-1) EqxAct.SliceBackward @ [EqxAct.SliceBackward; EqxAct.BatchBackward] = capture.ExternalCalls @> } [] - let ``Can roundtrip against Cosmos, managing sync conflicts by retrying [without any optimizations]`` ctx initialState = Async.RunSynchronously <| async { - let log1, capture1 = createLoggerWithCapture () + let ``Can roundtrip against Cosmos, managing sync conflicts by retrying`` withOptimizations ctx initialState = Async.RunSynchronously <| async { + let log1, capture1 = log, capture + capture1.Clear() let! conn = connectToSpecifiedCosmosOrSimulator log1 // Ensure batching is included at some point in the proceedings let batchSize = 3 - let context, cartId, (sku11, sku12, sku21, sku22) = ctx + let context, (sku11, sku12, sku21, sku22) = ctx + let cartId = Guid.NewGuid() |> CartId // establish base stream state - let service1 = Cart.createServiceWithoutOptimization conn batchSize log1 + let service1 = + if withOptimizations then Cart.createServiceWithProjection conn batchSize log1 + else Cart.createServiceWithProjection conn batchSize log1 let! maybeInitialSku = let (streamEmpty, skuId) = initialState async { @@ -153,8 +128,9 @@ type Tests(testOutputHelper) = do! act prepare service1 sku12 12 // Signal conflict generated do! s4 } - let log2, capture2 = createLoggerWithCapture () - let service2 = Cart.createServiceWithoutOptimization conn batchSize log2 + let log2, capture2 = TestsWithLogCapture.CreateLoggerWithCapture testOutputHelper + use _flush = log2 + let service2 = Cart.createServiceWithProjection conn batchSize log2 let t2 = async { // Signal we have state, wait for other to do same, engineer conflict let prepare = async { @@ -180,59 +156,22 @@ type Tests(testOutputHelper) = && has sku11 11 && has sku12 12 && has sku21 21 && has sku22 22 @> // Intended conflicts pertained - let hadConflict= function EqxEvent (EqxAction EqxAct.AppendConflict) -> Some () | _ -> None - test <@ [1; 1] = [for c in [capture1; capture2] -> c.ChooseCalls hadConflict |> List.length] @> + let conflict = function EqxAct.Conflict | EqxAct.Resync as x -> Some x | _ -> None + test <@ let c2 = List.choose conflict capture2.ExternalCalls + [EqxAct.Resync] = List.choose conflict capture1.ExternalCalls + && [EqxAct.Resync] = c2 @> } let singleBatchBackwards = [EqxAct.SliceBackward; EqxAct.BatchBackward] let batchBackwardsAndAppend = singleBatchBackwards @ [EqxAct.Append] [] - let ``Can roundtrip against Cosmos, correctly compacting to avoid redundant reads`` context skuId cartId = Async.RunSynchronously <| async { - let log, capture = createLoggerWithCapture () - let! conn = connectToSpecifiedCosmosOrSimulator log - let batchSize = 10 - let service = Cart.createServiceWithCompaction conn batchSize log - - // Trigger 10 events, then reload - do! addAndThenRemoveItemsManyTimes context cartId skuId service 5 - let! _ = service.Read cartId - - // ... should see a single read as we are inside the batch threshold - test <@ batchBackwardsAndAppend @ singleBatchBackwards = capture.ExternalCalls @> - - // Add two more, which should push it over the threshold and hence trigger inclusion of a snapshot event (but not incurr extra roundtrips) - capture.Clear() - do! addAndThenRemoveItemsManyTimes context cartId skuId service 1 - test <@ batchBackwardsAndAppend = capture.ExternalCalls @> - - // While we now have 13 events, we should be able to read them with a single call - capture.Clear() - let! _ = service.Read cartId - test <@ singleBatchBackwards = capture.ExternalCalls @> - - // Add 8 more; total of 21 should not trigger snapshotting as Event Number 12 (the 13th one) is a shapshot - capture.Clear() - do! addAndThenRemoveItemsManyTimes context cartId skuId service 4 - test <@ batchBackwardsAndAppend = capture.ExternalCalls @> - - // While we now have 21 events, we should be able to read them with a single call - capture.Clear() - let! _ = service.Read cartId - // ... and trigger a second snapshotting (inducing a single additional read + write) - do! addAndThenRemoveItemsManyTimes context cartId skuId service 1 - // and reload the 24 events with a single read - let! _ = service.Read cartId - test <@ singleBatchBackwards @ batchBackwardsAndAppend @ singleBatchBackwards = capture.ExternalCalls @> - } - - [] - let ``Can correctly read and update against Cosmos with EventsAreState Access Strategy`` id value = Async.RunSynchronously <| async { - let log, capture = createLoggerWithCapture () + let ``Can correctly read and update against Cosmos with EventsAreState Access Strategy`` value = Async.RunSynchronously <| async { let! conn = connectToSpecifiedCosmosOrSimulator log - let service = ContactPreferences.createService (createEqxGateway conn) log + let service = ContactPreferences.createService (createEqxStore conn) log - let (Domain.ContactPreferences.Id email) = id + let email = let g = System.Guid.NewGuid() in g.ToString "N" + //let (Domain.ContactPreferences.Id email) = id () // Feed some junk into the stream for i in 0..11 do let quickSurveysValue = i % 2 = 0 @@ -246,134 +185,62 @@ type Tests(testOutputHelper) = let! result = service.Read email test <@ value = result @> - test <@ batchBackwardsAndAppend @ singleBatchBackwards = capture.ExternalCalls @> + test <@ [EqxAct.Index; EqxAct.Append; EqxAct.Index] = capture.ExternalCalls @> } [] - let ``Can roundtrip against Cosmos, correctly caching to avoid redundant reads`` context skuId cartId = Async.RunSynchronously <| async { - let log, capture = createLoggerWithCapture () + let ``Can roundtrip against Cosmos, using Projection to avoid queries`` context skuId = Async.RunSynchronously <| async { let! conn = connectToSpecifiedCosmosOrSimulator log let batchSize = 10 - let cache = Caching.Cache("cart", sizeMb = 50) - let createServiceCached () = Cart.createServiceWithCaching conn batchSize log cache - let service1, service2 = createServiceCached (), createServiceCached () + let createServiceIndexed () = Cart.createServiceWithProjection conn batchSize log + let service1, service2 = createServiceIndexed (), createServiceIndexed () + capture.Clear() // Trigger 10 events, then reload + let cartId = Guid.NewGuid() |> CartId do! addAndThenRemoveItemsManyTimes context cartId skuId service1 5 let! _ = service2.Read cartId // ... should see a single read as we are writes are cached - test <@ batchForwardAndAppend @ singleBatchForward = capture.ExternalCalls @> + test <@ [EqxAct.IndexNotFound; EqxAct.Append; EqxAct.Index] = capture.ExternalCalls @> // Add two more - the roundtrip should only incur a single read capture.Clear() do! addAndThenRemoveItemsManyTimes context cartId skuId service1 1 - test <@ batchForwardAndAppend = capture.ExternalCalls @> + test <@ [EqxAct.Index; EqxAct.Append] = capture.ExternalCalls @> // While we now have 12 events, we should be able to read them with a single call capture.Clear() let! _ = service2.Read cartId - test <@ singleBatchForward = capture.ExternalCalls @> + test <@ [EqxAct.Index] = capture.ExternalCalls @> } - let primeIndex = [EqxAct.IndexedNotFound; EqxAct.SliceBackward; EqxAct.BatchBackward] - // When the test gets re-run to simplify, the stream will typically already have values - let primeIndexRerun = [EqxAct.IndexedCached] - [] - let ``Can roundtrip against Cosmos, correctly using the index and cache to avoid redundant reads`` context skuId cartId = Async.RunSynchronously <| async { - let log, capture = createLoggerWithCapture () + let ``Can roundtrip against Cosmos, correctly using Projection and Cache to avoid redundant reads`` context skuId = Async.RunSynchronously <| async { let! conn = connectToSpecifiedCosmosOrSimulator log let batchSize = 10 let cache = Caching.Cache("cart", sizeMb = 50) - let createServiceCached () = Cart.createServiceWithCachingIndexed conn batchSize log cache + let createServiceCached () = Cart.createServiceWithProjectionAndCaching conn batchSize log cache let service1, service2 = createServiceCached (), createServiceCached () + capture.Clear() // Trigger 10 events, then reload + let cartId = Guid.NewGuid() |> CartId do! addAndThenRemoveItemsManyTimes context cartId skuId service1 5 let! _ = service2.Read cartId // ... should see a single Cached Indexed read given writes are cached and writer emits etag - test <@ primeIndex @ [EqxAct.Append; EqxAct.IndexedCached] = capture.ExternalCalls - || primeIndexRerun @ [EqxAct.Append; EqxAct.IndexedCached] = capture.ExternalCalls@> + test <@ [EqxAct.IndexNotFound; EqxAct.Append; EqxAct.IndexNotModified] = capture.ExternalCalls @> // Add two more - the roundtrip should only incur a single read, which should be cached by virtue of being a second one in successono capture.Clear() do! addAndThenRemoveItemsManyTimes context cartId skuId service1 1 - test <@ [EqxAct.IndexedCached; EqxAct.Append] = capture.ExternalCalls @> + test <@ [EqxAct.IndexNotModified; EqxAct.Append] = capture.ExternalCalls @> // While we now have 12 events, we should be able to read them with a single call capture.Clear() let! _ = service2.Read cartId let! _ = service2.Read cartId // First is cached because writer emits etag, second remains cached - test <@ [EqxAct.IndexedCached; EqxAct.IndexedCached] = capture.ExternalCalls @> - } - - [] - let ``Can roundtrip against Cosmos, correctly using the index to avoid redundant reads`` context skuId cartId = Async.RunSynchronously <| async { - let log, capture = createLoggerWithCapture () - let! conn = connectToSpecifiedCosmosOrSimulator log - let batchSize = 10 - let createServiceIndexed () = Cart.createServiceIndexed conn batchSize log - let service1, service2 = createServiceIndexed (), createServiceIndexed () - - // Trigger 10 events, then reload - do! addAndThenRemoveItemsManyTimes context cartId skuId service1 5 - let! _ = service2.Read cartId - - // ... should see a single read as we are writes are cached - test <@ primeIndex @ [EqxAct.Append; EqxAct.Indexed] = capture.ExternalCalls @> - - // Add two more - the roundtrip should only incur a single read - capture.Clear() - do! addAndThenRemoveItemsManyTimes context cartId skuId service1 1 - test <@ [EqxAct.Indexed; EqxAct.Append] = capture.ExternalCalls @> - - // While we now have 12 events, we should be able to read them with a single call - capture.Clear() - let! _ = service2.Read cartId - test <@ [EqxAct.Indexed] = capture.ExternalCalls @> - } - - [] - let ``Can combine compaction with caching against Cosmos`` context skuId cartId = Async.RunSynchronously <| async { - let log, capture = createLoggerWithCapture () - let! conn = connectToSpecifiedCosmosOrSimulator log - let batchSize = 10 - let service1 = Cart.createServiceWithCompaction conn batchSize log - let cache = Caching.Cache("cart", sizeMb = 50) - let service2 = Cart.createServiceWithCompactionAndCaching conn batchSize log cache - - // Trigger 10 events, then reload - do! addAndThenRemoveItemsManyTimes context cartId skuId service1 5 - let! _ = service2.Read cartId - - // ... should see a single read as we are inside the batch threshold - test <@ batchBackwardsAndAppend @ singleBatchBackwards = capture.ExternalCalls @> - - // Add two more, which should push it over the threshold and hence trigger inclusion of a snapshot event (but not incurr extra roundtrips) - capture.Clear() - do! addAndThenRemoveItemsManyTimes context cartId skuId service1 1 - test <@ batchBackwardsAndAppend = capture.ExternalCalls @> - - // While we now have 13 events, we whould be able to read them backwards with a single call - capture.Clear() - let! _ = service1.Read cartId - test <@ singleBatchBackwards = capture.ExternalCalls @> - - // Add 8 more; total of 21 should not trigger snapshotting as Event Number 12 (the 13th one) is a shapshot - capture.Clear() - do! addAndThenRemoveItemsManyTimes context cartId skuId service1 4 - test <@ batchBackwardsAndAppend = capture.ExternalCalls @> - - // While we now have 21 events, we should be able to read them with a single call - capture.Clear() - let! _ = service1.Read cartId - // ... and trigger a second snapshotting (inducing a single additional read + write) - do! addAndThenRemoveItemsManyTimes context cartId skuId service1 1 - // and we _could_ reload the 24 events with a single read if reading backwards. However we are using the cache, which last saw it with 10 events, which necessitates two reads - let! _ = service2.Read cartId - let suboptimalExtraSlice = [singleSliceForward] - test <@ singleBatchBackwards @ batchBackwardsAndAppend @ suboptimalExtraSlice @ singleBatchForward = capture.ExternalCalls @> + test <@ [EqxAct.IndexNotModified; EqxAct.IndexNotModified] = capture.ExternalCalls @> } \ No newline at end of file diff --git a/tests/Equinox.Cosmos.Integration/Equinox.Cosmos.Integration.fsproj b/tests/Equinox.Cosmos.Integration/Equinox.Cosmos.Integration.fsproj index 62f071fb0..796526db0 100644 --- a/tests/Equinox.Cosmos.Integration/Equinox.Cosmos.Integration.fsproj +++ b/tests/Equinox.Cosmos.Integration/Equinox.Cosmos.Integration.fsproj @@ -11,7 +11,8 @@ - + + @@ -24,6 +25,8 @@ + + diff --git a/tests/Equinox.Cosmos.Integration/VerbatimUtf8JsonConverterTests.fs b/tests/Equinox.Cosmos.Integration/JsonConverterTests.fs similarity index 60% rename from tests/Equinox.Cosmos.Integration/VerbatimUtf8JsonConverterTests.fs rename to tests/Equinox.Cosmos.Integration/JsonConverterTests.fs index 903c9f1c0..06b795722 100644 --- a/tests/Equinox.Cosmos.Integration/VerbatimUtf8JsonConverterTests.fs +++ b/tests/Equinox.Cosmos.Integration/JsonConverterTests.fs @@ -1,4 +1,4 @@ -module Equinox.Cosmos.Integration.VerbatimUtf8JsonConverterTests +module Equinox.Cosmos.Integration.JsonConverterTests open Equinox.Cosmos open FsCheck.Xunit @@ -15,26 +15,30 @@ type Union = let mkUnionEncoder () = Equinox.UnionCodec.JsonUtf8.Create(JsonSerializerSettings()) -[] -let ``VerbatimUtf8JsonConverter encodes correctly`` () = - let encoded = mkUnionEncoder().Encode(A { embed = "\"" }) - let e : Store.Event = - { p = "streamName"; id = string 0; i = 0L - c = DateTimeOffset.MinValue - t = encoded.caseName - d = encoded.payload - m = null } - let res = JsonConvert.SerializeObject(e) - test <@ res.Contains """"d":{"embed":"\""}""" @> - -type Base64ZipUtf8JsonConverterTests() = +type VerbatimUtf8Tests() = + let unionEncoder = mkUnionEncoder () + + [] + let ``encodes correctly`` () = + let encoded = mkUnionEncoder().Encode(A { embed = "\"" }) + let e : Store.Event = + { p = "streamName"; id = string 0; i = 0L; _etag=null + c = DateTimeOffset.MinValue + t = encoded.caseName + d = encoded.payload + m = null } + let res = JsonConvert.SerializeObject(e) + test <@ res.Contains """"d":{"embed":"\""}""" @> + +type Base64ZipUtf8Tests() = let unionEncoder = mkUnionEncoder () [] let ``serializes, achieving compression`` () = let encoded = unionEncoder.Encode(A { embed = String('x',5000) }) - let e : Store.IndexProjection = - { t = encoded.caseName + let e : Store.Projection = + { i = 42L + t = encoded.caseName d = encoded.payload m = null } let res = JsonConvert.SerializeObject e @@ -49,13 +53,14 @@ type Base64ZipUtf8JsonConverterTests() = if hasNulls then () else let encoded = unionEncoder.Encode value - let e : Store.IndexProjection = - { t = encoded.caseName + let e : Store.Projection = + { i = 42L + t = encoded.caseName d = encoded.payload m = null } let ser = JsonConvert.SerializeObject(e) test <@ ser.Contains("\"d\":\"") @> - let des = JsonConvert.DeserializeObject(ser) + let des = JsonConvert.DeserializeObject(ser) let d : Equinox.UnionCodec.EncodedUnion<_> = { caseName = des.t; payload=des.d } let decoded = unionEncoder.Decode d test <@ value = decoded @> \ No newline at end of file diff --git a/tests/Equinox.EventStore.Integration/EventStoreIntegration.fs b/tests/Equinox.EventStore.Integration/EventStoreIntegration.fs index e7b136189..c36541b5f 100644 --- a/tests/Equinox.EventStore.Integration/EventStoreIntegration.fs +++ b/tests/Equinox.EventStore.Integration/EventStoreIntegration.fs @@ -67,9 +67,9 @@ type Tests(testOutputHelper) = let capture = LogCaptureBuffer() let logger = Serilog.LoggerConfiguration() - .WriteTo.Seq("http://localhost:5341") .WriteTo.Sink(testOutput) .WriteTo.Sink(capture) + .WriteTo.Seq("http://localhost:5341") .CreateLogger() logger, capture