From 801372432ff7c48d4459fb3571b020305cfaf851 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 29 Nov 2019 16:49:32 +0000 Subject: [PATCH 01/45] Add Location initial impl --- equinox-fc/Domain.Tests/Domain.Tests.fsproj | 31 +++++++ equinox-fc/Domain.Tests/Infrastructure.fs | 50 +++++++++++ equinox-fc/Domain.Tests/LocationEpochTests.fs | 54 +++++++++++ .../Domain.Tests/LocationSeriesTests.fs | 44 +++++++++ equinox-fc/Domain.Tests/LocationTests.fs | 70 +++++++++++++++ equinox-fc/Domain/Domain.fsproj | 20 +++++ equinox-fc/Domain/Infrastructure.fs | 16 ++++ equinox-fc/Domain/Location.fs | 45 ++++++++++ equinox-fc/Domain/LocationEpoch.fs | 90 +++++++++++++++++++ equinox-fc/Domain/LocationSeries.fs | 52 +++++++++++ equinox-fc/Fc.sln | 48 ++++++++++ 11 files changed, 520 insertions(+) create mode 100644 equinox-fc/Domain.Tests/Domain.Tests.fsproj create mode 100644 equinox-fc/Domain.Tests/Infrastructure.fs create mode 100644 equinox-fc/Domain.Tests/LocationEpochTests.fs create mode 100644 equinox-fc/Domain.Tests/LocationSeriesTests.fs create mode 100644 equinox-fc/Domain.Tests/LocationTests.fs create mode 100644 equinox-fc/Domain/Domain.fsproj create mode 100644 equinox-fc/Domain/Infrastructure.fs create mode 100644 equinox-fc/Domain/Location.fs create mode 100644 equinox-fc/Domain/LocationEpoch.fs create mode 100644 equinox-fc/Domain/LocationSeries.fs create mode 100644 equinox-fc/Fc.sln diff --git a/equinox-fc/Domain.Tests/Domain.Tests.fsproj b/equinox-fc/Domain.Tests/Domain.Tests.fsproj new file mode 100644 index 000000000..8ec512e47 --- /dev/null +++ b/equinox-fc/Domain.Tests/Domain.Tests.fsproj @@ -0,0 +1,31 @@ + + + + netcoreapp2.1 + 5 + Fc.Domain.Tests + false + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/equinox-fc/Domain.Tests/Infrastructure.fs b/equinox-fc/Domain.Tests/Infrastructure.fs new file mode 100644 index 000000000..80c23b5eb --- /dev/null +++ b/equinox-fc/Domain.Tests/Infrastructure.fs @@ -0,0 +1,50 @@ +[] +module Infrastructure + +open Serilog +open System + +let (|Id|) (x : Guid) = x.ToString "N" |> FSharp.UMX.UMX.tag +let inline mkId () = Guid.NewGuid() |> (|Id|) +let (|Ids|) (xs : Guid[]) = xs |> Array.map (|Id|) +let (|IdsAtLeastOne|) (Id x, Ids xs) = Seq.append xs (Seq.singleton x) |> Seq.toArray + +module EnvVar = + + let tryGet k = Environment.GetEnvironmentVariable k |> Option.ofObj + +module Cosmos = + + open Equinox.Cosmos + let connect () = + match EnvVar.tryGet "EQUINOX_COSMOS_CONNECTION", EnvVar.tryGet "EQUINOX_COSMOS_DATABASE", EnvVar.tryGet "EQUINOX_COSMOS_CONTAINER" with + | Some s,Some d,Some c -> + let appName = "Domain.Tests" + let discovery = Discovery.FromConnectionString s + let connector = Connector(TimeSpan.FromSeconds 5., 1, TimeSpan.FromSeconds 5., Serilog.Log.Logger) + let connection = connector.Connect(appName,discovery) |> Async.RunSynchronously + let context = Context(connection,d,c) + let cache = Equinox.Cache (appName, 10) + context,cache + | s,d,c -> + failwithf "Connection, Database and Container EQUINOX_COSMOS_* Environment variables are required (%b,%b,%b)" + (Option.isSome s) (Option.isSome d) (Option.isSome c) + +/// Adapts the XUnit ITestOutputHelper to be a Serilog Sink +type TestOutputAdapter(testOutput : Xunit.Abstractions.ITestOutputHelper) = + let formatter = Serilog.Formatting.Display.MessageTemplateTextFormatter("{Timestamp:HH:mm:ss.fff zzz} [{Level:u3}] {Message}{Properties}{NewLine}{Exception}", null); + let writeSerilogEvent logEvent = + use writer = new System.IO.StringWriter() + formatter.Format(logEvent, writer) + let messageLine = string writer + testOutput.WriteLine messageLine + System.Diagnostics.Debug.Write messageLine + interface Serilog.Core.ILogEventSink with member __.Emit logEvent = writeSerilogEvent logEvent + +/// Creates a Serilog Log chain emitting to the cited Sink (only) +let createLogger sink = + Serilog.LoggerConfiguration() +// .MinimumLevel.Debug() + .Destructure.FSharpTypes() + .WriteTo.Sink(sink) + .CreateLogger() \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/LocationEpochTests.fs b/equinox-fc/Domain.Tests/LocationEpochTests.fs new file mode 100644 index 000000000..8a4e14a4a --- /dev/null +++ b/equinox-fc/Domain.Tests/LocationEpochTests.fs @@ -0,0 +1,54 @@ +module LocationEpochTests + +open FsCheck.Xunit +open Location.Epoch +open Swensen.Unquote + +let interpret delta _balance = + match delta with + | 0 -> (),[] + | delta -> (),[Events.Delta { value = delta }] + +let validateAndInterpret expectedBalance delta balance = + test <@ expectedBalance = balance @> + interpret delta balance + +let verifyDeltaEvent delta events = + let dEvents = events |> List.filter (function Events.Delta _ -> true | _ -> false) + test <@ interpret delta (Unchecked.defaultof<_>) = ((),dEvents) @> + +let [] properties carriedForward delta1 closeImmediately delta2 close = + + (* Starting with an empty stream, we'll need to supply the balance carried forward, optionally we apply a delta and potentially close *) + + let initialShouldClose _state = closeImmediately + let res,events = sync (Some carriedForward) (validateAndInterpret carriedForward delta1) initialShouldClose Folds.initial + let cfEvents events = events |> List.filter (function Events.CarriedForward _ -> true | _ -> false) + let closeEvents events = events |> List.filter (function Events.Closed -> true | _ -> false) + let state1 = Folds.fold Folds.initial events + let expectedBalance = carriedForward + delta1 + // Only expect closing if it was requested + let expectImmediateClose = closeImmediately + test <@ Option.isSome res.result + && expectedBalance = res.balance @> + test <@ [Events.CarriedForward { initial = carriedForward }] = cfEvents events + && (not expectImmediateClose || 1 = Seq.length (closeEvents events)) @> + verifyDeltaEvent delta1 events + + (* After initializing, validate we don't need to supply a carriedForward, and don't produce a CarriedForward event *) + + let shouldClose _state = close + let { isOpen = isOpen; result = worked; balance = bal },events = sync None (validateAndInterpret expectedBalance delta2) shouldClose state1 + let expectedBalance = if expectImmediateClose then expectedBalance else expectedBalance + delta2 + test <@ [] = cfEvents events + && (expectImmediateClose || not close || 1 = Seq.length (closeEvents events)) @> + test <@ (expectImmediateClose || close || isOpen) + && expectedBalance = bal @> + if not expectImmediateClose then + test <@ Option.isSome worked @> + verifyDeltaEvent delta2 events + +let [] ``codec can roundtrip`` event = + let ee = Events.codec.Encode(None,event) + let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) + test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/LocationSeriesTests.fs b/equinox-fc/Domain.Tests/LocationSeriesTests.fs new file mode 100644 index 000000000..1bd09a28d --- /dev/null +++ b/equinox-fc/Domain.Tests/LocationSeriesTests.fs @@ -0,0 +1,44 @@ +module LocationSeriesTests + +open FsCheck.Xunit +open FSharp.UMX +open Swensen.Unquote +open Location.Series + +let [] properties c1 c2 = + let events = interpretActivateEpoch c1 Folds.initial + let state1 = Folds.fold Folds.initial events + let epoch0 = %0 + match c1, events, toActiveEpoch state1 with + // Started events are not written for < 0 + | n, [], activeEpoch when n < epoch0 -> + test <@ None = activeEpoch @> + // Any >=0 value should trigger a Started event, initially + | n, [Events.Started { epochId = ee }], Some activatedEpoch -> + test <@ n >= epoch0 && n = ee && n = activatedEpoch @> + // Nothing else should yield events + | _, l, _ -> + test <@ List.isEmpty l @> + + let events = interpretActivateEpoch c2 state1 + let state2 = Folds.fold state1 events + match toActiveEpoch state1, c2, events, toActiveEpoch state2 with + // Started events are not written for < 0 + | None, n, [], activeEpoch when n < epoch0 -> + test <@ None = activeEpoch @> + // Any >= 0 epochId should trigger a Started event if first command didnt do anything + | None, n, [Events.Started { epochId = ee }], Some activatedEpoch -> + let eEpoch = %ee + test <@ n >= epoch0 && n = eEpoch && n = activatedEpoch @> + // Any higher epochId should trigger a Started event (gaps are fine - we are only tying to reduce walks) + | Some s1, n, [Events.Started { epochId = ee }], Some activatedEpoch -> + let eEpoch = %ee + test <@ n > s1 && n = eEpoch && n > epoch0 && n = activatedEpoch @> + // Nothing else should yield events + | _, _, l, _ -> + test <@ List.isEmpty l @> + +let [] ``codec can roundtrip`` event = + let ee = Events.codec.Encode(None,event) + let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) + test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs new file mode 100644 index 000000000..2e117f65f --- /dev/null +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -0,0 +1,70 @@ +module LocationTests + +open FsCheck.Xunit +open FSharp.UMX +open Location +open Swensen.Unquote +open System + +/// Helpers to match `module Cosmos` wrapping inside the impl +module Location = + + open Equinox.MemoryStore + + module Series = + + let resolve store = Resolver(store, Series.Events.codec, Series.Folds.fold, Series.Folds.initial).Resolve + + module Epoch = + + let resolve store = Resolver(store, Epoch.Events.codec, Epoch.Folds.fold, Epoch.Folds.initial).Resolve + + module MemoryStore = + + let createService (zeroBalance, shouldClose) store = + let maxAttempts = Int32.MaxValue + let series = Series.create (Series.resolve store) maxAttempts + let epochs = Epoch.create (Epoch.resolve store) maxAttempts + create (zeroBalance, shouldClose) (series, epochs) + +let run (service : LocationService) (IdsAtLeastOne locations, deltas : _[]) = Async.RunSynchronously <| async { + let runId = mkId () // Need to make making state in store unique when replaying or shrinking + let locations = locations |> Array.map (fun x -> % (sprintf "%O_%O" runId x)) + + let updates = deltas |> Seq.mapi (fun i x -> locations.[i % locations.Length], x) |> Seq.cache + + (* Apply random deltas *) + + let adjust delta (bal : Epoch.Folds.Balance) = + let value = max -bal delta + if value = 0 then 0, [] + else value, [Location.Epoch.Events.Delta { value = value }] + let! appliedDeltas = seq { for loc,x in updates -> async { let! _,eff = service.Execute(loc, adjust x) in return loc,eff } } |> Async.Parallel + let expectedBalances = Seq.append (seq { for l in locations -> l, 0}) appliedDeltas |> Seq.groupBy fst |> Seq.map (fun (l,xs) -> l, xs |> Seq.sumBy snd) |> Set.ofSeq + + (* Verify loading yields identical state *) + + let! balances = seq { for loc in locations -> async { let! bal,() = service.Execute(loc,(fun _ -> (),[])) in return loc,bal } } |> Async.Parallel + test <@ expectedBalances = Set.ofSeq balances @> } + +let [] ``MemoryStore properties`` maxEvents args = + let store = Equinox.MemoryStore.VolatileStore() + let zeroBalance = 0 + let maxEvents = max 1 maxEvents + let shouldClose (state : Epoch.Folds.OpenState) = state.count > maxEvents + let service = Location.MemoryStore.createService (zeroBalance, shouldClose) store + run service args + +type Cosmos(testOutput) = + + let context,cache = Cosmos.connect () + + let log = testOutput |> TestOutputAdapter |> createLogger + do Serilog.Log.Logger <- log + + let [] properties maxEvents args = + let zeroBalance = 0 + let maxEvents = max 1 maxEvents + let shouldClose (state : Epoch.Folds.OpenState) = state.count > maxEvents + let service = Location.Cosmos.createService (zeroBalance, shouldClose) (context,cache,Int32.MaxValue) + run service args \ No newline at end of file diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj new file mode 100644 index 000000000..107408957 --- /dev/null +++ b/equinox-fc/Domain/Domain.fsproj @@ -0,0 +1,20 @@ + + + + netstandard2.0 + 5 + Fc.Domain + + + + + + + + + + + + + + diff --git a/equinox-fc/Domain/Infrastructure.fs b/equinox-fc/Domain/Infrastructure.fs new file mode 100644 index 000000000..7a1bfa843 --- /dev/null +++ b/equinox-fc/Domain/Infrastructure.fs @@ -0,0 +1,16 @@ +namespace global + +open FSharp.UMX // see https://github.com/fsprojects/FSharp.UMX - % operator and ability to apply units of measure to Guids+strings + +type LocationId = string +and [] locationId +module LocationId = + let parse (value : string) : LocationId = %value + let toString (value : LocationId) : string = %value + +type LocationEpochId = int +and [] locationEpochId +module LocationEpochId = + let parse (value : int) : LocationEpochId = %value + let next (value : LocationEpochId) : LocationEpochId = % (%value + 1) + let toString (value : LocationEpochId) : string = string %value \ No newline at end of file diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs new file mode 100644 index 000000000..50511d8d3 --- /dev/null +++ b/equinox-fc/Domain/Location.fs @@ -0,0 +1,45 @@ +namespace Location + +[] +type Wip<'R> = + | Pending of decide : (Epoch.Folds.Balance -> 'R*Epoch.Events.Event list) + | Complete of 'R + +/// Manages a Series of Epochs, with a running total being carried forward to the next Epoch when it's Closed +type LocationService internal (zeroBalance, shouldClose, series : Series.Service, epochs : Epoch.Service) = + + let rec execute locationId originEpochId = + let rec aux epochId balanceToCarryForward wip = async { + let decide state = match wip with Complete r -> r,[] | Pending decide -> decide state + match! epochs.Sync(locationId, epochId, balanceToCarryForward, decide, shouldClose) with + | { balance = bal; result = Some res; isOpen = true } -> + if originEpochId <> epochId then + do! series.ActivateEpoch(locationId, epochId) + return bal, res + | { balance = bal; result = Some res } -> + let successorEpochId = LocationEpochId.next epochId + return! aux successorEpochId (Some bal) (Complete res) + | { balance = bal } -> + let successorEpochId = LocationEpochId.next epochId + return! aux successorEpochId (Some bal) wip } + aux + + member __.Execute(locationId, decide) = async { + let! activeEpoch = series.Read locationId + let originEpochId, epochId, balanceCarriedForward = + match activeEpoch with + | None -> LocationEpochId.parse -1, LocationEpochId.parse 0, Some zeroBalance + | Some activeEpochId -> activeEpochId, activeEpochId, None + return! execute locationId originEpochId epochId balanceCarriedForward (Pending decide)} + +[] +module Helpers = + let create (zeroBalance, shouldClose) (series, epochs) = + LocationService(zeroBalance, shouldClose, series, epochs) + +module Cosmos = + + let createService (zeroBalance, shouldClose) (context, cache, maxAttempts) = + let series = Series.Cosmos.createService (context, cache, maxAttempts) + let epochs = Epoch.Cosmos.createService (context, cache, maxAttempts) + create (zeroBalance, shouldClose) (series, epochs) \ No newline at end of file diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs new file mode 100644 index 000000000..a76b7807d --- /dev/null +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -0,0 +1,90 @@ +module Location.Epoch + +// NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +[] +module Events = + + type CarriedForward = { initial : int } + type Delta = { value : int } + type Event = + | CarriedForward of CarriedForward + | Closed + | Delta of Delta + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + let [] categoryId = "LocationEpoch" + +module Folds = + + type Balance = int + type OpenState = { count : int; value : Balance } + type State = Initial | Open of OpenState | Closed of Balance + let initial = Initial + let evolve state event = + match event, state with + | Events.CarriedForward e, Initial -> Open { count = 0; value = e.initial } + | Events.Delta e, Open bal -> Open { count = bal.count + 1; value = bal.value + e.value } + | Events.Closed, Open { value = bal } -> Closed bal + | Events.CarriedForward _, (Open _|Closed _ as x) -> failwithf "CarriedForward : Unexpected %A" x + | Events.Delta _, (Initial|Closed _ as x) -> failwithf "Delta : Unexpected %A" x + | Events.Closed, (Initial|Closed _ as x) -> failwithf "Closed : Unexpected %A" x + let fold = Seq.fold evolve + +/// Holds events accumulated from a series of decisions while also evolving the presented `state` to reflect the pended events +type private Accumulator() = + let acc = ResizeArray() + member __.Ingest state : 'res * Events.Event list -> 'res * Folds.State = function + | res, [] -> res, state + | res, [e] -> acc.Add e; res, Folds.evolve state e + | res, xs -> acc.AddRange xs; res, Folds.fold state (Seq.ofList xs) + member __.Accumulated = List.ofSeq acc + +type Result<'t> = { balance : Folds.Balance; result : 't option; isOpen : bool } + +let sync (balanceCarriedForward : Folds.Balance option) (decide : (Folds.Balance -> 't*Events.Event list)) shouldClose state : Result<'t>*Events.Event list = + let acc = Accumulator() + // We always want to have a CarriedForward event at the start of any Epoch's event stream + let (), state = + acc.Ingest state <| + match state with + | Folds.Initial -> (), [Events.CarriedForward { initial = Option.get balanceCarriedForward }] + | Folds.Open _ | Folds.Closed _ -> (), [] + // Run, unless we determine we're in Closed state + let result, state = + acc.Ingest state <| + match state with + | Folds.Initial -> failwith "We've just guaranteed not Initial" + | Folds.Open { value = bal } -> let r,es = decide bal in Some r,es + | Folds.Closed _ -> None, [] + // Finally (iff we're `Open`, have run a `decide` and `shouldClose`), we generate a Closed event + let (balance, isOpen), _ = + acc.Ingest state <| + match state with + | Folds.Initial -> failwith "Can't be Initial" + | Folds.Open ({ value = bal } as openState) when shouldClose openState -> (bal, false), [Events.Closed] + | Folds.Open { value = bal } -> (bal, true), [] + | Folds.Closed bal -> (bal, false), [] + { balance = balance; result = result; isOpen = isOpen }, acc.Accumulated + +type Service internal (resolve, ?maxAttempts) = + + let log = Serilog.Log.ForContext() + let (|AggregateId|) (locationId, epochId) = + let id = sprintf "%s_%s" (LocationId.toString locationId) (LocationEpochId.toString epochId) + Equinox.AggregateId(Events.categoryId, id) + let (|Stream|) (AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) + + member __.Sync<'R>(locationId, epochId, prevEpochBalanceCarriedForward, decide, shouldClose) : Async> = + let (Stream stream) = (locationId, epochId) + stream.Transact(sync prevEpochBalanceCarriedForward decide shouldClose) + +let create resolve maxAttempts = Service(resolve, maxAttempts) + +module Cosmos = + + open Equinox.Cosmos + let resolve (context,cache) = + let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + Resolver(context, Events.codec, Folds.fold, Folds.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve + let createService (context,cache,maxAttempts) = + create (resolve (context,cache)) maxAttempts \ No newline at end of file diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs new file mode 100644 index 000000000..e75ccb9b4 --- /dev/null +++ b/equinox-fc/Domain/LocationSeries.fs @@ -0,0 +1,52 @@ +module Location.Series + +// NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +[] +module Events = + + type Started = { epochId : LocationEpochId } + type Event = + | Started of Started + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + let [] categoryId = "LocationSeries" + +module Folds = + + type State = LocationEpochId + let initial = LocationEpochId.parse -1 + let evolve _state = function + | Events.Started e -> e.epochId + let fold = Seq.fold evolve + +let interpretActivateEpoch epochId (state : Folds.State) = + [if state < epochId then yield Events.Started { epochId = epochId }] + +let toActiveEpoch state = + if state = Folds.initial then None else Some state + +type Service internal (resolve, ?maxAttempts) = + + let log = Serilog.Log.ForContext() + let (|AggregateId|) id = Equinox.AggregateId(Events.categoryId, LocationId.toString id) + let (|Stream|) (AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) + + member __.Read(locationId) : Async = + let (Stream stream) = locationId + stream.Query toActiveEpoch + + member __.ActivateEpoch(locationId,epochId) : Async = + let (Stream stream) = locationId + stream.Transact(interpretActivateEpoch epochId) + +let create resolve maxAttempts = Service(resolve, maxAttempts) + +module Cosmos = + + open Equinox.Cosmos + let resolve (context,cache) = + let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let opt = Equinox.ResolveOption.AllowStale + fun id -> Resolver(context, Events.codec, Folds.fold, Folds.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id,opt) + let createService (context, cache, maxAttempts) = + create (resolve (context,cache)) maxAttempts \ No newline at end of file diff --git a/equinox-fc/Fc.sln b/equinox-fc/Fc.sln new file mode 100644 index 000000000..2bf47b4d9 --- /dev/null +++ b/equinox-fc/Fc.sln @@ -0,0 +1,48 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 15 +VisualStudioVersion = 15.0.26124.0 +MinimumVisualStudioVersion = 15.0.26124.0 +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "Domain\Domain.fsproj", "{4722DF4D-DBE1-4030-9C55-6BA3A4147322}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "Domain.Tests\Domain.Tests.fsproj", "{AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Debug|x64 = Debug|x64 + Debug|x86 = Debug|x86 + Release|Any CPU = Release|Any CPU + Release|x64 = Release|x64 + Release|x86 = Release|x86 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Debug|Any CPU.Build.0 = Debug|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Debug|x64.ActiveCfg = Debug|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Debug|x64.Build.0 = Debug|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Debug|x86.ActiveCfg = Debug|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Debug|x86.Build.0 = Debug|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Release|Any CPU.ActiveCfg = Release|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Release|Any CPU.Build.0 = Release|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Release|x64.ActiveCfg = Release|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Release|x64.Build.0 = Release|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Release|x86.ActiveCfg = Release|Any CPU + {4722DF4D-DBE1-4030-9C55-6BA3A4147322}.Release|x86.Build.0 = Release|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Debug|Any CPU.Build.0 = Debug|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Debug|x64.ActiveCfg = Debug|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Debug|x64.Build.0 = Debug|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Debug|x86.ActiveCfg = Debug|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Debug|x86.Build.0 = Debug|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|Any CPU.ActiveCfg = Release|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|Any CPU.Build.0 = Release|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|x64.ActiveCfg = Release|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|x64.Build.0 = Release|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|x86.ActiveCfg = Release|Any CPU + {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|x86.Build.0 = Release|Any CPU + EndGlobalSection +EndGlobal From 1d858207d3ed72118d306607a0d0130bf65de644 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 29 Nov 2019 16:58:58 +0000 Subject: [PATCH 02/45] Add Fc template wrapping --- CHANGELOG.md | 1 + equinox-fc/.template.config/template.json | 17 +++++++++++++++++ 2 files changed, 18 insertions(+) create mode 100644 equinox-fc/.template.config/template.json diff --git a/CHANGELOG.md b/CHANGELOG.md index 2a6abd72e..997c122f2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -84,6 +84,7 @@ The `Unreleased` section name is replaced by the expected version of next releas ### Added - Add handling for `-T` TCP/IP switch on EventStore args [#46](https://github.com/jet/dotnet-templates/pulls/46) +- `equinox-fc`: Fulfilment-Center inspired example utilizing Process Manager patterns with basic `Equinox.MemoryStore` and `Equinox.Cosmos` tests [#40](https://github.com/jet/dotnet-templates/pulls/40) ### Changed diff --git a/equinox-fc/.template.config/template.json b/equinox-fc/.template.config/template.json new file mode 100644 index 000000000..20972bd61 --- /dev/null +++ b/equinox-fc/.template.config/template.json @@ -0,0 +1,17 @@ +{ + "$schema": "http://json.schemastore.org/template", + "author": "@jet @bartelink", + "classifications": [ + "Equinox", + "Event Sourcing", + "Fc" + ], + "tags": { + "language": "F#" + }, + "identity": "Equinox.Fc", + "name": "Equinox Fc Example", + "shortName": "eqxfc", + "sourceName": "Fc", + "preferNameDirectory": true +} \ No newline at end of file From 5977207b22bc16146c71af5ba6a8be50e8e615ac Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 29 Nov 2019 20:39:51 +0000 Subject: [PATCH 03/45] Correct AccessStrategy --- equinox-fc/Domain/LocationEpoch.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index a76b7807d..37c46b6d5 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -85,6 +85,6 @@ module Cosmos = open Equinox.Cosmos let resolve (context,cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - Resolver(context, Events.codec, Folds.fold, Folds.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve + Resolver(context, Events.codec, Folds.fold, Folds.initial, cacheStrategy, AccessStrategy.Unoptimized).Resolve let createService (context,cache,maxAttempts) = create (resolve (context,cache)) maxAttempts \ No newline at end of file From 55d192b272145da529fd685e5e4c2cec9a78c08c Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 29 Nov 2019 20:40:11 +0000 Subject: [PATCH 04/45] Fix streamId ordering --- equinox-fc/Domain.Tests/LocationTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index 2e117f65f..f3835b08f 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -29,7 +29,7 @@ module Location = let run (service : LocationService) (IdsAtLeastOne locations, deltas : _[]) = Async.RunSynchronously <| async { let runId = mkId () // Need to make making state in store unique when replaying or shrinking - let locations = locations |> Array.map (fun x -> % (sprintf "%O_%O" runId x)) + let locations = locations |> Array.map (fun x -> % (sprintf "%O_%O" x runId)) let updates = deltas |> Seq.mapi (fun i x -> locations.[i % locations.Length], x) |> Seq.cache From bff353f3c5c56f1a1cc5b3866d91e21a874870e7 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 29 Nov 2019 20:40:35 +0000 Subject: [PATCH 05/45] Tidy log output --- equinox-fc/Domain.Tests/Infrastructure.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equinox-fc/Domain.Tests/Infrastructure.fs b/equinox-fc/Domain.Tests/Infrastructure.fs index 80c23b5eb..eddefa50f 100644 --- a/equinox-fc/Domain.Tests/Infrastructure.fs +++ b/equinox-fc/Domain.Tests/Infrastructure.fs @@ -32,7 +32,7 @@ module Cosmos = /// Adapts the XUnit ITestOutputHelper to be a Serilog Sink type TestOutputAdapter(testOutput : Xunit.Abstractions.ITestOutputHelper) = - let formatter = Serilog.Formatting.Display.MessageTemplateTextFormatter("{Timestamp:HH:mm:ss.fff zzz} [{Level:u3}] {Message}{Properties}{NewLine}{Exception}", null); + let formatter = Serilog.Formatting.Display.MessageTemplateTextFormatter("{Timestamp:HH:mm:ss.fff zzz} [{Level:u3}] {Message} {Properties}{NewLine}{Exception}", null); let writeSerilogEvent logEvent = use writer = new System.IO.StringWriter() formatter.Format(logEvent, writer) From 74233029c676cc419d693cb44173164b2e6fe8bf Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 29 Nov 2019 21:21:37 +0000 Subject: [PATCH 06/45] Tidy connection logic --- equinox-fc/Domain.Tests/Infrastructure.fs | 10 +++++----- equinox-fc/Domain.Tests/LocationTests.fs | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/equinox-fc/Domain.Tests/Infrastructure.fs b/equinox-fc/Domain.Tests/Infrastructure.fs index eddefa50f..66dd13d73 100644 --- a/equinox-fc/Domain.Tests/Infrastructure.fs +++ b/equinox-fc/Domain.Tests/Infrastructure.fs @@ -18,14 +18,14 @@ module Cosmos = open Equinox.Cosmos let connect () = match EnvVar.tryGet "EQUINOX_COSMOS_CONNECTION", EnvVar.tryGet "EQUINOX_COSMOS_DATABASE", EnvVar.tryGet "EQUINOX_COSMOS_CONTAINER" with - | Some s,Some d,Some c -> + | Some s, Some d, Some c -> let appName = "Domain.Tests" let discovery = Discovery.FromConnectionString s - let connector = Connector(TimeSpan.FromSeconds 5., 1, TimeSpan.FromSeconds 5., Serilog.Log.Logger) - let connection = connector.Connect(appName,discovery) |> Async.RunSynchronously - let context = Context(connection,d,c) + let connector = Connector(TimeSpan.FromSeconds 5., 5, TimeSpan.FromSeconds 5., Serilog.Log.Logger) + let connection = connector.Connect(appName, discovery) |> Async.RunSynchronously + let context = Context(connection, d, c) let cache = Equinox.Cache (appName, 10) - context,cache + context, cache | s,d,c -> failwithf "Connection, Database and Container EQUINOX_COSMOS_* Environment variables are required (%b,%b,%b)" (Option.isSome s) (Option.isSome d) (Option.isSome c) diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index f3835b08f..b4bacbaad 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -62,7 +62,7 @@ type Cosmos(testOutput) = let log = testOutput |> TestOutputAdapter |> createLogger do Serilog.Log.Logger <- log - let [] properties maxEvents args = + let [] properties maxEvents args = let zeroBalance = 0 let maxEvents = max 1 maxEvents let shouldClose (state : Epoch.Folds.OpenState) = state.count > maxEvents From 94164b2ada79addd89f876a578d9435bd521025e Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 29 Nov 2019 22:49:40 +0000 Subject: [PATCH 07/45] Add README --- README.md | 1 + equinox-fc/Domain/Location.fs | 1 + equinox-fc/Fc.sln | 5 +++++ equinox-fc/README.md | 26 ++++++++++++++++++++++++++ 4 files changed, 33 insertions(+) create mode 100644 equinox-fc/README.md diff --git a/README.md b/README.md index 5d56ea78c..e01f8b0b3 100644 --- a/README.md +++ b/README.md @@ -7,6 +7,7 @@ This repo hosts the source for Jet's [`dotnet new`](https://docs.microsoft.com/e - [`eqxweb`](equinox-web/README.md) - Boilerplate for an ASP .NET Core 2 Web App, with an associated storage-independent Domain project using [Equinox](https://github.com/jet/equinox). - [`eqxwebcs`](equinox-web-csharp/README.md) - Boilerplate for an ASP .NET Core 2 Web App, with an associated storage-independent Domain project using [Equinox](https://github.com/jet/equinox), _ported to C#_. - [`eqxtestbed`](equinox-testbed/README.md) - Host that allows running back-to-back benchmarks when prototyping models using [Equinox](https://github.com/jet/equinox), using different stores and/or store configuration parameters. +- [`eqxfc`](equinox-fc/README.md) - Samples showcasing various modeling and testing techniques such as (FsCheck-based) unit tests and use of `MemoryStore` for integration tests. ## [Propulsion](https://github.com/jet/propulsion) related diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index 50511d8d3..ff6b6b133 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -34,6 +34,7 @@ type LocationService internal (zeroBalance, shouldClose, series : Series.Service [] module Helpers = + let create (zeroBalance, shouldClose) (series, epochs) = LocationService(zeroBalance, shouldClose, series, epochs) diff --git a/equinox-fc/Fc.sln b/equinox-fc/Fc.sln index 2bf47b4d9..bfb82d823 100644 --- a/equinox-fc/Fc.sln +++ b/equinox-fc/Fc.sln @@ -7,6 +7,11 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "Domain\Domain.fsp EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "Domain.Tests\Domain.Tests.fsproj", "{AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}" EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".project", ".project", "{FEADBAC9-0CA2-440B-AF9B-184FED9B362E}" +ProjectSection(SolutionItems) = preProject + README.md = README.md +EndProjectSection +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU diff --git a/equinox-fc/README.md b/equinox-fc/README.md new file mode 100644 index 000000000..39e27fd7c --- /dev/null +++ b/equinox-fc/README.md @@ -0,0 +1,26 @@ +# Equinox FC Sample + +This project was generated using: + + dotnet new -i Equinox.Templates # just once, to install in the local templates store + + dotnet new eqxfc # use --help to see options regarding storage subsystem configuration etc + +# `Location*` + +The `Location`* `module`s illustrates a way to approach the modelling of a long-running state by having writers adhere to a common protocol when writing: + +- the `LocationEpoch` category represents a span of time, which is guaranteed to have a `CarriedForward` event representing the opening balance, and/or the balance carried forward when the preceding epoch was marked `Closed` +- the `LocationSeries` category bears the verified active epoch (competing readers/writers read this optimistically on a cached basis; in the event that they're behind, they'll compete to log the successful commencement of a new epoch, which cannot happen before the `CarriedForward` event for the successor epoch has been committed) + +- `Domain.Tests` includes (`FsCheck`) Property-based unit tests, and an integration tests that demonstrates parallel writes (that trigger Optimistic Concurrency Control-based conflict resolution, including against `MemoryStore`) + +## Notes + +- Referencing an `Equinox.*` Store module from the `Domain` project is not mandatory; it's common to defer all wiring and configuration of the elements in `module Cosmos`, `module EventStore` etc. and instead maintain that alongside the Composition Root, outside of the `Domain` project + +- While using an `AccessStrategy` such as `Snapshotting` may in some cases be relevant too, in the general case, using the `Equinox.Cache`, combined with having a compact Fold `State` and a sufficiently constrained maximum number/size of events means the state can be established within a predictable latency range. + +- Representing a long-running state in this fashion is no panacea; in modeling a system, the ideal is to have streams that have a naturally constrained number of events over their lifetime. + +- [Original PR](https://github.com/jet/dotnet-templates/pull/40) \ No newline at end of file From cb323fd2b9deba12689e56bc5e80f55ff6b6951c Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sat, 7 Dec 2019 03:24:54 +0000 Subject: [PATCH 08/45] Move AggregateId to Events --- equinox-fc/Domain/LocationEpoch.fs | 8 ++++---- equinox-fc/Domain/LocationSeries.fs | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 37c46b6d5..83725eb66 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -13,6 +13,9 @@ module Events = interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() let [] categoryId = "LocationEpoch" + let (|AggregateId|) (locationId, epochId) = + let id = sprintf "%s_%s" (LocationId.toString locationId) (LocationEpochId.toString epochId) + Equinox.AggregateId(categoryId, id) module Folds = @@ -69,10 +72,7 @@ let sync (balanceCarriedForward : Folds.Balance option) (decide : (Folds.Balance type Service internal (resolve, ?maxAttempts) = let log = Serilog.Log.ForContext() - let (|AggregateId|) (locationId, epochId) = - let id = sprintf "%s_%s" (LocationId.toString locationId) (LocationEpochId.toString epochId) - Equinox.AggregateId(Events.categoryId, id) - let (|Stream|) (AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) + let (|Stream|) (Events.AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) member __.Sync<'R>(locationId, epochId, prevEpochBalanceCarriedForward, decide, shouldClose) : Async> = let (Stream stream) = (locationId, epochId) diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index e75ccb9b4..8beebe800 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -10,6 +10,7 @@ module Events = interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() let [] categoryId = "LocationSeries" + let (|AggregateId|) id = Equinox.AggregateId(categoryId, LocationId.toString id) module Folds = @@ -28,8 +29,7 @@ let toActiveEpoch state = type Service internal (resolve, ?maxAttempts) = let log = Serilog.Log.ForContext() - let (|AggregateId|) id = Equinox.AggregateId(Events.categoryId, LocationId.toString id) - let (|Stream|) (AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) + let (|Stream|) (Events.AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) member __.Read(locationId) : Async = let (Stream stream) = locationId From 03445be6201c384c5059e6810bf6c7d291f5b911 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sat, 7 Dec 2019 09:18:10 +0000 Subject: [PATCH 09/45] Aggregate layout/naming consistency --- equinox-fc/Domain.Tests/LocationEpochTests.fs | 4 +- .../Domain.Tests/LocationSeriesTests.fs | 6 +-- equinox-fc/Domain.Tests/LocationTests.fs | 18 +++---- equinox-fc/Domain/Location.fs | 2 +- equinox-fc/Domain/LocationEpoch.fs | 47 +++++++++---------- equinox-fc/Domain/LocationSeries.fs | 25 +++++----- 6 files changed, 50 insertions(+), 52 deletions(-) diff --git a/equinox-fc/Domain.Tests/LocationEpochTests.fs b/equinox-fc/Domain.Tests/LocationEpochTests.fs index 8a4e14a4a..6901aa746 100644 --- a/equinox-fc/Domain.Tests/LocationEpochTests.fs +++ b/equinox-fc/Domain.Tests/LocationEpochTests.fs @@ -22,10 +22,10 @@ let [] properties carriedForward delta1 closeImmediately delta2 close (* Starting with an empty stream, we'll need to supply the balance carried forward, optionally we apply a delta and potentially close *) let initialShouldClose _state = closeImmediately - let res,events = sync (Some carriedForward) (validateAndInterpret carriedForward delta1) initialShouldClose Folds.initial + let res,events = sync (Some carriedForward) (validateAndInterpret carriedForward delta1) initialShouldClose Fold.initial let cfEvents events = events |> List.filter (function Events.CarriedForward _ -> true | _ -> false) let closeEvents events = events |> List.filter (function Events.Closed -> true | _ -> false) - let state1 = Folds.fold Folds.initial events + let state1 = Fold.fold Fold.initial events let expectedBalance = carriedForward + delta1 // Only expect closing if it was requested let expectImmediateClose = closeImmediately diff --git a/equinox-fc/Domain.Tests/LocationSeriesTests.fs b/equinox-fc/Domain.Tests/LocationSeriesTests.fs index 1bd09a28d..b0ec09dd7 100644 --- a/equinox-fc/Domain.Tests/LocationSeriesTests.fs +++ b/equinox-fc/Domain.Tests/LocationSeriesTests.fs @@ -6,8 +6,8 @@ open Swensen.Unquote open Location.Series let [] properties c1 c2 = - let events = interpretActivateEpoch c1 Folds.initial - let state1 = Folds.fold Folds.initial events + let events = interpretActivateEpoch c1 Fold.initial + let state1 = Fold.fold Fold.initial events let epoch0 = %0 match c1, events, toActiveEpoch state1 with // Started events are not written for < 0 @@ -21,7 +21,7 @@ let [] properties c1 c2 = test <@ List.isEmpty l @> let events = interpretActivateEpoch c2 state1 - let state2 = Folds.fold state1 events + let state2 = Fold.fold state1 events match toActiveEpoch state1, c2, events, toActiveEpoch state2 with // Started events are not written for < 0 | None, n, [], activeEpoch when n < epoch0 -> diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index b4bacbaad..169834991 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -9,17 +9,17 @@ open System /// Helpers to match `module Cosmos` wrapping inside the impl module Location = - open Equinox.MemoryStore + module MemoryStore = - module Series = + open Equinox.MemoryStore - let resolve store = Resolver(store, Series.Events.codec, Series.Folds.fold, Series.Folds.initial).Resolve + module Series = - module Epoch = + let resolve store = Resolver(store, Series.Events.codec, Series.Fold.fold, Series.Fold.initial).Resolve - let resolve store = Resolver(store, Epoch.Events.codec, Epoch.Folds.fold, Epoch.Folds.initial).Resolve + module Epoch = - module MemoryStore = + let resolve store = Resolver(store, Epoch.Events.codec, Epoch.Fold.fold, Epoch.Fold.initial).Resolve let createService (zeroBalance, shouldClose) store = let maxAttempts = Int32.MaxValue @@ -35,7 +35,7 @@ let run (service : LocationService) (IdsAtLeastOne locations, deltas : _[]) = As (* Apply random deltas *) - let adjust delta (bal : Epoch.Folds.Balance) = + let adjust delta (bal : Epoch.Fold.Balance) = let value = max -bal delta if value = 0 then 0, [] else value, [Location.Epoch.Events.Delta { value = value }] @@ -51,7 +51,7 @@ let [] ``MemoryStore properties`` maxEvents args = let store = Equinox.MemoryStore.VolatileStore() let zeroBalance = 0 let maxEvents = max 1 maxEvents - let shouldClose (state : Epoch.Folds.OpenState) = state.count > maxEvents + let shouldClose (state : Epoch.Fold.OpenState) = state.count > maxEvents let service = Location.MemoryStore.createService (zeroBalance, shouldClose) store run service args @@ -65,6 +65,6 @@ type Cosmos(testOutput) = let [] properties maxEvents args = let zeroBalance = 0 let maxEvents = max 1 maxEvents - let shouldClose (state : Epoch.Folds.OpenState) = state.count > maxEvents + let shouldClose (state : Epoch.Fold.OpenState) = state.count > maxEvents let service = Location.Cosmos.createService (zeroBalance, shouldClose) (context,cache,Int32.MaxValue) run service args \ No newline at end of file diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index ff6b6b133..7e4468f58 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -2,7 +2,7 @@ namespace Location [] type Wip<'R> = - | Pending of decide : (Epoch.Folds.Balance -> 'R*Epoch.Events.Event list) + | Pending of decide : (Epoch.Fold.Balance -> 'R*Epoch.Events.Event list) | Complete of 'R /// Manages a Series of Epochs, with a running total being carried forward to the next Epoch when it's Closed diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 83725eb66..e2f41d27f 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -12,12 +12,12 @@ module Events = | Delta of Delta interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() - let [] categoryId = "LocationEpoch" - let (|AggregateId|) (locationId, epochId) = + let [] category = "LocationEpoch" + let (|For|) (locationId, epochId) = let id = sprintf "%s_%s" (LocationId.toString locationId) (LocationEpochId.toString epochId) - Equinox.AggregateId(categoryId, id) + Equinox.AggregateId(category, id) -module Folds = +module Fold = type Balance = int type OpenState = { count : int; value : Balance } @@ -36,55 +36,54 @@ module Folds = /// Holds events accumulated from a series of decisions while also evolving the presented `state` to reflect the pended events type private Accumulator() = let acc = ResizeArray() - member __.Ingest state : 'res * Events.Event list -> 'res * Folds.State = function + member __.Ingest state : 'res * Events.Event list -> 'res * Fold.State = function | res, [] -> res, state - | res, [e] -> acc.Add e; res, Folds.evolve state e - | res, xs -> acc.AddRange xs; res, Folds.fold state (Seq.ofList xs) + | res, [e] -> acc.Add e; res, Fold.evolve state e + | res, xs -> acc.AddRange xs; res, Fold.fold state (Seq.ofList xs) member __.Accumulated = List.ofSeq acc -type Result<'t> = { balance : Folds.Balance; result : 't option; isOpen : bool } +type Result<'t> = { balance : Fold.Balance; result : 't option; isOpen : bool } -let sync (balanceCarriedForward : Folds.Balance option) (decide : (Folds.Balance -> 't*Events.Event list)) shouldClose state : Result<'t>*Events.Event list = +let sync (balanceCarriedForward : Fold.Balance option) (decide : (Fold.Balance -> 't*Events.Event list)) shouldClose state : Result<'t>*Events.Event list = let acc = Accumulator() // We always want to have a CarriedForward event at the start of any Epoch's event stream let (), state = acc.Ingest state <| match state with - | Folds.Initial -> (), [Events.CarriedForward { initial = Option.get balanceCarriedForward }] - | Folds.Open _ | Folds.Closed _ -> (), [] + | Fold.Initial -> (), [Events.CarriedForward { initial = Option.get balanceCarriedForward }] + | Fold.Open _ | Fold.Closed _ -> (), [] // Run, unless we determine we're in Closed state let result, state = acc.Ingest state <| match state with - | Folds.Initial -> failwith "We've just guaranteed not Initial" - | Folds.Open { value = bal } -> let r,es = decide bal in Some r,es - | Folds.Closed _ -> None, [] + | Fold.Initial -> failwith "We've just guaranteed not Initial" + | Fold.Open { value = bal } -> let r,es = decide bal in Some r,es + | Fold.Closed _ -> None, [] // Finally (iff we're `Open`, have run a `decide` and `shouldClose`), we generate a Closed event let (balance, isOpen), _ = acc.Ingest state <| match state with - | Folds.Initial -> failwith "Can't be Initial" - | Folds.Open ({ value = bal } as openState) when shouldClose openState -> (bal, false), [Events.Closed] - | Folds.Open { value = bal } -> (bal, true), [] - | Folds.Closed bal -> (bal, false), [] + | Fold.Initial -> failwith "Can't be Initial" + | Fold.Open ({ value = bal } as openState) when shouldClose openState -> (bal, false), [Events.Closed] + | Fold.Open { value = bal } -> (bal, true), [] + | Fold.Closed bal -> (bal, false), [] { balance = balance; result = result; isOpen = isOpen }, acc.Accumulated -type Service internal (resolve, ?maxAttempts) = +type Service internal (log, resolve, maxAttempts) = - let log = Serilog.Log.ForContext() - let (|Stream|) (Events.AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) + let resolve (Events.For id) = Equinox.Stream(log, resolve id, maxAttempts) member __.Sync<'R>(locationId, epochId, prevEpochBalanceCarriedForward, decide, shouldClose) : Async> = - let (Stream stream) = (locationId, epochId) + let stream = resolve (locationId, epochId) stream.Transact(sync prevEpochBalanceCarriedForward decide shouldClose) -let create resolve maxAttempts = Service(resolve, maxAttempts) +let create resolve maxAttempts = Service(Serilog.Log.ForContext(), resolve, maxAttempts = maxAttempts) module Cosmos = open Equinox.Cosmos let resolve (context,cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - Resolver(context, Events.codec, Folds.fold, Folds.initial, cacheStrategy, AccessStrategy.Unoptimized).Resolve + Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.Unoptimized).Resolve let createService (context,cache,maxAttempts) = create (resolve (context,cache)) maxAttempts \ No newline at end of file diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index 8beebe800..7c7d1e6c8 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -9,10 +9,10 @@ module Events = | Started of Started interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() - let [] categoryId = "LocationSeries" - let (|AggregateId|) id = Equinox.AggregateId(categoryId, LocationId.toString id) + let [] category = "LocationSeries" + let (|For|) id = Equinox.AggregateId(category, LocationId.toString id) -module Folds = +module Fold = type State = LocationEpochId let initial = LocationEpochId.parse -1 @@ -20,26 +20,25 @@ module Folds = | Events.Started e -> e.epochId let fold = Seq.fold evolve -let interpretActivateEpoch epochId (state : Folds.State) = +let interpretActivateEpoch epochId (state : Fold.State) = [if state < epochId then yield Events.Started { epochId = epochId }] let toActiveEpoch state = - if state = Folds.initial then None else Some state + if state = Fold.initial then None else Some state -type Service internal (resolve, ?maxAttempts) = +type Service internal (log, resolve, maxAttempts) = - let log = Serilog.Log.ForContext() - let (|Stream|) (Events.AggregateId id) = Equinox.Stream(log, resolve id, maxAttempts = defaultArg maxAttempts 2) + let resolve (Events.For id) = Equinox.Stream(log, resolve id, maxAttempts) member __.Read(locationId) : Async = - let (Stream stream) = locationId + let stream = resolve locationId stream.Query toActiveEpoch - member __.ActivateEpoch(locationId,epochId) : Async = - let (Stream stream) = locationId + member __.ActivateEpoch(locationId, epochId) : Async = + let stream = resolve locationId stream.Transact(interpretActivateEpoch epochId) -let create resolve maxAttempts = Service(resolve, maxAttempts) +let create resolve maxAttempts = Service(Serilog.Log.ForContext(), resolve, maxAttempts) module Cosmos = @@ -47,6 +46,6 @@ module Cosmos = let resolve (context,cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) let opt = Equinox.ResolveOption.AllowStale - fun id -> Resolver(context, Events.codec, Folds.fold, Folds.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id,opt) + fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id,opt) let createService (context, cache, maxAttempts) = create (resolve (context,cache)) maxAttempts \ No newline at end of file From 72b415944e7657ce0e511b4029a0c71a957d07fc Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 17 Jan 2020 12:30:04 +0000 Subject: [PATCH 10/45] Sync layout --- equinox-fc/Domain/LocationEpoch.fs | 9 +++++---- equinox-fc/Domain/LocationSeries.fs | 7 ++++--- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index e2f41d27f..e5c0f571d 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -4,6 +4,11 @@ module Location.Epoch [] module Events = + let [] category = "LocationEpoch" + let (|For|) (locationId, epochId) = + let id = sprintf "%s_%s" (LocationId.toString locationId) (LocationEpochId.toString epochId) + Equinox.AggregateId (category, id) + type CarriedForward = { initial : int } type Delta = { value : int } type Event = @@ -12,10 +17,6 @@ module Events = | Delta of Delta interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() - let [] category = "LocationEpoch" - let (|For|) (locationId, epochId) = - let id = sprintf "%s_%s" (LocationId.toString locationId) (LocationEpochId.toString epochId) - Equinox.AggregateId(category, id) module Fold = diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index 7c7d1e6c8..d1ff8972e 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -4,19 +4,20 @@ module Location.Series [] module Events = + let [] category = "LocationSeries" + let (|For|) id = Equinox.AggregateId (category, LocationId.toString id) + type Started = { epochId : LocationEpochId } type Event = | Started of Started interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() - let [] category = "LocationSeries" - let (|For|) id = Equinox.AggregateId(category, LocationId.toString id) module Fold = type State = LocationEpochId let initial = LocationEpochId.parse -1 - let evolve _state = function + let private evolve _state = function | Events.Started e -> e.epochId let fold = Seq.fold evolve From c9c56b6522eb0f52a53f3359d8f5d80fcac378c8 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 12 Feb 2020 10:26:41 +0000 Subject: [PATCH 11/45] wip --- dotnet-templates.sln | 19 ++++ equinox-fc/.template.config/template.json | 5 +- .../Domain.Tests/LocationSeriesTests.fs | 4 +- equinox-fc/Domain/Domain.fsproj | 3 + equinox-fc/Domain/Infrastructure.fs | 21 ++++- equinox-fc/Domain/Inventory.fs | 83 +++++++++++++++++ equinox-fc/Domain/InventoryEpoch.fs | 93 +++++++++++++++++++ equinox-fc/Domain/InventorySeries.fs | 66 +++++++++++++ equinox-fc/Domain/Location.fs | 6 +- equinox-fc/Domain/LocationEpoch.fs | 7 +- equinox-fc/Domain/LocationSeries.fs | 15 ++- 11 files changed, 303 insertions(+), 19 deletions(-) create mode 100644 equinox-fc/Domain/Inventory.fs create mode 100644 equinox-fc/Domain/InventoryEpoch.fs create mode 100644 equinox-fc/Domain/InventorySeries.fs diff --git a/dotnet-templates.sln b/dotnet-templates.sln index 5db9a23d5..4de1cdd8b 100644 --- a/dotnet-templates.sln +++ b/dotnet-templates.sln @@ -80,6 +80,15 @@ EndProjectSection EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Equinox.Templates", "src\Equinox.Templates\Equinox.Templates.fsproj", "{8C92B728-85A5-4231-863A-E4236E46CC36}" EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "fc", "fc", "{4946576F-1558-49ED-A272-6F4D92FB0031}" +ProjectSection(SolutionItems) = preProject + equinox-fc\.template.config\template.json = equinox-fc\.template.config\template.json +EndProjectSection +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "equinox-fc\Domain\Domain.fsproj", "{B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "equinox-fc\Domain.Tests\Domain.Tests.fsproj", "{49890A45-D6C2-4EF6-87AD-39960E03E254}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -132,6 +141,14 @@ Global {8C92B728-85A5-4231-863A-E4236E46CC36}.Debug|Any CPU.Build.0 = Debug|Any CPU {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.ActiveCfg = Release|Any CPU {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.Build.0 = Release|Any CPU + {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}.Debug|Any CPU.Build.0 = Debug|Any CPU + {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}.Release|Any CPU.ActiveCfg = Release|Any CPU + {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}.Release|Any CPU.Build.0 = Release|Any CPU + {49890A45-D6C2-4EF6-87AD-39960E03E254}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {49890A45-D6C2-4EF6-87AD-39960E03E254}.Debug|Any CPU.Build.0 = Debug|Any CPU + {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.ActiveCfg = Release|Any CPU + {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(NestedProjects) = preSolution {F66A5BFE-7C81-44DC-97DE-3FD8C83B8F06} = {B72FFAAE-7801-41B2-86F5-FD90E97A30F7} @@ -145,5 +162,7 @@ Global {D7ACBDF8-5F24-420F-9657-20096CE08B49} = {818D28A6-E6AB-4416-BDA6-1577C5D54447} {B6389F9E-A8E4-4BD7-B4C0-703B1A69BEA1} = {E7434881-8655-4C22-82CD-91ADB5123A73} {36C2D70A-F292-4481-8ADA-5066A80F92B2} = {1F3C9245-F973-43A3-97C9-5E527B93060C} + {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C} = {4946576F-1558-49ED-A272-6F4D92FB0031} + {49890A45-D6C2-4EF6-87AD-39960E03E254} = {4946576F-1558-49ED-A272-6F4D92FB0031} EndGlobalSection EndGlobal diff --git a/equinox-fc/.template.config/template.json b/equinox-fc/.template.config/template.json index 20972bd61..135b57883 100644 --- a/equinox-fc/.template.config/template.json +++ b/equinox-fc/.template.config/template.json @@ -4,14 +4,15 @@ "classifications": [ "Equinox", "Event Sourcing", - "Fc" + "Fc", + "Propulsion" ], "tags": { "language": "F#" }, "identity": "Equinox.Fc", "name": "Equinox Fc Example", - "shortName": "eqxfc", + "shortName": "eqxFc", "sourceName": "Fc", "preferNameDirectory": true } \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/LocationSeriesTests.fs b/equinox-fc/Domain.Tests/LocationSeriesTests.fs index b0ec09dd7..4335d8128 100644 --- a/equinox-fc/Domain.Tests/LocationSeriesTests.fs +++ b/equinox-fc/Domain.Tests/LocationSeriesTests.fs @@ -9,7 +9,7 @@ let [] properties c1 c2 = let events = interpretActivateEpoch c1 Fold.initial let state1 = Fold.fold Fold.initial events let epoch0 = %0 - match c1, events, toActiveEpoch state1 with + match c1, events, state1 with // Started events are not written for < 0 | n, [], activeEpoch when n < epoch0 -> test <@ None = activeEpoch @> @@ -22,7 +22,7 @@ let [] properties c1 c2 = let events = interpretActivateEpoch c2 state1 let state2 = Fold.fold state1 events - match toActiveEpoch state1, c2, events, toActiveEpoch state2 with + match state1, c2, events, state2 with // Started events are not written for < 0 | None, n, [], activeEpoch when n < epoch0 -> test <@ None = activeEpoch @> diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index 107408957..a3c779a4a 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -11,6 +11,9 @@ + + + diff --git a/equinox-fc/Domain/Infrastructure.fs b/equinox-fc/Domain/Infrastructure.fs index 7a1bfa843..945811c5d 100644 --- a/equinox-fc/Domain/Infrastructure.fs +++ b/equinox-fc/Domain/Infrastructure.fs @@ -13,4 +13,23 @@ and [] locationEpochId module LocationEpochId = let parse (value : int) : LocationEpochId = %value let next (value : LocationEpochId) : LocationEpochId = % (%value + 1) - let toString (value : LocationEpochId) : string = string %value \ No newline at end of file + let toString (value : LocationEpochId) : string = string %value + +type InventoryId = string +and [] inventoryId +module InventoryId = + let parse (value : string) : InventoryId = %value + let toString (value : InventoryId) : string = %value + +type InventoryEpochId = int +and [] inventoryEpochId +module InventoryEpochId = + let parse (value : int) : InventoryEpochId = %value + let next (value : InventoryEpochId) : InventoryEpochId = % (%value + 1) + let toString (value : InventoryEpochId) : string = string %value + +type InventoryTransactionId = string +and [] inventoryTransactionId +module InventoryTransactionId = + let parse (value : string) : InventoryTransactionId = %value + let toString (value : InventoryTransactionId) : string = %value \ No newline at end of file diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs new file mode 100644 index 000000000..f587010fa --- /dev/null +++ b/equinox-fc/Domain/Inventory.fs @@ -0,0 +1,83 @@ +namespace Domain.Inventory + +open Equinox.Core // we use Equinox's AsyncCacheCell helper below +open FSharp.UMX + +type internal TicketsCache() = + let all = System.Collections.Concurrent.ConcurrentDictionary() // Bounded only by relatively low number of physical pick tickets IRL + static member Create init = let x = TicketsCache() in x.Add init; x + member __.Add tickets = for x in tickets do all.[x] <- () + member __.Contains ticket = all.ContainsKey ticket + +/// Maintains active BatchId in a thread-safe manner while ingesting items into the chain of `batches` indexed by the `transmissions` +/// Prior to first add, reads `lookBack` batches to seed the cache, in order to minimize the number of duplicated pickTickets we transmit +type Ingester internal (fcId, batches : Batch.Service, transmissions : Transmissions.Service, lookBack, capacity) = + + let log = Serilog.Log.ForContext() + // Maintains what we believe to be the currently open BatchId. + // Guaranteed to be set only after `previousTicket.AwaitValue()` + let mutable activeId = Unchecked.defaultof<_> + + // We want max one request in flight to establish the pre-existing Batches from which the tickets cache will be seeded + let previousBatches = AsyncCacheCell list> <| async { + let! startingId = transmissions.ReadIngestionBatchId(fcId) + activeId <- %startingId + let readBatch batchId = async { let! r = batches.IngestShipped(fcId,batchId,(fun _ -> 1),Seq.empty) in return r.batchContent } + return [ for b in (max 0 (%startingId - lookBack)) .. (%startingId - 1) -> AsyncCacheCell(readBatch %b) ] } + + // Tickets cache - used to maintain a list of tickets that have already been ingested in order to avoid db round-trips + let previousTickets : AsyncCacheCell = AsyncCacheCell <| async { + let! batches = previousBatches.AwaitValue() + let! tickets = seq { for x in batches -> x.AwaitValue() } |> Async.Parallel + return TicketsCache.Create(Seq.concat tickets) } + + let tryIngest items = async { + let! previousTickets = previousTickets.AwaitValue() + let firstBatchId = %activeId + + let rec aux batchId totalIngestedTickets items = async { + let dup,fresh = items |> List.partition previousTickets.Contains + let fullCount = List.length items + let dropping = fullCount - List.length fresh + if dropping <> 0 then log.Information("Ignoring {count}/{fullCount} duplicate ids: {ids} for {batchId}", dropping, fullCount, dup, batchId) + if List.isEmpty fresh then + return totalIngestedTickets + else + let! res = batches.IngestShipped(fcId,batchId,capacity,fresh) + log.Information("Added {count} items to {fcId:l}/{batchId}", res.added, fcId, batchId) + // The adding is potentially redundant; we don't care + previousTickets.Add res.batchContent + // Any writer noticing we've moved to a new batch shares the burden of marking it active + if not res.isClosed && activeId < %batchId then + log.Information("Marking {fcId:l}/{batchId} active", fcId, batchId) + do! transmissions.MarkIngestionBatchId(fcId,batchId) + System.Threading.Interlocked.CompareExchange(&activeId,%batchId,activeId) |> ignore + let totalIngestedTickets = totalIngestedTickets + res.added + match res.rejected with + | [] -> return totalIngestedTickets + | rej -> return! aux (BatchId.next batchId) totalIngestedTickets rej } + return! aux firstBatchId 0 items + } + + /// Upon startup, we initialize the PickTickets cache with recent batches; we want to kick that process off before our first ingest + member __.Initialize() = previousBatches.AwaitValue() |> Async.Ignore + + /// Feeds the items into the sequence of batches. Returns the number of items actually added [excluding duplicates] + member __.Ingest(items : PickTicketId list) : Async = tryIngest items + +module PickTicketsIngester = + + let create fcId maxPickTicketsPerBatch lookBackLimit batchesResolve (epochOverride,transmissionsResolve) = + let remainingBatchCapacity (state: Financial.Batch.Fold.State) = + let l = state.ItemCount + max 0 (maxPickTicketsPerBatch-l) + let batches = Financial.Batch.createService batchesResolve + let transmissions = Financial.Transmissions.createService epochOverride transmissionsResolve + Ingester(fcId, batches, transmissions, lookBack=lookBackLimit, capacity=remainingBatchCapacity) + + module Cosmos = + + let create epochOverride fcId maxPickTicketsPerBatch lookBackLimit (context,cache) = + let batchesResolve = Financial.Batch.Cosmos.resolve (context,cache) + let transmissionsResolve = Financial.Transmissions.Cosmos.resolve (context,cache) + create fcId maxPickTicketsPerBatch lookBackLimit batchesResolve (epochOverride,transmissionsResolve) diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs new file mode 100644 index 000000000..f78bdd25c --- /dev/null +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -0,0 +1,93 @@ +module Domain.Inventory.Epoch + +open System + +// NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +[] +module Events = + + let [] categoryId = "InventoryEpoch" + let (|For|) (inventoryId : InventoryId, epochId : InventoryEpochId) = + let streamId = sprintf "%s_%s" (InventoryId.toString inventoryId) (InventoryEpochId.toString epochId) + Equinox.AggregateId(categoryId, streamId) + + type Transferred = { transactionId : InventoryTransactionId } + type Adjusted = { transactionId : InventoryTransactionId } + + type Snapshotted = { closed: bool; ids : InventoryTransactionId[] } + + type Event = + | Adjusted of Adjusted + | Transferred of Transferred + | Closed + | Snapshotted of Snapshotted + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + // TOCONSIDER - codec could pull transferId from meta + +module Fold = + + type State = { closed : bool; ids : Set } + let initial = { closed = false; ids = Set.empty } + let evolve state = function + | Events.Adjusted e -> { state with ids = Set.add e.transactionId state.ids } + | Events.Transferred e -> { state with ids = Set.add e.transactionId state.ids } + | Events.Closed -> { state with closed = true } + | Events.Snapshotted e -> { closed = e.closed; ids = Set.ofArray e.ids } + let fold : State -> Events.Event seq -> State = Seq.fold evolve + let isOrigin = function Events.Snapshotted _ -> true | _ -> false + let snapshot s = Events.Snapshotted { closed = s.closed; ids = Array.ofSeq s.ids } + +type Result = + { /// Indicates whether this epoch is closed (either previously or as a side-effect this time) + isClosed : bool + /// Count of items added to this epoch. May be less than requested due to removal of duplicates and/or rejected items + added : int + /// residual items that [are not duplicates and] were not accepted into this epoch + rejected : Events.Event list } + +let decideSync capacity requested (state : Fold.State) : Result * Events.Event list = + let isFresh = function + | Events.Adjusted { transactionId = id } + | Events.Transferred { transactionId = id } -> (not << state.ids.Contains) id + | Events.Closed | Events.Snapshotted _ -> false + let news = requested |> Seq.filter isFresh |> List.ofSeq + let closed,allowing,markClosed,residual = + let newCount = List.length news + if state.closed then + true,0,false,news + else + let capacityNow = capacity state + let accepting = min capacityNow newCount + let closing = accepting = capacityNow + let residual = List.skip accepting news + closing,accepting,closing,residual + let events = + [ if allowing <> 0 then yield! news + if markClosed then yield Events.Closed ] + let state' = Fold.fold state events + { isClosed = closed; added = allowing; rejected = residual },events + +type Service internal (log, resolve, maxAttempts) = + + let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) + + /// Attempt ingestion of `events` into the cited Epoch. + /// - No `items` will be accepted if the Epoch is `closed` + /// - The `capacity` function will be passed a non-closed `state` in order to determine number of items that can be admitted prior to closing + /// - If the computed capacity result is >= the number of items being submitted (which may be 0), the Epoch will be marked Closed + /// NOTE the result may include rejected items (which the caller is expected to feed into a successor epoch) + member __.IngestShipped(inventoryId, epochId, capacity, events) : Async = + let stream = resolve (inventoryId, epochId) + stream.Transact(decideSync capacity events) + +let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) + +module Cosmos = + + open Equinox.Cosmos + let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) + let resolve (context,cache) = + let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) + Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve + let createService (context,cache) = createService (resolve (context,cache)) \ No newline at end of file diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs new file mode 100644 index 000000000..a70c8abb0 --- /dev/null +++ b/equinox-fc/Domain/InventorySeries.fs @@ -0,0 +1,66 @@ +module Domain.Inventory.Series + +// NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +[] +module Events = + + let [] categoryId = "InventorySeries" + let (|For|) inventoryId = Equinox.AggregateId(categoryId, InventoryId.toString inventoryId) + + type Epoch = { epoch : InventoryEpochId } + type Checkpoint = { epoch : InventoryEpochId; index : int64 } + type Snapshotted = { writing : InventoryEpochId; checkpoint : Checkpoint option } + type Event = + | Started of Epoch + | Checkpointed of Checkpoint + | Snapshotted of Snapshotted + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + +module Fold = + + type State = { writing : InventoryEpochId; checkpoint : Events.Checkpoint option } + + let initial = { writing = 0; checkpoint = None } + let evolve state = function + | Events.Started e -> { state with writing = e.epoch } + | Events.Checkpointed e -> { state with checkpoint = Some e } + | Events.Snapshotted e -> { writing = e.writing; checkpoint = e.checkpoint } + let fold : State -> Events.Event seq -> State = Seq.fold evolve + + let isOrigin = function Events.Snapshotted _ -> true | _ -> false + let snapshot s = Events.Snapshotted { writing = s.writing; checkpoint = s.checkpoint } + // TODO transmute to remove checkpoints (a la propulsion?) + +let interpretMarkWriting epochId (state : Fold.State) = + if state.writing >= epochId then [] + else [Events.Started { epoch = epochId }] + +type Service internal (log, resolve, maxAttempts) = + + let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) + + member __.ReadIngestionEpochId inventoryId : Async = + let stream = resolve inventoryId + stream.Query(fun s -> s.writing) + + member __.UpdateEpoch(inventoryId, epochId) : Async = + let stream = resolve inventoryId + stream.Transact(interpretMarkWriting epochId) + +let createService resolve = + Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) + +module Cosmos = + + open Equinox.Cosmos + let resolve (context,cache) = + let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // For this stream, we uniformly use stale reads as: + // a) we don't require any information from competing writers + // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale + let accessStrategy = AccessStrategy.Snapshot(Fold.isOrigin,Fold.snapshot) + fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) + let createService (context,cache) = + createService (resolve (context,cache)) diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index 7e4468f58..86dd213dc 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -6,7 +6,7 @@ type Wip<'R> = | Complete of 'R /// Manages a Series of Epochs, with a running total being carried forward to the next Epoch when it's Closed -type LocationService internal (zeroBalance, shouldClose, series : Series.Service, epochs : Epoch.Service) = +type Service internal (zeroBalance, shouldClose, series : Series.Service, epochs : Epoch.Service) = let rec execute locationId originEpochId = let rec aux epochId balanceToCarryForward wip = async { @@ -25,7 +25,7 @@ type LocationService internal (zeroBalance, shouldClose, series : Series.Service aux member __.Execute(locationId, decide) = async { - let! activeEpoch = series.Read locationId + let! activeEpoch = series.ReadIngestionEpoch locationId let originEpochId, epochId, balanceCarriedForward = match activeEpoch with | None -> LocationEpochId.parse -1, LocationEpochId.parse 0, Some zeroBalance @@ -36,7 +36,7 @@ type LocationService internal (zeroBalance, shouldClose, series : Series.Service module Helpers = let create (zeroBalance, shouldClose) (series, epochs) = - LocationService(zeroBalance, shouldClose, series, epochs) + Service(zeroBalance, shouldClose, series, epochs) module Cosmos = diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index e5c0f571d..3189d8e3e 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -11,10 +11,12 @@ module Events = type CarriedForward = { initial : int } type Delta = { value : int } + type Value = { value : int } type Event = | CarriedForward of CarriedForward | Closed | Delta of Delta + | Reset of Value interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() @@ -28,9 +30,10 @@ module Fold = match event, state with | Events.CarriedForward e, Initial -> Open { count = 0; value = e.initial } | Events.Delta e, Open bal -> Open { count = bal.count + 1; value = bal.value + e.value } + | Events.Reset e, Open bal -> Open { count = bal.count + 1; value = e.value } | Events.Closed, Open { value = bal } -> Closed bal | Events.CarriedForward _, (Open _|Closed _ as x) -> failwithf "CarriedForward : Unexpected %A" x - | Events.Delta _, (Initial|Closed _ as x) -> failwithf "Delta : Unexpected %A" x + | (Events.Delta _|Events.Reset _), (Initial|Closed _ as x) -> failwithf "Delta : Unexpected %A" x | Events.Closed, (Initial|Closed _ as x) -> failwithf "Closed : Unexpected %A" x let fold = Seq.fold evolve @@ -47,7 +50,7 @@ type Result<'t> = { balance : Fold.Balance; result : 't option; isOpen : bool } let sync (balanceCarriedForward : Fold.Balance option) (decide : (Fold.Balance -> 't*Events.Event list)) shouldClose state : Result<'t>*Events.Event list = let acc = Accumulator() - // We always want to have a CarriedForward event at the start of any Epoch's event stream + // We require a CarriedForward event at the start of any Epoch's event stream let (), state = acc.Ingest state <| match state with diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index d1ff8972e..f81aecff7 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -15,25 +15,22 @@ module Events = module Fold = - type State = LocationEpochId - let initial = LocationEpochId.parse -1 + type State = LocationEpochId option + let initial = None let private evolve _state = function - | Events.Started e -> e.epochId + | Events.Started e -> Some e.epochId let fold = Seq.fold evolve let interpretActivateEpoch epochId (state : Fold.State) = - [if state < epochId then yield Events.Started { epochId = epochId }] - -let toActiveEpoch state = - if state = Fold.initial then None else Some state + [if state |> Option.forall (fun s -> s < epochId) then yield Events.Started { epochId = epochId }] type Service internal (log, resolve, maxAttempts) = let resolve (Events.For id) = Equinox.Stream(log, resolve id, maxAttempts) - member __.Read(locationId) : Async = + member __.ReadIngestionEpoch(locationId) : Async = let stream = resolve locationId - stream.Query toActiveEpoch + stream.Query id member __.ActivateEpoch(locationId, epochId) : Async = let stream = resolve locationId From 4b06d7759f947af506320d7cd18df31971ef7af6 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 12 Feb 2020 17:08:02 +0000 Subject: [PATCH 12/45] wip --- equinox-fc/Domain.Tests/Domain.Tests.fsproj | 2 +- equinox-fc/Domain/Domain.fsproj | 4 +- equinox-fc/Domain/Infrastructure.fs | 5 + equinox-fc/Domain/Inventory.fs | 26 ++--- equinox-fc/Domain/InventoryEpoch.fs | 19 ++-- equinox-fc/Domain/InventorySeries.fs | 18 ++-- equinox-fc/Domain/InventoryTransaction.fs | 114 ++++++++++++++++++++ equinox-fc/Domain/Location.fs | 4 +- equinox-fc/Domain/LocationEpoch.fs | 21 ++-- equinox-fc/Domain/LocationSeries.fs | 6 +- 10 files changed, 167 insertions(+), 52 deletions(-) create mode 100644 equinox-fc/Domain/InventoryTransaction.fs diff --git a/equinox-fc/Domain.Tests/Domain.Tests.fsproj b/equinox-fc/Domain.Tests/Domain.Tests.fsproj index 8ec512e47..40feab0a9 100644 --- a/equinox-fc/Domain.Tests/Domain.Tests.fsproj +++ b/equinox-fc/Domain.Tests/Domain.Tests.fsproj @@ -16,7 +16,7 @@ - + diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index a3c779a4a..496064bdd 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -14,10 +14,10 @@ + - - + diff --git a/equinox-fc/Domain/Infrastructure.fs b/equinox-fc/Domain/Infrastructure.fs index 945811c5d..0ef31b200 100644 --- a/equinox-fc/Domain/Infrastructure.fs +++ b/equinox-fc/Domain/Infrastructure.fs @@ -6,12 +6,14 @@ type LocationId = string and [] locationId module LocationId = let parse (value : string) : LocationId = %value + let (|Parse|) = parse let toString (value : LocationId) : string = %value type LocationEpochId = int and [] locationEpochId module LocationEpochId = let parse (value : int) : LocationEpochId = %value + let (|Parse|) = parse let next (value : LocationEpochId) : LocationEpochId = % (%value + 1) let toString (value : LocationEpochId) : string = string %value @@ -19,12 +21,14 @@ type InventoryId = string and [] inventoryId module InventoryId = let parse (value : string) : InventoryId = %value + let (|Parse|) = parse let toString (value : InventoryId) : string = %value type InventoryEpochId = int and [] inventoryEpochId module InventoryEpochId = let parse (value : int) : InventoryEpochId = %value + let (|Parse|) = parse let next (value : InventoryEpochId) : InventoryEpochId = % (%value + 1) let toString (value : InventoryEpochId) : string = string %value @@ -32,4 +36,5 @@ type InventoryTransactionId = string and [] inventoryTransactionId module InventoryTransactionId = let parse (value : string) : InventoryTransactionId = %value + let (|Parse|) = parse let toString (value : InventoryTransactionId) : string = %value \ No newline at end of file diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index f587010fa..d68cb3cfe 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -1,21 +1,21 @@ -namespace Domain.Inventory +namespace Fc.Inventory open Equinox.Core // we use Equinox's AsyncCacheCell helper below open FSharp.UMX -type internal TicketsCache() = - let all = System.Collections.Concurrent.ConcurrentDictionary() // Bounded only by relatively low number of physical pick tickets IRL - static member Create init = let x = TicketsCache() in x.Add init; x - member __.Add tickets = for x in tickets do all.[x] <- () - member __.Contains ticket = all.ContainsKey ticket +type internal IdsCache<'Id>() = + let all = System.Collections.Concurrent.ConcurrentDictionary<'Id,unit>() // Bounded only by relatively low number of physical pick tickets IRL + static member Create init = let x = IdsCache() in x.Add init; x + member __.Add ids = for x in ids do all.[x] <- () + member __.Contains id = all.ContainsKey id /// Maintains active BatchId in a thread-safe manner while ingesting items into the chain of `batches` indexed by the `transmissions` /// Prior to first add, reads `lookBack` batches to seed the cache, in order to minimize the number of duplicated pickTickets we transmit -type Ingester internal (fcId, batches : Batch.Service, transmissions : Transmissions.Service, lookBack, capacity) = +type Ingester internal (fcId, series : Series.Service, epochs : Epoch.Service, lookBack, capacity) = let log = Serilog.Log.ForContext() - // Maintains what we believe to be the currently open BatchId. - // Guaranteed to be set only after `previousTicket.AwaitValue()` + // Maintains what we believe to be the currently open EpochId + // Guaranteed to be set only after `previousIds.AwaitValue()` let mutable activeId = Unchecked.defaultof<_> // We want max one request in flight to establish the pre-existing Batches from which the tickets cache will be seeded @@ -26,13 +26,13 @@ type Ingester internal (fcId, batches : Batch.Service, transmissions : Transmiss return [ for b in (max 0 (%startingId - lookBack)) .. (%startingId - 1) -> AsyncCacheCell(readBatch %b) ] } // Tickets cache - used to maintain a list of tickets that have already been ingested in order to avoid db round-trips - let previousTickets : AsyncCacheCell = AsyncCacheCell <| async { + let previousIds : AsyncCacheCell = AsyncCacheCell <| async { let! batches = previousBatches.AwaitValue() - let! tickets = seq { for x in batches -> x.AwaitValue() } |> Async.Parallel - return TicketsCache.Create(Seq.concat tickets) } + let! ids = seq { for x in batches -> x.AwaitValue() } |> Async.Parallel + return IdsCache.Create(Seq.concat ids) } let tryIngest items = async { - let! previousTickets = previousTickets.AwaitValue() + let! previousTickets = previousIds.AwaitValue() let firstBatchId = %activeId let rec aux batchId totalIngestedTickets items = async { diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index f78bdd25c..2c0877a15 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -1,4 +1,4 @@ -module Domain.Inventory.Epoch +module Fc.Inventory.Epoch open System @@ -6,32 +6,27 @@ open System [] module Events = - let [] categoryId = "InventoryEpoch" - let (|For|) (inventoryId : InventoryId, epochId : InventoryEpochId) = - let streamId = sprintf "%s_%s" (InventoryId.toString inventoryId) (InventoryEpochId.toString epochId) - Equinox.AggregateId(categoryId, streamId) + let [] CategoryId = "InventoryEpoch" + let (|For|) (inventoryId, epochId) = FsCodec.StreamName.compose CategoryId [InventoryId.toString inventoryId; InventoryEpochId.toString epochId] - type Transferred = { transactionId : InventoryTransactionId } - type Adjusted = { transactionId : InventoryTransactionId } + type TransactionInfo = { transactionId : InventoryTransactionId } type Snapshotted = { closed: bool; ids : InventoryTransactionId[] } type Event = - | Adjusted of Adjusted - | Transferred of Transferred + | Adjusted of TransactionInfo + | Transferred of TransactionInfo | Closed | Snapshotted of Snapshotted interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() - // TOCONSIDER - codec could pull transferId from meta module Fold = type State = { closed : bool; ids : Set } let initial = { closed = false; ids = Set.empty } let evolve state = function - | Events.Adjusted e -> { state with ids = Set.add e.transactionId state.ids } - | Events.Transferred e -> { state with ids = Set.add e.transactionId state.ids } + | (Events.Adjusted e | Events.Transferred e) -> { state with ids = Set.add e.transactionId state.ids } | Events.Closed -> { state with closed = true } | Events.Snapshotted e -> { closed = e.closed; ids = Set.ofArray e.ids } let fold : State -> Events.Event seq -> State = Seq.fold evolve diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index a70c8abb0..20a25c7b5 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -1,11 +1,11 @@ -module Domain.Inventory.Series +module Fc.Inventory.Series // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] categoryId = "InventorySeries" - let (|For|) inventoryId = Equinox.AggregateId(categoryId, InventoryId.toString inventoryId) + let [] CategoryId = "InventorySeries" + let (|For|) inventoryId = FsCodec.StreamName.create CategoryId (InventoryId.toString inventoryId) type Epoch = { epoch : InventoryEpochId } type Checkpoint = { epoch : InventoryEpochId; index : int64 } @@ -30,7 +30,7 @@ module Fold = let isOrigin = function Events.Snapshotted _ -> true | _ -> false let snapshot s = Events.Snapshotted { writing = s.writing; checkpoint = s.checkpoint } - // TODO transmute to remove checkpoints (a la propulsion?) + // TODO transmute to remove checkpoints a la Propulsion let interpretMarkWriting epochId (state : Fold.State) = if state.writing >= epochId then [] @@ -48,19 +48,21 @@ type Service internal (log, resolve, maxAttempts) = let stream = resolve inventoryId stream.Transact(interpretMarkWriting epochId) + // TODO checkpoint writing + let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) module Cosmos = open Equinox.Cosmos - let resolve (context,cache) = + let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // For this stream, we uniformly use stale reads as: // a) we don't require any information from competing writers // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale - let accessStrategy = AccessStrategy.Snapshot(Fold.isOrigin,Fold.snapshot) + let accessStrategy = AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) - let createService (context,cache) = - createService (resolve (context,cache)) + let createService (context, cache) = + createService (resolve (context, cache)) diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs new file mode 100644 index 000000000..e12ceb256 --- /dev/null +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -0,0 +1,114 @@ +module Fc.InventoryTransaction + +open System + +// NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +[] +module Events = + + let [] CategoryId = "Transfer" + let (|For|) (inventoryId, transactionId) = + FsCodec.StreamName.compose CategoryId [InventoryId.toString inventoryId; InventoryTransactionId.toString transactionId] + + type TransferRequested = { source : LocationId; destination : LocationId; quantity : int } + type Removed = { balance : int } + type Added = { balance : int } + type AdjustmentRequested = { location : LocationId; quantity : int } + + type Event = + | AdjustmentRequested of AdjustmentRequested + | Adjusted + | TransferRequested of TransferRequested + | Failed + | Removed of Removed + | Added of Added + | Completed + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + +module Fold = + + type Removed = { request : Events.TransferRequested; removed : Events.Removed } + type Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } + type State = + | Initial + | Adjusting of Events.AdjustmentRequested + | Adjusted of Events.AdjustmentRequested + | Transferring of Events.TransferRequested + | Failed + | Adding of Removed + | Added of Added + | Completed + let initial = Initial + let evolve state = function + | Events.AdjustmentRequested e -> Adjusting e + | Events.Adjusted as ee -> + match state with + | Adjusting s -> Adjusted s + | x -> failwithf "Unexpected %A when %A " ee state + | Events.TransferRequested e -> Transferring e + | Events.Failed -> Failed + | Events.Removed e as ee -> + match state with + | Transferring s -> Adding { request = s; removed = e } + | x -> failwithf "Unexpected %A when %A " ee state + | Events.Added e as ee -> + match state with + | Adding s -> Added { request = s.request; removed = s.removed; added = e } + | x -> failwithf "Unexpected %A when %A " ee state + | Events.Completed -> Completed + let fold : State -> Events.Event seq -> State = Seq.fold evolve + +type Result = + { /// Indicates whether this epoch is closed (either previously or as a side-effect this time) + isClosed : bool + /// Count of items added to this epoch. May be less than requested due to removal of duplicates and/or rejected items + added : int + /// residual items that [are not duplicates and] were not accepted into this epoch + rejected : Events.Event list } + +let decideSync capacity requested (state : Fold.State) : Result * Events.Event list = + let isFresh = function + | Events.Adjusted { transactionId = id } + | Events.Transferred { transactionId = id } -> (not << state.ids.Contains) id + | Events.Closed | Events.Snapshotted _ -> false + let news = requested |> Seq.filter isFresh |> List.ofSeq + let closed,allowing,markClosed,residual = + let newCount = List.length news + if state.closed then + true,0,false,news + else + let capacityNow = capacity state + let accepting = min capacityNow newCount + let closing = accepting = capacityNow + let residual = List.skip accepting news + closing,accepting,closing,residual + let events = + [ if allowing <> 0 then yield! news + if markClosed then yield Events.Closed ] + let state' = Fold.fold state events + { isClosed = closed; added = allowing; rejected = residual },events + +type Service internal (log, resolve, maxAttempts) = + + let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) + + /// Attempt ingestion of `events` into the cited Epoch. + /// - No `items` will be accepted if the Epoch is `closed` + /// - The `capacity` function will be passed a non-closed `state` in order to determine number of items that can be admitted prior to closing + /// - If the computed capacity result is >= the number of items being submitted (which may be 0), the Epoch will be marked Closed + /// NOTE the result may include rejected items (which the caller is expected to feed into a successor epoch) + member __.IngestShipped(inventoryId, epochId, capacity, events) : Async = + let stream = resolve (inventoryId, epochId) + stream.Transact(decideSync capacity events) + +let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) + +module Cosmos = + + open Equinox.Cosmos + let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) + let resolve (context,cache) = + let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) + Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve + let createService (context,cache) = createService (resolve (context,cache)) \ No newline at end of file diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index 86dd213dc..562e1da70 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -1,8 +1,8 @@ -namespace Location +namespace Fc.Location [] type Wip<'R> = - | Pending of decide : (Epoch.Fold.Balance -> 'R*Epoch.Events.Event list) + | Pending of decide : (Epoch.Fold.Balance -> 'R * Epoch.Events.Event list) | Complete of 'R /// Manages a Series of Epochs, with a running total being carried forward to the next Epoch when it's Closed diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 3189d8e3e..9c92b2bc5 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -1,21 +1,20 @@ -module Location.Epoch +module Fc.Location.Epoch // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] category = "LocationEpoch" - let (|For|) (locationId, epochId) = - let id = sprintf "%s_%s" (LocationId.toString locationId) (LocationEpochId.toString epochId) - Equinox.AggregateId (category, id) + let [] CategoryId = "LocationEpoch" + let (|For|) (locationId, epochId) = FsCodec.StreamName.compose CategoryId [LocationId.toString locationId; LocationEpochId.toString epochId] type CarriedForward = { initial : int } - type Delta = { value : int } - type Value = { value : int } + type Delta = { delta : int; transaction : InventoryTransactionId } + type Value = { value : int; transaction : InventoryTransactionId } type Event = | CarriedForward of CarriedForward | Closed - | Delta of Delta + | Added of Delta + | Removed of Delta | Reset of Value interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() @@ -29,12 +28,12 @@ module Fold = let evolve state event = match event, state with | Events.CarriedForward e, Initial -> Open { count = 0; value = e.initial } - | Events.Delta e, Open bal -> Open { count = bal.count + 1; value = bal.value + e.value } + | Events.Added e, Open bal -> Open { count = bal.count + 1; value = bal.value + e.delta } + | Events.Removed e, Open bal -> Open { count = bal.count + 1; value = bal.value - e.delta } | Events.Reset e, Open bal -> Open { count = bal.count + 1; value = e.value } | Events.Closed, Open { value = bal } -> Closed bal | Events.CarriedForward _, (Open _|Closed _ as x) -> failwithf "CarriedForward : Unexpected %A" x - | (Events.Delta _|Events.Reset _), (Initial|Closed _ as x) -> failwithf "Delta : Unexpected %A" x - | Events.Closed, (Initial|Closed _ as x) -> failwithf "Closed : Unexpected %A" x + | (Events.Added _|Events.Removed _|Events.Reset _|Events.Closed) as e, (Initial|Closed _ as s) -> failwithf "Unexpected %A when %A" e s let fold = Seq.fold evolve /// Holds events accumulated from a series of decisions while also evolving the presented `state` to reflect the pended events diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index f81aecff7..f69801b6a 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -1,11 +1,11 @@ -module Location.Series +module Fc.Location.Series // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] category = "LocationSeries" - let (|For|) id = Equinox.AggregateId (category, LocationId.toString id) + let [] CategoryId = "LocationSeries" + let (|For|) id = FsCodec.StreamName.create CategoryId (LocationId.toString id) type Started = { epochId : LocationEpochId } type Event = From 98e524c3dfa21ec68dfd192ed932b0e64a77999e Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 13 Feb 2020 13:12:39 +0000 Subject: [PATCH 13/45] Complete Location, Inventory and LocationTests --- equinox-fc/Domain.Tests/Domain.Tests.fsproj | 2 +- equinox-fc/Domain.Tests/Infrastructure.fs | 5 +- equinox-fc/Domain.Tests/LocationEpochTests.fs | 29 +++--- .../Domain.Tests/LocationSeriesTests.fs | 6 +- equinox-fc/Domain.Tests/LocationTests.fs | 13 +-- equinox-fc/Domain/Domain.fsproj | 3 +- equinox-fc/Domain/Infrastructure.fs | 7 +- equinox-fc/Domain/Inventory.fs | 99 ++++++++++--------- equinox-fc/Domain/InventoryEpoch.fs | 28 +++--- equinox-fc/Domain/InventorySeries.fs | 11 ++- equinox-fc/Domain/InventoryTransaction.fs | 4 +- equinox-fc/Domain/Location.fs | 6 +- equinox-fc/Domain/LocationEpoch.fs | 10 +- equinox-fc/Domain/LocationSeries.fs | 17 ++-- 14 files changed, 127 insertions(+), 113 deletions(-) diff --git a/equinox-fc/Domain.Tests/Domain.Tests.fsproj b/equinox-fc/Domain.Tests/Domain.Tests.fsproj index 40feab0a9..078801f4e 100644 --- a/equinox-fc/Domain.Tests/Domain.Tests.fsproj +++ b/equinox-fc/Domain.Tests/Domain.Tests.fsproj @@ -1,7 +1,7 @@ - netcoreapp2.1 + netcoreapp3.1 5 Fc.Domain.Tests false diff --git a/equinox-fc/Domain.Tests/Infrastructure.fs b/equinox-fc/Domain.Tests/Infrastructure.fs index 66dd13d73..3f0d4f26e 100644 --- a/equinox-fc/Domain.Tests/Infrastructure.fs +++ b/equinox-fc/Domain.Tests/Infrastructure.fs @@ -1,5 +1,5 @@ [] -module Infrastructure +module Fc.Infrastructure open Serilog open System @@ -32,7 +32,8 @@ module Cosmos = /// Adapts the XUnit ITestOutputHelper to be a Serilog Sink type TestOutputAdapter(testOutput : Xunit.Abstractions.ITestOutputHelper) = - let formatter = Serilog.Formatting.Display.MessageTemplateTextFormatter("{Timestamp:HH:mm:ss.fff zzz} [{Level:u3}] {Message} {Properties}{NewLine}{Exception}", null); + let template = "{Timestamp:HH:mm:ss.fff zzz} [{Level:u3}] {Message} {Properties}{NewLine}{Exception}" + let formatter = Serilog.Formatting.Display.MessageTemplateTextFormatter(template, null); let writeSerilogEvent logEvent = use writer = new System.IO.StringWriter() formatter.Format(logEvent, writer) diff --git a/equinox-fc/Domain.Tests/LocationEpochTests.fs b/equinox-fc/Domain.Tests/LocationEpochTests.fs index 6901aa746..8683170e1 100644 --- a/equinox-fc/Domain.Tests/LocationEpochTests.fs +++ b/equinox-fc/Domain.Tests/LocationEpochTests.fs @@ -1,28 +1,30 @@ -module LocationEpochTests +module Fc.LocationEpochTests open FsCheck.Xunit open Location.Epoch open Swensen.Unquote -let interpret delta _balance = +let interpret transactionId delta _balance = match delta with | 0 -> (),[] - | delta -> (),[Events.Delta { value = delta }] + | delta when delta < 0 -> (), [Events.Removed { delta = -delta; transaction = transactionId }] + | delta -> (), [Events.Added { delta = delta; transaction = transactionId }] -let validateAndInterpret expectedBalance delta balance = +let validateAndInterpret transactionId expectedBalance delta balance = test <@ expectedBalance = balance @> - interpret delta balance + interpret transactionId delta balance -let verifyDeltaEvent delta events = - let dEvents = events |> List.filter (function Events.Delta _ -> true | _ -> false) - test <@ interpret delta (Unchecked.defaultof<_>) = ((),dEvents) @> +let verifyDeltaEvent transactionId delta events = + let dEvents = events |> List.filter (function Events.Added _ | Events.Removed _ -> true | _ -> false) + test <@ interpret transactionId delta (Unchecked.defaultof<_>) = ((),dEvents) @> -let [] properties carriedForward delta1 closeImmediately delta2 close = +let [] properties transactionId carriedForward delta1 closeImmediately delta2 close = (* Starting with an empty stream, we'll need to supply the balance carried forward, optionally we apply a delta and potentially close *) let initialShouldClose _state = closeImmediately - let res,events = sync (Some carriedForward) (validateAndInterpret carriedForward delta1) initialShouldClose Fold.initial + let res,events = + sync (Some carriedForward) (validateAndInterpret transactionId carriedForward delta1) initialShouldClose Fold.initial let cfEvents events = events |> List.filter (function Events.CarriedForward _ -> true | _ -> false) let closeEvents events = events |> List.filter (function Events.Closed -> true | _ -> false) let state1 = Fold.fold Fold.initial events @@ -33,12 +35,13 @@ let [] properties carriedForward delta1 closeImmediately delta2 close && expectedBalance = res.balance @> test <@ [Events.CarriedForward { initial = carriedForward }] = cfEvents events && (not expectImmediateClose || 1 = Seq.length (closeEvents events)) @> - verifyDeltaEvent delta1 events + verifyDeltaEvent transactionId delta1 events (* After initializing, validate we don't need to supply a carriedForward, and don't produce a CarriedForward event *) let shouldClose _state = close - let { isOpen = isOpen; result = worked; balance = bal },events = sync None (validateAndInterpret expectedBalance delta2) shouldClose state1 + let { isOpen = isOpen; result = worked; balance = bal },events = + sync None (validateAndInterpret transactionId expectedBalance delta2) shouldClose state1 let expectedBalance = if expectImmediateClose then expectedBalance else expectedBalance + delta2 test <@ [] = cfEvents events && (expectImmediateClose || not close || 1 = Seq.length (closeEvents events)) @> @@ -46,7 +49,7 @@ let [] properties carriedForward delta1 closeImmediately delta2 close && expectedBalance = bal @> if not expectImmediateClose then test <@ Option.isSome worked @> - verifyDeltaEvent delta2 events + verifyDeltaEvent transactionId delta2 events let [] ``codec can roundtrip`` event = let ee = Events.codec.Encode(None,event) diff --git a/equinox-fc/Domain.Tests/LocationSeriesTests.fs b/equinox-fc/Domain.Tests/LocationSeriesTests.fs index 4335d8128..d6fbde18b 100644 --- a/equinox-fc/Domain.Tests/LocationSeriesTests.fs +++ b/equinox-fc/Domain.Tests/LocationSeriesTests.fs @@ -1,4 +1,4 @@ -module LocationSeriesTests +module Fc.LocationSeriesTests open FsCheck.Xunit open FSharp.UMX @@ -6,7 +6,7 @@ open Swensen.Unquote open Location.Series let [] properties c1 c2 = - let events = interpretActivateEpoch c1 Fold.initial + let events = interpretAdvanceIngestionEpoch c1 Fold.initial let state1 = Fold.fold Fold.initial events let epoch0 = %0 match c1, events, state1 with @@ -20,7 +20,7 @@ let [] properties c1 c2 = | _, l, _ -> test <@ List.isEmpty l @> - let events = interpretActivateEpoch c2 state1 + let events = interpretAdvanceIngestionEpoch c2 state1 let state2 = Fold.fold state1 events match state1, c2, events, state2 with // Started events are not written for < 0 diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index 169834991..3f54c13a6 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -1,8 +1,8 @@ -module LocationTests +module Fc.LocationTests open FsCheck.Xunit open FSharp.UMX -open Location +open Fc.Location open Swensen.Unquote open System @@ -27,7 +27,7 @@ module Location = let epochs = Epoch.create (Epoch.resolve store) maxAttempts create (zeroBalance, shouldClose) (series, epochs) -let run (service : LocationService) (IdsAtLeastOne locations, deltas : _[]) = Async.RunSynchronously <| async { +let run (service : Location.Service) (IdsAtLeastOne locations, deltas : _[], transactionId) = Async.RunSynchronously <| async { let runId = mkId () // Need to make making state in store unique when replaying or shrinking let locations = locations |> Array.map (fun x -> % (sprintf "%O_%O" x runId)) @@ -38,7 +38,8 @@ let run (service : LocationService) (IdsAtLeastOne locations, deltas : _[]) = As let adjust delta (bal : Epoch.Fold.Balance) = let value = max -bal delta if value = 0 then 0, [] - else value, [Location.Epoch.Events.Delta { value = value }] + elif value < 0 then value, [Epoch.Events.Removed { delta = -value; transaction = transactionId }] + else value, [Epoch.Events.Added { delta = value; transaction = transactionId }] let! appliedDeltas = seq { for loc,x in updates -> async { let! _,eff = service.Execute(loc, adjust x) in return loc,eff } } |> Async.Parallel let expectedBalances = Seq.append (seq { for l in locations -> l, 0}) appliedDeltas |> Seq.groupBy fst |> Seq.map (fun (l,xs) -> l, xs |> Seq.sumBy snd) |> Set.ofSeq @@ -57,7 +58,7 @@ let [] ``MemoryStore properties`` maxEvents args = type Cosmos(testOutput) = - let context,cache = Cosmos.connect () + let context, cache = Cosmos.connect () let log = testOutput |> TestOutputAdapter |> createLogger do Serilog.Log.Logger <- log @@ -66,5 +67,5 @@ type Cosmos(testOutput) = let zeroBalance = 0 let maxEvents = max 1 maxEvents let shouldClose (state : Epoch.Fold.OpenState) = state.count > maxEvents - let service = Location.Cosmos.createService (zeroBalance, shouldClose) (context,cache,Int32.MaxValue) + let service = Location.Cosmos.createService (zeroBalance, shouldClose) (context, cache, 50) run service args \ No newline at end of file diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index 496064bdd..472c3527b 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -3,6 +3,7 @@ netstandard2.0 5 + true Fc.Domain @@ -14,7 +15,7 @@ - + diff --git a/equinox-fc/Domain/Infrastructure.fs b/equinox-fc/Domain/Infrastructure.fs index 0ef31b200..02863a4a3 100644 --- a/equinox-fc/Domain/Infrastructure.fs +++ b/equinox-fc/Domain/Infrastructure.fs @@ -6,14 +6,12 @@ type LocationId = string and [] locationId module LocationId = let parse (value : string) : LocationId = %value - let (|Parse|) = parse let toString (value : LocationId) : string = %value type LocationEpochId = int and [] locationEpochId module LocationEpochId = let parse (value : int) : LocationEpochId = %value - let (|Parse|) = parse let next (value : LocationEpochId) : LocationEpochId = % (%value + 1) let toString (value : LocationEpochId) : string = string %value @@ -21,14 +19,12 @@ type InventoryId = string and [] inventoryId module InventoryId = let parse (value : string) : InventoryId = %value - let (|Parse|) = parse let toString (value : InventoryId) : string = %value type InventoryEpochId = int and [] inventoryEpochId module InventoryEpochId = let parse (value : int) : InventoryEpochId = %value - let (|Parse|) = parse let next (value : InventoryEpochId) : InventoryEpochId = % (%value + 1) let toString (value : InventoryEpochId) : string = string %value @@ -36,5 +32,4 @@ type InventoryTransactionId = string and [] inventoryTransactionId module InventoryTransactionId = let parse (value : string) : InventoryTransactionId = %value - let (|Parse|) = parse - let toString (value : InventoryTransactionId) : string = %value \ No newline at end of file + let toString (value : InventoryTransactionId) : string = %value diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index d68cb3cfe..cf7a9301b 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -1,5 +1,6 @@ namespace Fc.Inventory +open Epoch open Equinox.Core // we use Equinox's AsyncCacheCell helper below open FSharp.UMX @@ -9,75 +10,75 @@ type internal IdsCache<'Id>() = member __.Add ids = for x in ids do all.[x] <- () member __.Contains id = all.ContainsKey id -/// Maintains active BatchId in a thread-safe manner while ingesting items into the chain of `batches` indexed by the `transmissions` -/// Prior to first add, reads `lookBack` batches to seed the cache, in order to minimize the number of duplicated pickTickets we transmit -type Ingester internal (fcId, series : Series.Service, epochs : Epoch.Service, lookBack, capacity) = +/// Maintains active Epoch Id in a thread-safe manner while ingesting items into the `series` of `epochs` +/// Prior to first add, reads `lookBack` epochs to seed the cache, in order to minimize the number of duplicated Ids we ingest +type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Service, lookBack, capacity) = + + let log = Serilog.Log.ForContext() - let log = Serilog.Log.ForContext() // Maintains what we believe to be the currently open EpochId // Guaranteed to be set only after `previousIds.AwaitValue()` - let mutable activeId = Unchecked.defaultof<_> + let mutable activeEpochId = Unchecked.defaultof<_> // We want max one request in flight to establish the pre-existing Batches from which the tickets cache will be seeded - let previousBatches = AsyncCacheCell list> <| async { - let! startingId = transmissions.ReadIngestionBatchId(fcId) - activeId <- %startingId - let readBatch batchId = async { let! r = batches.IngestShipped(fcId,batchId,(fun _ -> 1),Seq.empty) in return r.batchContent } - return [ for b in (max 0 (%startingId - lookBack)) .. (%startingId - 1) -> AsyncCacheCell(readBatch %b) ] } + let previousEpochs = AsyncCacheCell> list> <| async { + let! startingId = series.ReadIngestionEpochId(inventoryId) + activeEpochId <- %startingId + let read epochId = async { let! r = epochs.TryIngest(inventoryId, epochId, (fun _ -> 1),Seq.empty) in return r.transactionIds } + return [ for epoch in (max 0 (%startingId - lookBack)) .. (%startingId - 1) -> AsyncCacheCell(read %epoch) ] } - // Tickets cache - used to maintain a list of tickets that have already been ingested in order to avoid db round-trips - let previousIds : AsyncCacheCell = AsyncCacheCell <| async { - let! batches = previousBatches.AwaitValue() + // TransactionIds cache - used to maintain a list of transactions that have already been ingested in order to avoid db round-trips + let previousIds : AsyncCacheCell> = AsyncCacheCell <| async { + let! batches = previousEpochs.AwaitValue() let! ids = seq { for x in batches -> x.AwaitValue() } |> Async.Parallel return IdsCache.Create(Seq.concat ids) } - let tryIngest items = async { - let! previousTickets = previousIds.AwaitValue() - let firstBatchId = %activeId + let tryIngest events = async { + let! previousIds = previousIds.AwaitValue() + let initialEpochId = %activeEpochId - let rec aux batchId totalIngestedTickets items = async { - let dup,fresh = items |> List.partition previousTickets.Contains + let rec aux epochId totalIngested items = async { + let SeqPartition f = Seq.toArray >> Array.partition f + let dup,fresh = items |> SeqPartition (Epoch.Events.chooseInventoryTransactionId >> Option.exists previousIds.Contains) let fullCount = List.length items - let dropping = fullCount - List.length fresh - if dropping <> 0 then log.Information("Ignoring {count}/{fullCount} duplicate ids: {ids} for {batchId}", dropping, fullCount, dup, batchId) - if List.isEmpty fresh then - return totalIngestedTickets + let dropping = fullCount - Array.length fresh + if dropping <> 0 then log.Information("Ignoring {count}/{fullCount} duplicate ids: {ids} for {epochId}", dropping, fullCount, dup, epochId) + if Array.isEmpty fresh then + return totalIngested else - let! res = batches.IngestShipped(fcId,batchId,capacity,fresh) - log.Information("Added {count} items to {fcId:l}/{batchId}", res.added, fcId, batchId) + let! res = epochs.TryIngest(inventoryId, epochId, capacity, fresh) + log.Information("Added {count} items to {inventoryId:l}/{epochId}", res.added, inventoryId, epochId) // The adding is potentially redundant; we don't care - previousTickets.Add res.batchContent - // Any writer noticing we've moved to a new batch shares the burden of marking it active - if not res.isClosed && activeId < %batchId then - log.Information("Marking {fcId:l}/{batchId} active", fcId, batchId) - do! transmissions.MarkIngestionBatchId(fcId,batchId) - System.Threading.Interlocked.CompareExchange(&activeId,%batchId,activeId) |> ignore - let totalIngestedTickets = totalIngestedTickets + res.added + previousIds.Add res.transactionIds + // Any writer noticing we've moved to a new epoch shares the burden of marking it active + if not res.isClosed && activeEpochId < %epochId then + log.Information("Marking {inventoryId:l}/{epochId} active", inventoryId, epochId) + do! series.AdvanceIngestionEpoch(inventoryId, epochId) + System.Threading.Interlocked.CompareExchange(&activeEpochId, %epochId,activeEpochId) |> ignore + let totalIngestedTickets = totalIngested + res.added match res.rejected with | [] -> return totalIngestedTickets - | rej -> return! aux (BatchId.next batchId) totalIngestedTickets rej } - return! aux firstBatchId 0 items + | rej -> return! aux (InventoryEpochId.next epochId) totalIngestedTickets rej } + return! aux initialEpochId 0 events } /// Upon startup, we initialize the PickTickets cache with recent batches; we want to kick that process off before our first ingest - member __.Initialize() = previousBatches.AwaitValue() |> Async.Ignore + member __.Initialize() = previousIds.AwaitValue() |> Async.Ignore - /// Feeds the items into the sequence of batches. Returns the number of items actually added [excluding duplicates] - member __.Ingest(items : PickTicketId list) : Async = tryIngest items + /// Feeds the events into the sequence of batches. Returns the number of items actually added [excluding duplicates] + member __.Ingest(events : Epoch.Events.Event list) : Async = tryIngest events -module PickTicketsIngester = +module internal Helpers = - let create fcId maxPickTicketsPerBatch lookBackLimit batchesResolve (epochOverride,transmissionsResolve) = - let remainingBatchCapacity (state: Financial.Batch.Fold.State) = - let l = state.ItemCount - max 0 (maxPickTicketsPerBatch-l) - let batches = Financial.Batch.createService batchesResolve - let transmissions = Financial.Transmissions.createService epochOverride transmissionsResolve - Ingester(fcId, batches, transmissions, lookBack=lookBackLimit, capacity=remainingBatchCapacity) + let create inventoryId maxTransactionsPerBatch lookBackLimit (series, epochs) = + let remainingBatchCapacity (state: Epoch.Fold.State) = + let currentLen = state.ids.Count + max 0 (maxTransactionsPerBatch - currentLen) + Service(inventoryId, series, epochs, lookBack = lookBackLimit, capacity = remainingBatchCapacity) - module Cosmos = +module Cosmos = - let create epochOverride fcId maxPickTicketsPerBatch lookBackLimit (context,cache) = - let batchesResolve = Financial.Batch.Cosmos.resolve (context,cache) - let transmissionsResolve = Financial.Transmissions.Cosmos.resolve (context,cache) - create fcId maxPickTicketsPerBatch lookBackLimit batchesResolve (epochOverride,transmissionsResolve) + let create inventoryId maxTransactionsPerBatch lookBackLimit (context, cache) = + let series = Series.Cosmos.createService (context, cache) + let epochs = Epoch.Cosmos.createService (context, cache) + Helpers.create inventoryId maxTransactionsPerBatch lookBackLimit (series, epochs) diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index 2c0877a15..f85691095 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -1,7 +1,5 @@ module Fc.Inventory.Epoch -open System - // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = @@ -21,6 +19,11 @@ module Events = interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() + /// Used for deduplicating input events + let chooseInventoryTransactionId = function + | Adjusted { transactionId = id } | Transferred { transactionId = id } -> Some id + | Closed | Snapshotted _ -> None + module Fold = type State = { closed : bool; ids : Set } @@ -39,14 +42,16 @@ type Result = /// Count of items added to this epoch. May be less than requested due to removal of duplicates and/or rejected items added : int /// residual items that [are not duplicates and] were not accepted into this epoch - rejected : Events.Event list } + rejected : Events.Event list + /// identifiers for all items in this epoch + transactionIds : Set } -let decideSync capacity requested (state : Fold.State) : Result * Events.Event list = +let decideSync capacity events (state : Fold.State) : Result * Events.Event list = let isFresh = function | Events.Adjusted { transactionId = id } | Events.Transferred { transactionId = id } -> (not << state.ids.Contains) id | Events.Closed | Events.Snapshotted _ -> false - let news = requested |> Seq.filter isFresh |> List.ofSeq + let news = events |> Seq.filter isFresh |> List.ofSeq let closed,allowing,markClosed,residual = let newCount = List.length news if state.closed then @@ -61,18 +66,18 @@ let decideSync capacity requested (state : Fold.State) : Result * Events.Event l [ if allowing <> 0 then yield! news if markClosed then yield Events.Closed ] let state' = Fold.fold state events - { isClosed = closed; added = allowing; rejected = residual },events + { isClosed = closed; added = allowing; rejected = residual; transactionIds = state'.ids },events type Service internal (log, resolve, maxAttempts) = let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) /// Attempt ingestion of `events` into the cited Epoch. - /// - No `items` will be accepted if the Epoch is `closed` + /// - None will be accepted if the Epoch is `closed` /// - The `capacity` function will be passed a non-closed `state` in order to determine number of items that can be admitted prior to closing /// - If the computed capacity result is >= the number of items being submitted (which may be 0), the Epoch will be marked Closed /// NOTE the result may include rejected items (which the caller is expected to feed into a successor epoch) - member __.IngestShipped(inventoryId, epochId, capacity, events) : Async = + member __.TryIngest(inventoryId, epochId, capacity, events) : Async = let stream = resolve (inventoryId, epochId) stream.Transact(decideSync capacity events) @@ -81,8 +86,9 @@ let createService resolve = Service(Serilog.Log.ForContext(), resolve, module Cosmos = open Equinox.Cosmos + let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) - let resolve (context,cache) = - let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) + let resolve (context, cache) = + let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let createService (context,cache) = createService (resolve (context,cache)) \ No newline at end of file + let createService (context, cache) = createService (resolve (context, cache)) diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index 20a25c7b5..d97d09177 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -21,7 +21,7 @@ module Fold = type State = { writing : InventoryEpochId; checkpoint : Events.Checkpoint option } - let initial = { writing = 0; checkpoint = None } + let initial = { writing = InventoryEpochId.parse 0; checkpoint = None } let evolve state = function | Events.Started e -> { state with writing = e.epoch } | Events.Checkpointed e -> { state with checkpoint = Some e } @@ -32,7 +32,7 @@ module Fold = let snapshot s = Events.Snapshotted { writing = s.writing; checkpoint = s.checkpoint } // TODO transmute to remove checkpoints a la Propulsion -let interpretMarkWriting epochId (state : Fold.State) = +let interpretAdvanceIngestionEpoch epochId (state : Fold.State) = if state.writing >= epochId then [] else [Events.Started { epoch = epochId }] @@ -44,9 +44,9 @@ type Service internal (log, resolve, maxAttempts) = let stream = resolve inventoryId stream.Query(fun s -> s.writing) - member __.UpdateEpoch(inventoryId, epochId) : Async = + member __.AdvanceIngestionEpoch(inventoryId, epochId) : Async = let stream = resolve inventoryId - stream.Transact(interpretMarkWriting epochId) + stream.Transact(interpretAdvanceIngestionEpoch epochId) // TODO checkpoint writing @@ -56,6 +56,7 @@ let createService resolve = module Cosmos = open Equinox.Cosmos + let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // For this stream, we uniformly use stale reads as: @@ -63,6 +64,6 @@ module Cosmos = // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale let accessStrategy = AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) - fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) + fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) let createService (context, cache) = createService (resolve (context, cache)) diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index e12ceb256..1fd4c03c3 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -108,7 +108,7 @@ module Cosmos = open Equinox.Cosmos let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) - let resolve (context,cache) = + let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let createService (context,cache) = createService (resolve (context,cache)) \ No newline at end of file + let createService (context, cache) = createService (resolve (context,cache)) \ No newline at end of file diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index 562e1da70..8c8ac3b51 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -14,7 +14,7 @@ type Service internal (zeroBalance, shouldClose, series : Series.Service, epochs match! epochs.Sync(locationId, epochId, balanceToCarryForward, decide, shouldClose) with | { balance = bal; result = Some res; isOpen = true } -> if originEpochId <> epochId then - do! series.ActivateEpoch(locationId, epochId) + do! series.AdvanceIngestionEpoch(locationId, epochId) return bal, res | { balance = bal; result = Some res } -> let successorEpochId = LocationEpochId.next epochId @@ -25,7 +25,7 @@ type Service internal (zeroBalance, shouldClose, series : Series.Service, epochs aux member __.Execute(locationId, decide) = async { - let! activeEpoch = series.ReadIngestionEpoch locationId + let! activeEpoch = series.TryReadIngestionEpoch locationId let originEpochId, epochId, balanceCarriedForward = match activeEpoch with | None -> LocationEpochId.parse -1, LocationEpochId.parse 0, Some zeroBalance @@ -43,4 +43,4 @@ module Cosmos = let createService (zeroBalance, shouldClose) (context, cache, maxAttempts) = let series = Series.Cosmos.createService (context, cache, maxAttempts) let epochs = Epoch.Cosmos.createService (context, cache, maxAttempts) - create (zeroBalance, shouldClose) (series, epochs) \ No newline at end of file + create (zeroBalance, shouldClose) (series, epochs) diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 9c92b2bc5..15508e3b7 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -47,7 +47,8 @@ type private Accumulator() = type Result<'t> = { balance : Fold.Balance; result : 't option; isOpen : bool } -let sync (balanceCarriedForward : Fold.Balance option) (decide : (Fold.Balance -> 't*Events.Event list)) shouldClose state : Result<'t>*Events.Event list = +let sync (balanceCarriedForward : Fold.Balance option) (decide : Fold.Balance -> 't*Events.Event list) shouldClose state : Result<'t>*Events.Event list = + let acc = Accumulator() // We require a CarriedForward event at the start of any Epoch's event stream let (), state = @@ -85,8 +86,9 @@ let create resolve maxAttempts = Service(Serilog.Log.ForContext(), reso module Cosmos = open Equinox.Cosmos - let resolve (context,cache) = + + let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.Unoptimized).Resolve - let createService (context,cache,maxAttempts) = - create (resolve (context,cache)) maxAttempts \ No newline at end of file + let createService (context, cache, maxAttempts) = + create (resolve (context, cache)) maxAttempts diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index f69801b6a..3221509ea 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -16,34 +16,37 @@ module Events = module Fold = type State = LocationEpochId option - let initial = None + let initial : State = None let private evolve _state = function | Events.Started e -> Some e.epochId let fold = Seq.fold evolve -let interpretActivateEpoch epochId (state : Fold.State) = +let interpretAdvanceIngestionEpoch (epochId : LocationEpochId) (state : Fold.State) = + if epochId < LocationEpochId.parse 0 then [] else + [if state |> Option.forall (fun s -> s < epochId) then yield Events.Started { epochId = epochId }] type Service internal (log, resolve, maxAttempts) = let resolve (Events.For id) = Equinox.Stream(log, resolve id, maxAttempts) - member __.ReadIngestionEpoch(locationId) : Async = + member __.TryReadIngestionEpoch(locationId) : Async = let stream = resolve locationId stream.Query id - member __.ActivateEpoch(locationId, epochId) : Async = + member __.AdvanceIngestionEpoch(locationId, epochId) : Async = let stream = resolve locationId - stream.Transact(interpretActivateEpoch epochId) + stream.Transact(interpretAdvanceIngestionEpoch epochId) let create resolve maxAttempts = Service(Serilog.Log.ForContext(), resolve, maxAttempts) module Cosmos = open Equinox.Cosmos - let resolve (context,cache) = + + let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) let opt = Equinox.ResolveOption.AllowStale fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id,opt) let createService (context, cache, maxAttempts) = - create (resolve (context,cache)) maxAttempts \ No newline at end of file + create (resolve (context, cache)) maxAttempts From d5844dd9b1684ec92a6edae0e0ae07b1aa969a10 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 13 Feb 2020 13:33:45 +0000 Subject: [PATCH 14/45] Yes, comments --- equinox-fc/Domain.Tests/Domain.Tests.fsproj | 2 +- equinox-fc/Domain.Tests/Infrastructure.fs | 2 +- equinox-fc/Domain.Tests/LocationEpochTests.fs | 2 +- equinox-fc/Domain.Tests/LocationSeriesTests.fs | 2 +- equinox-fc/Domain.Tests/LocationTests.fs | 2 +- equinox-fc/Domain/InventoryEpoch.fs | 3 +++ equinox-fc/Domain/InventorySeries.fs | 4 ++++ equinox-fc/Domain/Location.fs | 2 +- equinox-fc/Domain/LocationEpoch.fs | 3 +++ equinox-fc/Domain/LocationSeries.fs | 1 + 10 files changed, 17 insertions(+), 6 deletions(-) diff --git a/equinox-fc/Domain.Tests/Domain.Tests.fsproj b/equinox-fc/Domain.Tests/Domain.Tests.fsproj index 078801f4e..40feab0a9 100644 --- a/equinox-fc/Domain.Tests/Domain.Tests.fsproj +++ b/equinox-fc/Domain.Tests/Domain.Tests.fsproj @@ -1,7 +1,7 @@ - netcoreapp3.1 + netcoreapp2.1 5 Fc.Domain.Tests false diff --git a/equinox-fc/Domain.Tests/Infrastructure.fs b/equinox-fc/Domain.Tests/Infrastructure.fs index 3f0d4f26e..0711ee67b 100644 --- a/equinox-fc/Domain.Tests/Infrastructure.fs +++ b/equinox-fc/Domain.Tests/Infrastructure.fs @@ -48,4 +48,4 @@ let createLogger sink = // .MinimumLevel.Debug() .Destructure.FSharpTypes() .WriteTo.Sink(sink) - .CreateLogger() \ No newline at end of file + .CreateLogger() diff --git a/equinox-fc/Domain.Tests/LocationEpochTests.fs b/equinox-fc/Domain.Tests/LocationEpochTests.fs index 8683170e1..3f1379484 100644 --- a/equinox-fc/Domain.Tests/LocationEpochTests.fs +++ b/equinox-fc/Domain.Tests/LocationEpochTests.fs @@ -54,4 +54,4 @@ let [] properties transactionId carriedForward delta1 closeImmediately let [] ``codec can roundtrip`` event = let ee = Events.codec.Encode(None,event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) - test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file + test <@ Some event = Events.codec.TryDecode ie @> diff --git a/equinox-fc/Domain.Tests/LocationSeriesTests.fs b/equinox-fc/Domain.Tests/LocationSeriesTests.fs index d6fbde18b..b972071d0 100644 --- a/equinox-fc/Domain.Tests/LocationSeriesTests.fs +++ b/equinox-fc/Domain.Tests/LocationSeriesTests.fs @@ -41,4 +41,4 @@ let [] properties c1 c2 = let [] ``codec can roundtrip`` event = let ee = Events.codec.Encode(None,event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) - test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file + test <@ Some event = Events.codec.TryDecode ie @> diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index 3f54c13a6..ab4a8660a 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -68,4 +68,4 @@ type Cosmos(testOutput) = let maxEvents = max 1 maxEvents let shouldClose (state : Epoch.Fold.OpenState) = state.count > maxEvents let service = Location.Cosmos.createService (zeroBalance, shouldClose) (context, cache, 50) - run service args \ No newline at end of file + run service args diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index f85691095..d8fafbe42 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -1,3 +1,6 @@ +/// Manages the ingestion (and deduplication based on a TransactionId) of events reflecting transfers or stock adjustments +/// that have been effected across a given set of Inventory +/// See Inventory.Service for surface level API which manages the ingestion, including transitioning to a new Epoch when an epoch reaches 'full' state module Fc.Inventory.Epoch // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index d97d09177..60e9d7456 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -1,3 +1,7 @@ +/// Manages a) the ingestion epoch id b) the current checkpointed read position for a long-running Inventory Series +/// See InventoryEpoch for the logic managing the actual events logged within a given epoch +/// See Inventory.Service for the surface API which manages the writing + module Fc.Inventory.Series // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index 8c8ac3b51..7527bde77 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -5,7 +5,7 @@ type Wip<'R> = | Pending of decide : (Epoch.Fold.Balance -> 'R * Epoch.Events.Event list) | Complete of 'R -/// Manages a Series of Epochs, with a running total being carried forward to the next Epoch when it's Closed +/// Manages Reads and Writes for a Series of Epochs, with a running total being carried forward to the next Epoch when it's marked Closed type Service internal (zeroBalance, shouldClose, series : Series.Service, epochs : Epoch.Service) = let rec execute locationId originEpochId = diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 15508e3b7..24e9d3b5d 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -1,3 +1,6 @@ +/// Manages Stock adjustments and deltas for a given Location +/// Provides for controlled opening and closing of an epoch, carrying forward incoming balances when a given Epoch reaches a 'full' state +/// See Location.Service for the logic that allows competing readers/writers to co-operate in bringing this about module Fc.Location.Epoch // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index 3221509ea..db922e71b 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -1,3 +1,4 @@ +/// Manages the active epoch for a given Location module Fc.Location.Series // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care From 6ccceb849725ab387d92f4443aaf15b9a513a959 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 13 Feb 2020 16:48:13 +0000 Subject: [PATCH 15/45] tmp --- equinox-fc/Domain/Domain.fsproj | 2 +- equinox-fc/Domain/InventoryTransaction.fs | 26 +++++++++++++---------- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index 472c3527b..1ac6eac73 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -15,7 +15,7 @@ - + diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 1fd4c03c3..0c2bc1482 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -1,3 +1,12 @@ +/// Process Manager used to: +/// - Coordinate competing attempts to transfer quantities from stock; if balance is 3 one of contesting requests to remove 2 or 3 items must reach `Failed` +/// - maintain rolling balance of stock levels per Location +/// - while recording any transfers or adjustment in an overall Inventory record +/// The Process is driven by two actors: +/// 1) The 'happy path', where a given actor is executing the known steps of the command flow +/// In the normal case, such an actor will bring the flow to a terminal state (Completed or Failed) +/// 2) A watchdog-projector, which reacts to observed events in this Category by stepping in to complete in-flight requests that have stalled +/// This represents the case where a 'happy path' actor died, or experienced another impediment on the path. module Fc.InventoryTransaction open System @@ -6,14 +15,13 @@ open System [] module Events = - let [] CategoryId = "Transfer" - let (|For|) (inventoryId, transactionId) = - FsCodec.StreamName.compose CategoryId [InventoryId.toString inventoryId; InventoryTransactionId.toString transactionId] + let [] CategoryId = "InventoryTransfer" + let (|For|) (inventoryId, transactionId) = FsCodec.StreamName.create CategoryId (InventoryTransactionId.toString transactionId) + type AdjustmentRequested = { location : LocationId; quantity : int } type TransferRequested = { source : LocationId; destination : LocationId; quantity : int } type Removed = { balance : int } type Added = { balance : int } - type AdjustmentRequested = { location : LocationId; quantity : int } type Event = | AdjustmentRequested of AdjustmentRequested @@ -59,13 +67,9 @@ module Fold = | Events.Completed -> Completed let fold : State -> Events.Event seq -> State = Seq.fold evolve -type Result = - { /// Indicates whether this epoch is closed (either previously or as a side-effect this time) - isClosed : bool - /// Count of items added to this epoch. May be less than requested due to removal of duplicates and/or rejected items - added : int - /// residual items that [are not duplicates and] were not accepted into this epoch - rejected : Events.Event list } +type Command = + | Adjust of Events.AdjustmentRequested + | Transfer of Events.TransferRequested let decideSync capacity requested (state : Fold.State) : Result * Events.Event list = let isFresh = function From 479378a23dad076835f4572c790abc34dd9f6112 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 13 Feb 2020 18:45:29 +0000 Subject: [PATCH 16/45] WIP code snipped --- equinox-fc/Domain/InventoryTransaction.fs | 46 ----------------------- 1 file changed, 46 deletions(-) diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 0c2bc1482..25ac55139 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -70,49 +70,3 @@ module Fold = type Command = | Adjust of Events.AdjustmentRequested | Transfer of Events.TransferRequested - -let decideSync capacity requested (state : Fold.State) : Result * Events.Event list = - let isFresh = function - | Events.Adjusted { transactionId = id } - | Events.Transferred { transactionId = id } -> (not << state.ids.Contains) id - | Events.Closed | Events.Snapshotted _ -> false - let news = requested |> Seq.filter isFresh |> List.ofSeq - let closed,allowing,markClosed,residual = - let newCount = List.length news - if state.closed then - true,0,false,news - else - let capacityNow = capacity state - let accepting = min capacityNow newCount - let closing = accepting = capacityNow - let residual = List.skip accepting news - closing,accepting,closing,residual - let events = - [ if allowing <> 0 then yield! news - if markClosed then yield Events.Closed ] - let state' = Fold.fold state events - { isClosed = closed; added = allowing; rejected = residual },events - -type Service internal (log, resolve, maxAttempts) = - - let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) - - /// Attempt ingestion of `events` into the cited Epoch. - /// - No `items` will be accepted if the Epoch is `closed` - /// - The `capacity` function will be passed a non-closed `state` in order to determine number of items that can be admitted prior to closing - /// - If the computed capacity result is >= the number of items being submitted (which may be 0), the Epoch will be marked Closed - /// NOTE the result may include rejected items (which the caller is expected to feed into a successor epoch) - member __.IngestShipped(inventoryId, epochId, capacity, events) : Async = - let stream = resolve (inventoryId, epochId) - stream.Transact(decideSync capacity events) - -let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) - -module Cosmos = - - open Equinox.Cosmos - let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) - let resolve (context, cache) = - let cacheStrategy = CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) - Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let createService (context, cache) = createService (resolve (context,cache)) \ No newline at end of file From 03bab4ffdc0bb29b1e80254d5be88f0ce90987d7 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 13 Feb 2020 19:32:20 +0000 Subject: [PATCH 17/45] Add missing README.md --- dotnet-templates.sln | 1 + equinox-fc/Domain/InventoryTransaction.fs | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/dotnet-templates.sln b/dotnet-templates.sln index 4de1cdd8b..43f6f4b32 100644 --- a/dotnet-templates.sln +++ b/dotnet-templates.sln @@ -83,6 +83,7 @@ EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "fc", "fc", "{4946576F-1558-49ED-A272-6F4D92FB0031}" ProjectSection(SolutionItems) = preProject equinox-fc\.template.config\template.json = equinox-fc\.template.config\template.json + equinox-fc\README.md = equinox-fc\README.md EndProjectSection EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "equinox-fc\Domain\Domain.fsproj", "{B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}" diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 25ac55139..6ace7369b 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -36,17 +36,17 @@ module Events = module Fold = - type Removed = { request : Events.TransferRequested; removed : Events.Removed } - type Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } type State = | Initial | Adjusting of Events.AdjustmentRequested | Adjusted of Events.AdjustmentRequested | Transferring of Events.TransferRequested - | Failed + | Rejected | Adding of Removed | Added of Added | Completed + and Removed = { request : Events.TransferRequested; removed : Events.Removed } + and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } let initial = Initial let evolve state = function | Events.AdjustmentRequested e -> Adjusting e @@ -55,7 +55,7 @@ module Fold = | Adjusting s -> Adjusted s | x -> failwithf "Unexpected %A when %A " ee state | Events.TransferRequested e -> Transferring e - | Events.Failed -> Failed + | Events.Failed -> Rejected | Events.Removed e as ee -> match state with | Transferring s -> Adding { request = s; removed = e } From bf6813b60b64db2c8183085f416a86ebfde30167 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 14 Feb 2020 03:25:16 +0000 Subject: [PATCH 18/45] Tidy accessStrategy --- equinox-fc/Domain/InventorySeries.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index 60e9d7456..33b7e2049 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -61,13 +61,13 @@ module Cosmos = open Equinox.Cosmos + let accessStrategy = AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // For this stream, we uniformly use stale reads as: // a) we don't require any information from competing writers // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale - let accessStrategy = AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) let createService (context, cache) = createService (resolve (context, cache)) From 6b8d0cf8353a4949cf52282f282bb049508744af Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 14 Feb 2020 15:06:38 +0000 Subject: [PATCH 19/45] Formatting --- equinox-fc/Domain.Tests/Infrastructure.fs | 2 +- equinox-fc/Domain.Tests/LocationEpochTests.fs | 2 +- equinox-fc/Domain.Tests/LocationSeriesTests.fs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/equinox-fc/Domain.Tests/Infrastructure.fs b/equinox-fc/Domain.Tests/Infrastructure.fs index 0711ee67b..1c6c0b920 100644 --- a/equinox-fc/Domain.Tests/Infrastructure.fs +++ b/equinox-fc/Domain.Tests/Infrastructure.fs @@ -26,7 +26,7 @@ module Cosmos = let context = Context(connection, d, c) let cache = Equinox.Cache (appName, 10) context, cache - | s,d,c -> + | s, d, c -> failwithf "Connection, Database and Container EQUINOX_COSMOS_* Environment variables are required (%b,%b,%b)" (Option.isSome s) (Option.isSome d) (Option.isSome c) diff --git a/equinox-fc/Domain.Tests/LocationEpochTests.fs b/equinox-fc/Domain.Tests/LocationEpochTests.fs index 3f1379484..49c09a264 100644 --- a/equinox-fc/Domain.Tests/LocationEpochTests.fs +++ b/equinox-fc/Domain.Tests/LocationEpochTests.fs @@ -52,6 +52,6 @@ let [] properties transactionId carriedForward delta1 closeImmediately verifyDeltaEvent transactionId delta2 events let [] ``codec can roundtrip`` event = - let ee = Events.codec.Encode(None,event) + let ee = Events.codec.Encode(None, event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) test <@ Some event = Events.codec.TryDecode ie @> diff --git a/equinox-fc/Domain.Tests/LocationSeriesTests.fs b/equinox-fc/Domain.Tests/LocationSeriesTests.fs index b972071d0..6c7b33ae7 100644 --- a/equinox-fc/Domain.Tests/LocationSeriesTests.fs +++ b/equinox-fc/Domain.Tests/LocationSeriesTests.fs @@ -39,6 +39,6 @@ let [] properties c1 c2 = test <@ List.isEmpty l @> let [] ``codec can roundtrip`` event = - let ee = Events.codec.Encode(None,event) + let ee = Events.codec.Encode(None, event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) test <@ Some event = Events.codec.TryDecode ie @> From fc139b5bff47626a1ade61a118b00d2e4c8ac694 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 14 Feb 2020 15:20:15 +0000 Subject: [PATCH 20/45] InventoryTransaction wip --- equinox-fc/Domain/InventoryTransaction.fs | 121 +++++++++++++++++----- 1 file changed, 94 insertions(+), 27 deletions(-) diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 6ace7369b..1799abd38 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -9,13 +9,11 @@ /// This represents the case where a 'happy path' actor died, or experienced another impediment on the path. module Fc.InventoryTransaction -open System - // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] CategoryId = "InventoryTransfer" + let [] CategoryId = "InventoryTransaction" let (|For|) (inventoryId, transactionId) = FsCodec.StreamName.create CategoryId (InventoryTransactionId.toString transactionId) type AdjustmentRequested = { location : LocationId; quantity : int } @@ -24,13 +22,18 @@ module Events = type Added = { balance : int } type Event = + (* Stock Adjustment Flow *) | AdjustmentRequested of AdjustmentRequested | Adjusted + + (* Stock Transfer Flow *) | TransferRequested of TransferRequested - | Failed + | Failed // terminal | Removed of Removed | Added of Added - | Completed + + (* Successful completion *) + | Completed // terminal interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() @@ -38,35 +41,99 @@ module Fold = type State = | Initial - | Adjusting of Events.AdjustmentRequested - | Adjusted of Events.AdjustmentRequested - | Transferring of Events.TransferRequested - | Rejected + | Running of RunningState + | Completed of TerminalState + and RunningState = + | Adjust of Events.AdjustmentRequested + | Transfer of TransferState + and TransferState = + | Requested of Events.TransferRequested + | Failed of Events.TransferRequested | Adding of Removed | Added of Added - | Completed + and TerminalState = + | Adjusted of Events.AdjustmentRequested + | Transferred of Added + | TransferFailed of Events.TransferRequested + and AdjustState = Events.AdjustmentRequested and Removed = { request : Events.TransferRequested; removed : Events.Removed } and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } let initial = Initial - let evolve state = function - | Events.AdjustmentRequested e -> Adjusting e - | Events.Adjusted as ee -> - match state with - | Adjusting s -> Adjusted s - | x -> failwithf "Unexpected %A when %A " ee state - | Events.TransferRequested e -> Transferring e - | Events.Failed -> Rejected - | Events.Removed e as ee -> - match state with - | Transferring s -> Adding { request = s; removed = e } - | x -> failwithf "Unexpected %A when %A " ee state - | Events.Added e as ee -> - match state with - | Adding s -> Added { request = s.request; removed = s.removed; added = e } - | x -> failwithf "Unexpected %A when %A " ee state - | Events.Completed -> Completed + let evolve state event = + match state, event with + (* Adjustment Process *) + | Initial, Events.AdjustmentRequested e -> + Running (Adjust e) + | Running (Adjust s), Events.Adjusted -> + Completed (Adjusted s) + + (* Transfer Process *) + | Initial, Events.TransferRequested e -> + Running (Transfer (Requested e)) + + | Running (Transfer (Requested s)), Events.Failed -> + Completed (TransferFailed s) + + | Running (Transfer (Requested s)), Events.Removed e as ee -> + Running (Transfer (Adding { request = s; removed = e })) + | Running (Transfer (Adding s)), Events.Added e as ee -> + Running (Transfer (Added { request = s.request; removed = s.removed; added = e })) + | Running (Transfer (Added s)), Events.Completed as ee -> + Completed (Transferred s) + + (* Any disallowed state changes represent gaps in the model, so we fail fast *) + | state, event -> failwithf "Unexpected %A when %A" event state + let fold : State -> Events.Event seq -> State = Seq.fold evolve type Command = | Adjust of Events.AdjustmentRequested | Transfer of Events.TransferRequested + +type Result = { complete : bool; } + +/// Holds events accumulated from a series of decisions while also evolving the presented `state` to reflect the pended events +type private Accumulator() = + let acc = ResizeArray() + member __.Ingest(state) : 'res * Events.Event list -> 'res * Fold.State = function + | res, [] -> res, state + | res, [e] -> acc.Add e; res, Fold.evolve state e + | res, xs -> acc.AddRange xs; res, Fold.fold state (Seq.ofList xs) + member __.Accumulated = List.ofSeq acc + +type Update = + | AdjustmentCompleted + +let decide command updates (state : Fold.State) : Result * Events.Event list = + + let acc = Accumulator() + let started, state = + acc.Ingest state <| + match state, command with + | Fold.Initial, Adjust e -> true, [ Events.AdjustmentRequested e ] + | Fold.Initial, Transfer e -> true, [ Events.TransferRequested e ] + | _ -> false, [] + { complete = false }, acc.Accumulated + +type Service internal (log, resolve, maxAttempts) = + + let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) + + member __.IngestShipped(inventoryId, transactionId, command, updates) : Async = + let stream = resolve (inventoryId, transactionId) + stream.Transact(decide command updates) + +let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) + +module Cosmos = + + open Equinox.Cosmos + + // in the happy path case, the event stream will typically be short, and the state cached, so snapshotting is less critical + let accessStrategy = Equinox.Cosmos.AccessStrategy.Unoptimized + // ... and there will generally be a single actor touching it at a given time, so we don't need to do a load (which would be more expensive than normal given the `accessStrategy`) before we sync + let opt = Equinox.AllowStale + let resolve (context, cache) = + let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) + let createService (context, cache) = createService (resolve (context, cache)) \ No newline at end of file From 49f726c72cdb95089f93fe3234e9580f5651883b Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 14 Feb 2020 23:59:58 +0000 Subject: [PATCH 21/45] Handle FsCodec _ restriction --- equinox-fc/Domain.Tests/LocationTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index ab4a8660a..bf21327a2 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -29,7 +29,7 @@ module Location = let run (service : Location.Service) (IdsAtLeastOne locations, deltas : _[], transactionId) = Async.RunSynchronously <| async { let runId = mkId () // Need to make making state in store unique when replaying or shrinking - let locations = locations |> Array.map (fun x -> % (sprintf "%O_%O" x runId)) + let locations = locations |> Array.map (fun x -> % (sprintf "%O/%O" x runId)) let updates = deltas |> Seq.mapi (fun i x -> locations.[i % locations.Length], x) |> Seq.cache From b251291a3481d056b107714bb469c1b3b907bcf2 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sat, 15 Feb 2020 00:00:35 +0000 Subject: [PATCH 22/45] Remove inventoryId from Trans SN --- equinox-fc/Domain.Tests/LocationTests.fs | 2 +- equinox-fc/Domain/InventoryTransaction.fs | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index bf21327a2..03a3972bb 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -1,8 +1,8 @@ module Fc.LocationTests +open Fc.Location open FsCheck.Xunit open FSharp.UMX -open Fc.Location open Swensen.Unquote open System diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 1799abd38..9a6000f77 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -14,7 +14,7 @@ module Fc.InventoryTransaction module Events = let [] CategoryId = "InventoryTransaction" - let (|For|) (inventoryId, transactionId) = FsCodec.StreamName.create CategoryId (InventoryTransactionId.toString transactionId) + let (|For|) transactionId = FsCodec.StreamName.create CategoryId (InventoryTransactionId.toString transactionId) type AdjustmentRequested = { location : LocationId; quantity : int } type TransferRequested = { source : LocationId; destination : LocationId; quantity : int } @@ -83,7 +83,6 @@ module Fold = (* Any disallowed state changes represent gaps in the model, so we fail fast *) | state, event -> failwithf "Unexpected %A when %A" event state - let fold : State -> Events.Event seq -> State = Seq.fold evolve type Command = @@ -112,7 +111,11 @@ let decide command updates (state : Fold.State) : Result * Events.Event list = match state, command with | Fold.Initial, Adjust e -> true, [ Events.AdjustmentRequested e ] | Fold.Initial, Transfer e -> true, [ Events.TransferRequested e ] + + // TOCONSIDER validate conflicts + | _ -> false, [] + { complete = false }, acc.Accumulated type Service internal (log, resolve, maxAttempts) = @@ -120,7 +123,7 @@ type Service internal (log, resolve, maxAttempts) = let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) member __.IngestShipped(inventoryId, transactionId, command, updates) : Async = - let stream = resolve (inventoryId, transactionId) + let stream = resolve transactionId stream.Transact(decide command updates) let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) From 4a56430fcb7e9f9d51438a99310f0fd7c924735c Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Mon, 17 Feb 2020 14:52:53 +0000 Subject: [PATCH 23/45] Remove checkpoints from InventorySeries --- equinox-fc/Domain.Tests/Domain.Tests.fsproj | 2 +- .../Domain.Tests/LocationSeriesTests.fs | 6 ++-- equinox-fc/Domain/Domain.fsproj | 3 +- equinox-fc/Domain/Inventory.fs | 2 +- equinox-fc/Domain/InventorySeries.fs | 35 ++++++------------- equinox-fc/Domain/LocationSeries.fs | 8 ++--- equinox-fc/README.md | 2 +- 7 files changed, 22 insertions(+), 36 deletions(-) diff --git a/equinox-fc/Domain.Tests/Domain.Tests.fsproj b/equinox-fc/Domain.Tests/Domain.Tests.fsproj index 40feab0a9..236935241 100644 --- a/equinox-fc/Domain.Tests/Domain.Tests.fsproj +++ b/equinox-fc/Domain.Tests/Domain.Tests.fsproj @@ -3,8 +3,8 @@ netcoreapp2.1 5 - Fc.Domain.Tests false + true diff --git a/equinox-fc/Domain.Tests/LocationSeriesTests.fs b/equinox-fc/Domain.Tests/LocationSeriesTests.fs index 6c7b33ae7..65f682545 100644 --- a/equinox-fc/Domain.Tests/LocationSeriesTests.fs +++ b/equinox-fc/Domain.Tests/LocationSeriesTests.fs @@ -14,7 +14,7 @@ let [] properties c1 c2 = | n, [], activeEpoch when n < epoch0 -> test <@ None = activeEpoch @> // Any >=0 value should trigger a Started event, initially - | n, [Events.Started { epochId = ee }], Some activatedEpoch -> + | n, [Events.Started { epoch = ee }], Some activatedEpoch -> test <@ n >= epoch0 && n = ee && n = activatedEpoch @> // Nothing else should yield events | _, l, _ -> @@ -27,11 +27,11 @@ let [] properties c1 c2 = | None, n, [], activeEpoch when n < epoch0 -> test <@ None = activeEpoch @> // Any >= 0 epochId should trigger a Started event if first command didnt do anything - | None, n, [Events.Started { epochId = ee }], Some activatedEpoch -> + | None, n, [Events.Started { epoch = ee }], Some activatedEpoch -> let eEpoch = %ee test <@ n >= epoch0 && n = eEpoch && n = activatedEpoch @> // Any higher epochId should trigger a Started event (gaps are fine - we are only tying to reduce walks) - | Some s1, n, [Events.Started { epochId = ee }], Some activatedEpoch -> + | Some s1, n, [Events.Started { epoch = ee }], Some activatedEpoch -> let eEpoch = %ee test <@ n > s1 && n = eEpoch && n > epoch0 && n = activatedEpoch @> // Nothing else should yield events diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index 1ac6eac73..32f7f3857 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -1,10 +1,9 @@  - netstandard2.0 + netstandard2.0 5 true - Fc.Domain diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index cf7a9301b..61d537212 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -22,7 +22,7 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv // We want max one request in flight to establish the pre-existing Batches from which the tickets cache will be seeded let previousEpochs = AsyncCacheCell> list> <| async { - let! startingId = series.ReadIngestionEpochId(inventoryId) + let! startingId = series.ReadIngestionEpoch(inventoryId) activeEpochId <- %startingId let read epochId = async { let! r = epochs.TryIngest(inventoryId, epochId, (fun _ -> 1),Seq.empty) in return r.transactionIds } return [ for epoch in (max 0 (%startingId - lookBack)) .. (%startingId - 1) -> AsyncCacheCell(read %epoch) ] } diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index 33b7e2049..a0197d5d3 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -1,7 +1,6 @@ /// Manages a) the ingestion epoch id b) the current checkpointed read position for a long-running Inventory Series /// See InventoryEpoch for the logic managing the actual events logged within a given epoch /// See Inventory.Service for the surface API which manages the writing - module Fc.Inventory.Series // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care @@ -11,49 +10,38 @@ module Events = let [] CategoryId = "InventorySeries" let (|For|) inventoryId = FsCodec.StreamName.create CategoryId (InventoryId.toString inventoryId) - type Epoch = { epoch : InventoryEpochId } - type Checkpoint = { epoch : InventoryEpochId; index : int64 } - type Snapshotted = { writing : InventoryEpochId; checkpoint : Checkpoint option } + type Started = { epoch : InventoryEpochId } type Event = - | Started of Epoch - | Checkpointed of Checkpoint - | Snapshotted of Snapshotted + | Started of Started interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() module Fold = - type State = { writing : InventoryEpochId; checkpoint : Events.Checkpoint option } - - let initial = { writing = InventoryEpochId.parse 0; checkpoint = None } - let evolve state = function - | Events.Started e -> { state with writing = e.epoch } - | Events.Checkpointed e -> { state with checkpoint = Some e } - | Events.Snapshotted e -> { writing = e.writing; checkpoint = e.checkpoint } + type State = InventoryEpochId option + let initial = None + let evolve _state = function + | Events.Started e -> Some e.epoch let fold : State -> Events.Event seq -> State = Seq.fold evolve - let isOrigin = function Events.Snapshotted _ -> true | _ -> false - let snapshot s = Events.Snapshotted { writing = s.writing; checkpoint = s.checkpoint } - // TODO transmute to remove checkpoints a la Propulsion +let queryActiveEpoch state = state |> Option.defaultValue (InventoryEpochId.parse 0) let interpretAdvanceIngestionEpoch epochId (state : Fold.State) = - if state.writing >= epochId then [] + if queryActiveEpoch state >= epochId then [] else [Events.Started { epoch = epochId }] type Service internal (log, resolve, maxAttempts) = let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) - member __.ReadIngestionEpochId inventoryId : Async = + member __.ReadIngestionEpoch(inventoryId) : Async = let stream = resolve inventoryId - stream.Query(fun s -> s.writing) + stream.Query queryActiveEpoch member __.AdvanceIngestionEpoch(inventoryId, epochId) : Async = let stream = resolve inventoryId stream.Transact(interpretAdvanceIngestionEpoch epochId) - // TODO checkpoint writing - let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) @@ -61,13 +49,12 @@ module Cosmos = open Equinox.Cosmos - let accessStrategy = AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // For this stream, we uniformly use stale reads as: // a) we don't require any information from competing writers // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale - fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) + fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id, opt) let createService (context, cache) = createService (resolve (context, cache)) diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index db922e71b..517f9dec7 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -6,9 +6,9 @@ module Fc.Location.Series module Events = let [] CategoryId = "LocationSeries" - let (|For|) id = FsCodec.StreamName.create CategoryId (LocationId.toString id) + let (|For|) locationId = FsCodec.StreamName.create CategoryId (LocationId.toString locationId) - type Started = { epochId : LocationEpochId } + type Started = { epoch : LocationEpochId } type Event = | Started of Started interface TypeShape.UnionContract.IUnionContract @@ -19,13 +19,13 @@ module Fold = type State = LocationEpochId option let initial : State = None let private evolve _state = function - | Events.Started e -> Some e.epochId + | Events.Started e -> Some e.epoch let fold = Seq.fold evolve let interpretAdvanceIngestionEpoch (epochId : LocationEpochId) (state : Fold.State) = if epochId < LocationEpochId.parse 0 then [] else - [if state |> Option.forall (fun s -> s < epochId) then yield Events.Started { epochId = epochId }] + [if state |> Option.forall (fun s -> s < epochId) then yield Events.Started { epoch = epochId }] type Service internal (log, resolve, maxAttempts) = diff --git a/equinox-fc/README.md b/equinox-fc/README.md index 39e27fd7c..350598cff 100644 --- a/equinox-fc/README.md +++ b/equinox-fc/README.md @@ -19,7 +19,7 @@ The `Location`* `module`s illustrates a way to approach the modelling of a long- - Referencing an `Equinox.*` Store module from the `Domain` project is not mandatory; it's common to defer all wiring and configuration of the elements in `module Cosmos`, `module EventStore` etc. and instead maintain that alongside the Composition Root, outside of the `Domain` project -- While using an `AccessStrategy` such as `Snapshotting` may in some cases be relevant too, in the general case, using the `Equinox.Cache`, combined with having a compact Fold `State` and a sufficiently constrained maximum number/size of events means the state can be established within a predictable latency range. +- While using an `AccessStrategy` such as `Snapshot` may in some cases be relevant too, in the general case, using the `Equinox.Cache`, combined with having a compact Fold `State` and a sufficiently constrained maximum number/size of events means the state can be established within a predictable latency range. - Representing a long-running state in this fashion is no panacea; in modeling a system, the ideal is to have streams that have a naturally constrained number of events over their lifetime. From 4e53aa1816e30bd0a5703e62453af539270c4686 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Mon, 17 Feb 2020 15:38:53 +0000 Subject: [PATCH 24/45] Tidying / formatting --- equinox-fc/Domain.Tests/LocationEpochTests.fs | 8 ++++---- equinox-fc/Domain.Tests/LocationTests.fs | 6 +++--- equinox-fc/Domain/Inventory.fs | 8 ++++---- equinox-fc/Domain/InventoryEpoch.fs | 10 +++++----- equinox-fc/Domain/InventorySeries.fs | 2 +- equinox-fc/Domain/InventoryTransaction.fs | 11 +++++------ equinox-fc/Domain/Location.fs | 2 +- equinox-fc/Domain/LocationEpoch.fs | 2 +- equinox-fc/Domain/LocationSeries.fs | 2 +- 9 files changed, 25 insertions(+), 26 deletions(-) diff --git a/equinox-fc/Domain.Tests/LocationEpochTests.fs b/equinox-fc/Domain.Tests/LocationEpochTests.fs index 49c09a264..b0c244314 100644 --- a/equinox-fc/Domain.Tests/LocationEpochTests.fs +++ b/equinox-fc/Domain.Tests/LocationEpochTests.fs @@ -6,7 +6,7 @@ open Swensen.Unquote let interpret transactionId delta _balance = match delta with - | 0 -> (),[] + | 0 -> (), [] | delta when delta < 0 -> (), [Events.Removed { delta = -delta; transaction = transactionId }] | delta -> (), [Events.Added { delta = delta; transaction = transactionId }] @@ -16,14 +16,14 @@ let validateAndInterpret transactionId expectedBalance delta balance = let verifyDeltaEvent transactionId delta events = let dEvents = events |> List.filter (function Events.Added _ | Events.Removed _ -> true | _ -> false) - test <@ interpret transactionId delta (Unchecked.defaultof<_>) = ((),dEvents) @> + test <@ interpret transactionId delta (Unchecked.defaultof<_>) = ((), dEvents) @> let [] properties transactionId carriedForward delta1 closeImmediately delta2 close = (* Starting with an empty stream, we'll need to supply the balance carried forward, optionally we apply a delta and potentially close *) let initialShouldClose _state = closeImmediately - let res,events = + let res, events = sync (Some carriedForward) (validateAndInterpret transactionId carriedForward delta1) initialShouldClose Fold.initial let cfEvents events = events |> List.filter (function Events.CarriedForward _ -> true | _ -> false) let closeEvents events = events |> List.filter (function Events.Closed -> true | _ -> false) @@ -40,7 +40,7 @@ let [] properties transactionId carriedForward delta1 closeImmediately (* After initializing, validate we don't need to supply a carriedForward, and don't produce a CarriedForward event *) let shouldClose _state = close - let { isOpen = isOpen; result = worked; balance = bal },events = + let { isOpen = isOpen; result = worked; balance = bal }, events = sync None (validateAndInterpret transactionId expectedBalance delta2) shouldClose state1 let expectedBalance = if expectImmediateClose then expectedBalance else expectedBalance + delta2 test <@ [] = cfEvents events diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index 03a3972bb..52e6b75f7 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -40,12 +40,12 @@ let run (service : Location.Service) (IdsAtLeastOne locations, deltas : _[], tra if value = 0 then 0, [] elif value < 0 then value, [Epoch.Events.Removed { delta = -value; transaction = transactionId }] else value, [Epoch.Events.Added { delta = value; transaction = transactionId }] - let! appliedDeltas = seq { for loc,x in updates -> async { let! _,eff = service.Execute(loc, adjust x) in return loc,eff } } |> Async.Parallel - let expectedBalances = Seq.append (seq { for l in locations -> l, 0}) appliedDeltas |> Seq.groupBy fst |> Seq.map (fun (l,xs) -> l, xs |> Seq.sumBy snd) |> Set.ofSeq + let! appliedDeltas = seq { for loc, x in updates -> async { let! _, eff = service.Execute(loc, adjust x) in return loc,eff } } |> Async.Parallel + let expectedBalances = Seq.append (seq { for l in locations -> l, 0}) appliedDeltas |> Seq.groupBy fst |> Seq.map (fun (l, xs) -> l, xs |> Seq.sumBy snd) |> Set.ofSeq (* Verify loading yields identical state *) - let! balances = seq { for loc in locations -> async { let! bal,() = service.Execute(loc,(fun _ -> (),[])) in return loc,bal } } |> Async.Parallel + let! balances = seq { for loc in locations -> async { let! bal, () = service.Execute(loc,(fun _ -> (), [])) in return loc,bal } } |> Async.Parallel test <@ expectedBalances = Set.ofSeq balances @> } let [] ``MemoryStore properties`` maxEvents args = diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index 61d537212..80b916343 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -5,7 +5,7 @@ open Equinox.Core // we use Equinox's AsyncCacheCell helper below open FSharp.UMX type internal IdsCache<'Id>() = - let all = System.Collections.Concurrent.ConcurrentDictionary<'Id,unit>() // Bounded only by relatively low number of physical pick tickets IRL + let all = System.Collections.Concurrent.ConcurrentDictionary<'Id, unit>() // Bounded only by relatively low number of physical pick tickets IRL static member Create init = let x = IdsCache() in x.Add init; x member __.Add ids = for x in ids do all.[x] <- () member __.Contains id = all.ContainsKey id @@ -24,7 +24,7 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv let previousEpochs = AsyncCacheCell> list> <| async { let! startingId = series.ReadIngestionEpoch(inventoryId) activeEpochId <- %startingId - let read epochId = async { let! r = epochs.TryIngest(inventoryId, epochId, (fun _ -> 1),Seq.empty) in return r.transactionIds } + let read epochId = async { let! r = epochs.TryIngest(inventoryId, epochId, (fun _ -> 1), Seq.empty) in return r.transactionIds } return [ for epoch in (max 0 (%startingId - lookBack)) .. (%startingId - 1) -> AsyncCacheCell(read %epoch) ] } // TransactionIds cache - used to maintain a list of transactions that have already been ingested in order to avoid db round-trips @@ -39,7 +39,7 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv let rec aux epochId totalIngested items = async { let SeqPartition f = Seq.toArray >> Array.partition f - let dup,fresh = items |> SeqPartition (Epoch.Events.chooseInventoryTransactionId >> Option.exists previousIds.Contains) + let dup, fresh = items |> SeqPartition (Epoch.Events.chooseInventoryTransactionId >> Option.exists previousIds.Contains) let fullCount = List.length items let dropping = fullCount - Array.length fresh if dropping <> 0 then log.Information("Ignoring {count}/{fullCount} duplicate ids: {ids} for {epochId}", dropping, fullCount, dup, epochId) @@ -54,7 +54,7 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv if not res.isClosed && activeEpochId < %epochId then log.Information("Marking {inventoryId:l}/{epochId} active", inventoryId, epochId) do! series.AdvanceIngestionEpoch(inventoryId, epochId) - System.Threading.Interlocked.CompareExchange(&activeEpochId, %epochId,activeEpochId) |> ignore + System.Threading.Interlocked.CompareExchange(&activeEpochId, %epochId, activeEpochId) |> ignore let totalIngestedTickets = totalIngested + res.added match res.rejected with | [] -> return totalIngestedTickets diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index d8fafbe42..c596d5cbb 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -55,25 +55,25 @@ let decideSync capacity events (state : Fold.State) : Result * Events.Event list | Events.Transferred { transactionId = id } -> (not << state.ids.Contains) id | Events.Closed | Events.Snapshotted _ -> false let news = events |> Seq.filter isFresh |> List.ofSeq - let closed,allowing,markClosed,residual = + let closed, allowing, markClosed, residual = let newCount = List.length news if state.closed then - true,0,false,news + true, 0, false, news else let capacityNow = capacity state let accepting = min capacityNow newCount let closing = accepting = capacityNow let residual = List.skip accepting news - closing,accepting,closing,residual + closing, accepting, closing, residual let events = [ if allowing <> 0 then yield! news if markClosed then yield Events.Closed ] let state' = Fold.fold state events - { isClosed = closed; added = allowing; rejected = residual; transactionIds = state'.ids },events + { isClosed = closed; added = allowing; rejected = residual; transactionIds = state'.ids }, events type Service internal (log, resolve, maxAttempts) = - let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) + let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) /// Attempt ingestion of `events` into the cited Epoch. /// - None will be accepted if the Epoch is `closed` diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index a0197d5d3..2e0ce93fe 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -32,7 +32,7 @@ let interpretAdvanceIngestionEpoch epochId (state : Fold.State) = type Service internal (log, resolve, maxAttempts) = - let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) + let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) member __.ReadIngestionEpoch(inventoryId) : Async = let stream = resolve inventoryId diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 9a6000f77..7d5c4d988 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -2,7 +2,7 @@ /// - Coordinate competing attempts to transfer quantities from stock; if balance is 3 one of contesting requests to remove 2 or 3 items must reach `Failed` /// - maintain rolling balance of stock levels per Location /// - while recording any transfers or adjustment in an overall Inventory record -/// The Process is driven by two actors: +/// The Process is driven by two collaborating actors: /// 1) The 'happy path', where a given actor is executing the known steps of the command flow /// In the normal case, such an actor will bring the flow to a terminal state (Completed or Failed) /// 2) A watchdog-projector, which reacts to observed events in this Category by stepping in to complete in-flight requests that have stalled @@ -51,13 +51,12 @@ module Fold = | Failed of Events.TransferRequested | Adding of Removed | Added of Added + and Removed = { request : Events.TransferRequested; removed : Events.Removed } + and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } and TerminalState = | Adjusted of Events.AdjustmentRequested | Transferred of Added | TransferFailed of Events.TransferRequested - and AdjustState = Events.AdjustmentRequested - and Removed = { request : Events.TransferRequested; removed : Events.Removed } - and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } let initial = Initial let evolve state event = match state, event with @@ -120,7 +119,7 @@ let decide command updates (state : Fold.State) : Result * Events.Event list = type Service internal (log, resolve, maxAttempts) = - let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) + let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) member __.IngestShipped(inventoryId, transactionId, command, updates) : Async = let stream = resolve transactionId @@ -139,4 +138,4 @@ module Cosmos = let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) - let createService (context, cache) = createService (resolve (context, cache)) \ No newline at end of file + let createService (context, cache) = createService (resolve (context, cache)) diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index 7527bde77..838f9d174 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -10,7 +10,7 @@ type Service internal (zeroBalance, shouldClose, series : Series.Service, epochs let rec execute locationId originEpochId = let rec aux epochId balanceToCarryForward wip = async { - let decide state = match wip with Complete r -> r,[] | Pending decide -> decide state + let decide state = match wip with Complete r -> r, [] | Pending decide -> decide state match! epochs.Sync(locationId, epochId, balanceToCarryForward, decide, shouldClose) with | { balance = bal; result = Some res; isOpen = true } -> if originEpochId <> epochId then diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 24e9d3b5d..421b7a052 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -64,7 +64,7 @@ let sync (balanceCarriedForward : Fold.Balance option) (decide : Fold.Balance -> acc.Ingest state <| match state with | Fold.Initial -> failwith "We've just guaranteed not Initial" - | Fold.Open { value = bal } -> let r,es = decide bal in Some r,es + | Fold.Open { value = bal } -> let r, es = decide bal in Some r, es | Fold.Closed _ -> None, [] // Finally (iff we're `Open`, have run a `decide` and `shouldClose`), we generate a Closed event let (balance, isOpen), _ = diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index 517f9dec7..72306eb40 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -48,6 +48,6 @@ module Cosmos = let resolve (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) let opt = Equinox.ResolveOption.AllowStale - fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id,opt) + fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id, opt) let createService (context, cache, maxAttempts) = create (resolve (context, cache)) maxAttempts From 95afe8910b1052425677db3deb8ea4c16430020c Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Mon, 17 Feb 2020 15:48:09 +0000 Subject: [PATCH 25/45] Fix batch vs epoch naming in inventory --- equinox-fc/Domain/Inventory.fs | 28 ++++++++++++++-------------- equinox-fc/Domain/InventoryEpoch.fs | 4 ++-- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index 80b916343..f512547ad 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -20,7 +20,7 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv // Guaranteed to be set only after `previousIds.AwaitValue()` let mutable activeEpochId = Unchecked.defaultof<_> - // We want max one request in flight to establish the pre-existing Batches from which the tickets cache will be seeded + // We want max one request in flight to establish the pre-existing Events from which the TransactionIds cache will be seeded let previousEpochs = AsyncCacheCell> list> <| async { let! startingId = series.ReadIngestionEpoch(inventoryId) activeEpochId <- %startingId @@ -29,8 +29,8 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv // TransactionIds cache - used to maintain a list of transactions that have already been ingested in order to avoid db round-trips let previousIds : AsyncCacheCell> = AsyncCacheCell <| async { - let! batches = previousEpochs.AwaitValue() - let! ids = seq { for x in batches -> x.AwaitValue() } |> Async.Parallel + let! previousEpochs = previousEpochs.AwaitValue() + let! ids = seq { for x in previousEpochs -> x.AwaitValue() } |> Async.Parallel return IdsCache.Create(Seq.concat ids) } let tryIngest events = async { @@ -55,30 +55,30 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv log.Information("Marking {inventoryId:l}/{epochId} active", inventoryId, epochId) do! series.AdvanceIngestionEpoch(inventoryId, epochId) System.Threading.Interlocked.CompareExchange(&activeEpochId, %epochId, activeEpochId) |> ignore - let totalIngestedTickets = totalIngested + res.added + let totalIngestedTransactions = totalIngested + res.added match res.rejected with - | [] -> return totalIngestedTickets - | rej -> return! aux (InventoryEpochId.next epochId) totalIngestedTickets rej } + | [] -> return totalIngestedTransactions + | rej -> return! aux (InventoryEpochId.next epochId) totalIngestedTransactions rej } return! aux initialEpochId 0 events } - /// Upon startup, we initialize the PickTickets cache with recent batches; we want to kick that process off before our first ingest + /// Upon startup, we initialize the TransactionIds cache with recent epochs; we want to kick that process off before our first ingest member __.Initialize() = previousIds.AwaitValue() |> Async.Ignore - /// Feeds the events into the sequence of batches. Returns the number of items actually added [excluding duplicates] + /// Feeds the events into the sequence of transactions. Returns the number actually added [excluding duplicates] member __.Ingest(events : Epoch.Events.Event list) : Async = tryIngest events module internal Helpers = - let create inventoryId maxTransactionsPerBatch lookBackLimit (series, epochs) = - let remainingBatchCapacity (state: Epoch.Fold.State) = + let create inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) = + let remainingEpochCapacity (state: Epoch.Fold.State) = let currentLen = state.ids.Count - max 0 (maxTransactionsPerBatch - currentLen) - Service(inventoryId, series, epochs, lookBack = lookBackLimit, capacity = remainingBatchCapacity) + max 0 (maxTransactionsPerEpoch - currentLen) + Service(inventoryId, series, epochs, lookBack = lookBackLimit, capacity = remainingEpochCapacity) module Cosmos = - let create inventoryId maxTransactionsPerBatch lookBackLimit (context, cache) = + let create inventoryId maxTransactionsPerEpoch lookBackLimit (context, cache) = let series = Series.Cosmos.createService (context, cache) let epochs = Epoch.Cosmos.createService (context, cache) - Helpers.create inventoryId maxTransactionsPerBatch lookBackLimit (series, epochs) + Helpers.create inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index c596d5cbb..746c01b49 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -66,8 +66,8 @@ let decideSync capacity events (state : Fold.State) : Result * Events.Event list let residual = List.skip accepting news closing, accepting, closing, residual let events = - [ if allowing <> 0 then yield! news - if markClosed then yield Events.Closed ] + [ if allowing <> 0 then yield! news + if markClosed then yield Events.Closed ] let state' = Fold.fold state events { isClosed = closed; added = allowing; rejected = residual; transactionIds = state'.ids }, events From 790a4e8bdb07669a1627195fcf90916f0523b60b Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Tue, 18 Feb 2020 08:44:25 +0000 Subject: [PATCH 26/45] Complete Process Manager Apply --- equinox-fc/Domain/InventoryTransaction.fs | 80 ++++++++++------------- 1 file changed, 36 insertions(+), 44 deletions(-) diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 7d5c4d988..57c845d79 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -33,7 +33,8 @@ module Events = | Added of Added (* Successful completion *) - | Completed // terminal + | Logged + | Completed interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() @@ -42,6 +43,7 @@ module Fold = type State = | Initial | Running of RunningState + | Logging of TerminalState | Completed of TerminalState and RunningState = | Adjust of Events.AdjustmentRequested @@ -61,10 +63,10 @@ module Fold = let evolve state event = match state, event with (* Adjustment Process *) - | Initial, Events.AdjustmentRequested e -> - Running (Adjust e) - | Running (Adjust s), Events.Adjusted -> - Completed (Adjusted s) + | Initial, Events.AdjustmentRequested r -> + Running (Adjust r) + | Running (Adjust r), Events.Adjusted -> + Logging (Adjusted r) (* Transfer Process *) | Initial, Events.TransferRequested e -> @@ -73,59 +75,49 @@ module Fold = | Running (Transfer (Requested s)), Events.Failed -> Completed (TransferFailed s) - | Running (Transfer (Requested s)), Events.Removed e as ee -> + | Running (Transfer (Requested s)), Events.Removed e -> Running (Transfer (Adding { request = s; removed = e })) - | Running (Transfer (Adding s)), Events.Added e as ee -> + | Running (Transfer (Adding s)), Events.Added e -> Running (Transfer (Added { request = s.request; removed = s.removed; added = e })) - | Running (Transfer (Added s)), Events.Completed as ee -> - Completed (Transferred s) + | Running (Transfer (Added s)), Events.Completed -> + Logging (Transferred s) + + (* Log result *) + | Logging s, Events.Logged -> + Completed s (* Any disallowed state changes represent gaps in the model, so we fail fast *) | state, event -> failwithf "Unexpected %A when %A" event state let fold : State -> Events.Event seq -> State = Seq.fold evolve -type Command = - | Adjust of Events.AdjustmentRequested - | Transfer of Events.TransferRequested - -type Result = { complete : bool; } - -/// Holds events accumulated from a series of decisions while also evolving the presented `state` to reflect the pended events -type private Accumulator() = - let acc = ResizeArray() - member __.Ingest(state) : 'res * Events.Event list -> 'res * Fold.State = function - | res, [] -> res, state - | res, [e] -> acc.Add e; res, Fold.evolve state e - | res, xs -> acc.AddRange xs; res, Fold.fold state (Seq.ofList xs) - member __.Accumulated = List.ofSeq acc - -type Update = - | AdjustmentCompleted - -let decide command updates (state : Fold.State) : Result * Events.Event list = - - let acc = Accumulator() - let started, state = - acc.Ingest state <| - match state, command with - | Fold.Initial, Adjust e -> true, [ Events.AdjustmentRequested e ] - | Fold.Initial, Transfer e -> true, [ Events.TransferRequested e ] - - // TOCONSIDER validate conflicts - - | _ -> false, [] - - { complete = false }, acc.Accumulated + /// Validates an event actually represents an acceptable, non-redundant state transition + let filter event state = + match state, event with + | Initial, Events.AdjustmentRequested _ + | Initial, Events.TransferRequested _ + | Running (Adjust _), Events.Adjusted + | Running (Transfer (Requested _)), Events.Failed + | Running (Transfer (Requested _)), Events.Removed _ + | Running (Transfer (Adding _)), Events.Added _ + | Logging _, Events.Logged -> + [event] + | _ -> [] + +/// Given an event from the Process's timeline, yields the State, in order that it can be completed +let decide update (state : Fold.State) : Fold.State * Events.Event list = + let events = Fold.filter update state + let state' = Fold.fold state events + state', events type Service internal (log, resolve, maxAttempts) = let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) - member __.IngestShipped(inventoryId, transactionId, command, updates) : Async = + member __.Apply(transactionId, update) : Async = let stream = resolve transactionId - stream.Transact(decide command updates) + stream.Transact(decide update) -let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) +let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 3) module Cosmos = From ed33c94a700e9c3b03c747692023776dc5130d57 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 19 Feb 2020 09:54:17 +0000 Subject: [PATCH 27/45] Target V2s --- equinox-fc/Domain.Tests/Domain.Tests.fsproj | 2 +- equinox-fc/Domain/Domain.fsproj | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/equinox-fc/Domain.Tests/Domain.Tests.fsproj b/equinox-fc/Domain.Tests/Domain.Tests.fsproj index 236935241..a8213b6eb 100644 --- a/equinox-fc/Domain.Tests/Domain.Tests.fsproj +++ b/equinox-fc/Domain.Tests/Domain.Tests.fsproj @@ -16,7 +16,7 @@ - + diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index 32f7f3857..13301d866 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -17,7 +17,7 @@ - + From 18a805958b18e825ce3bcbbe01842fdad1cc22be Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 19 Feb 2020 15:17:11 +0000 Subject: [PATCH 28/45] wip --- dotnet-templates.sln | 2 +- equinox-fc/.template.config/template.json | 2 +- equinox-fc/Domain/Domain.fsproj | 2 +- equinox-fc/Domain/Inventory.fs | 19 +++++++++-- equinox-fc/Domain/InventoryTransaction.fs | 40 +++++++++++++++-------- 5 files changed, 46 insertions(+), 19 deletions(-) diff --git a/dotnet-templates.sln b/dotnet-templates.sln index 43f6f4b32..6f7b1f5ce 100644 --- a/dotnet-templates.sln +++ b/dotnet-templates.sln @@ -80,7 +80,7 @@ EndProjectSection EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Equinox.Templates", "src\Equinox.Templates\Equinox.Templates.fsproj", "{8C92B728-85A5-4231-863A-E4236E46CC36}" EndProject -Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "fc", "fc", "{4946576F-1558-49ED-A272-6F4D92FB0031}" +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "fcInventory", "fcInventory", "{4946576F-1558-49ED-A272-6F4D92FB0031}" ProjectSection(SolutionItems) = preProject equinox-fc\.template.config\template.json = equinox-fc\.template.config\template.json equinox-fc\README.md = equinox-fc\README.md diff --git a/equinox-fc/.template.config/template.json b/equinox-fc/.template.config/template.json index 135b57883..b8bac62f6 100644 --- a/equinox-fc/.template.config/template.json +++ b/equinox-fc/.template.config/template.json @@ -12,7 +12,7 @@ }, "identity": "Equinox.Fc", "name": "Equinox Fc Example", - "shortName": "eqxFc", + "shortName": "fcInventory", "sourceName": "Fc", "preferNameDirectory": true } \ No newline at end of file diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index 13301d866..9e1499c82 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -13,8 +13,8 @@ - + diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index f512547ad..9a13f5423 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -70,7 +70,7 @@ type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Serv module internal Helpers = - let create inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) = + let createService inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) = let remainingEpochCapacity (state: Epoch.Fold.State) = let currentLen = state.ids.Count max 0 (maxTransactionsPerEpoch - currentLen) @@ -81,4 +81,19 @@ module Cosmos = let create inventoryId maxTransactionsPerEpoch lookBackLimit (context, cache) = let series = Series.Cosmos.createService (context, cache) let epochs = Epoch.Cosmos.createService (context, cache) - Helpers.create inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) + Helpers.createService inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) + +module Processor = + + type Service(transactions : Transaction.Service, locations : Fc.Location.Service, inventory : Service) = + + member __.Apply(inventoryId, transactionId, update) = async { + let! action = transactions.Apply(transactionId, update) + match action with + | Transaction.Adjust (loc, qty) -> locations.Execute + | Remove of LocationId * int + | Add of LocationId * int + | Log of TerminalState + | Finish + service.Ingest + } \ No newline at end of file diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 57c845d79..90f4f0410 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -7,7 +7,7 @@ /// In the normal case, such an actor will bring the flow to a terminal state (Completed or Failed) /// 2) A watchdog-projector, which reacts to observed events in this Category by stepping in to complete in-flight requests that have stalled /// This represents the case where a 'happy path' actor died, or experienced another impediment on the path. -module Fc.InventoryTransaction +module Fc.Inventory.Transaction // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] @@ -38,6 +38,18 @@ module Events = interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() +type TerminalState = + | Adjusted of Events.AdjustmentRequested + | Transferred of Added + | TransferFailed of Events.TransferRequested +and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } +type Action = + | Adjust of LocationId * int + | Remove of LocationId * int + | Add of LocationId * int + | Log of TerminalState + | Finish + module Fold = type State = @@ -50,15 +62,8 @@ module Fold = | Transfer of TransferState and TransferState = | Requested of Events.TransferRequested - | Failed of Events.TransferRequested | Adding of Removed - | Added of Added and Removed = { request : Events.TransferRequested; removed : Events.Removed } - and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } - and TerminalState = - | Adjusted of Events.AdjustmentRequested - | Transferred of Added - | TransferFailed of Events.TransferRequested let initial = Initial let evolve state event = match state, event with @@ -78,9 +83,7 @@ module Fold = | Running (Transfer (Requested s)), Events.Removed e -> Running (Transfer (Adding { request = s; removed = e })) | Running (Transfer (Adding s)), Events.Added e -> - Running (Transfer (Added { request = s.request; removed = s.removed; added = e })) - | Running (Transfer (Added s)), Events.Completed -> - Logging (Transferred s) + Logging (Transferred { request = s.request; removed = s.removed; added = e }) (* Log result *) | Logging s, Events.Logged -> @@ -103,17 +106,26 @@ module Fold = [event] | _ -> [] + /// Determines the next action (if any) to be carried out in this workflwo + let nextAction : State -> Action = function + | Initial -> failwith "Cannot interpret Initial state" + | Running (Adjust r) -> Action.Adjust (r.location, r.quantity) + | Running (Transfer (Requested r)) -> Action.Remove (r.source, r.quantity) + | Running (Transfer (Adding r)) -> Action.Add (r.request.destination, r.request.quantity) + | Logging s -> Action.Log s + | Completed _ -> Finish + /// Given an event from the Process's timeline, yields the State, in order that it can be completed -let decide update (state : Fold.State) : Fold.State * Events.Event list = +let decide update (state : Fold.State) : Action * Events.Event list = let events = Fold.filter update state let state' = Fold.fold state events - state', events + Fold.nextAction state', events type Service internal (log, resolve, maxAttempts) = let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) - member __.Apply(transactionId, update) : Async = + member __.Apply(transactionId, update) : Async = let stream = resolve transactionId stream.Transact(decide update) From a8ecd7593024963d99cdb0225c7dfa027ce1779a Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 21 Feb 2020 14:58:25 +0000 Subject: [PATCH 29/45] Process Manager wip --- equinox-fc/Domain/Inventory.fs | 50 ++++++--- equinox-fc/Domain/InventoryEpoch.fs | 7 +- equinox-fc/Domain/InventoryTransaction.fs | 27 +++-- equinox-fc/Domain/Location.fs | 28 ++--- equinox-fc/Domain/LocationEpoch.fs | 118 +++++++++++++++------- 5 files changed, 153 insertions(+), 77 deletions(-) diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index 9a13f5423..80943ea48 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -12,9 +12,9 @@ type internal IdsCache<'Id>() = /// Maintains active Epoch Id in a thread-safe manner while ingesting items into the `series` of `epochs` /// Prior to first add, reads `lookBack` epochs to seed the cache, in order to minimize the number of duplicated Ids we ingest -type Service internal (inventoryId, series : Series.Service, epochs : Epoch.Service, lookBack, capacity) = +type Service2 internal (inventoryId, series : Series.Service, epochs : Epoch.Service, lookBack, capacity) = - let log = Serilog.Log.ForContext() + let log = Serilog.Log.ForContext() // Maintains what we believe to be the currently open EpochId // Guaranteed to be set only after `previousIds.AwaitValue()` @@ -74,7 +74,7 @@ module internal Helpers = let remainingEpochCapacity (state: Epoch.Fold.State) = let currentLen = state.ids.Count max 0 (maxTransactionsPerEpoch - currentLen) - Service(inventoryId, series, epochs, lookBack = lookBackLimit, capacity = remainingEpochCapacity) + Service2(inventoryId, series, epochs, lookBack = lookBackLimit, capacity = remainingEpochCapacity) module Cosmos = @@ -85,15 +85,35 @@ module Cosmos = module Processor = - type Service(transactions : Transaction.Service, locations : Fc.Location.Service, inventory : Service) = - - member __.Apply(inventoryId, transactionId, update) = async { - let! action = transactions.Apply(transactionId, update) - match action with - | Transaction.Adjust (loc, qty) -> locations.Execute - | Remove of LocationId * int - | Add of LocationId * int - | Log of TerminalState - | Finish - service.Ingest - } \ No newline at end of file + type Service(transactions : Transaction.Service, locations : Fc.Location.Service, inventory : Service2) = + + let execute transactionId = + let f = Fc.Location.Epoch.decide transactionId + let rec aux update = async { + let! action = transactions.Apply(transactionId, update) + match action with + | Transaction.Adjust (loc, bal) -> + match! locations.Execute(loc, f (Fc.Location.Epoch.Reset bal)) with + | Fc.Location.Epoch.Accepted _ -> do! aux (Transaction.Events.Adjusted) + | Fc.Location.Epoch.DupFromPreviousEpoch -> failwith "TODO walk back to previous epoch" + | Transaction.Remove (loc, delta) -> + match! locations.Execute(loc, f (Fc.Location.Epoch.Remove delta)) with + | Fc.Location.Epoch.Accepted bal -> do! aux (Transaction.Events.Removed { balance = bal }) + | Fc.Location.Epoch.DupFromPreviousEpoch -> failwith "TODO walk back to previous epoch" + | Transaction.Add (loc, delta) -> + match! locations.Execute(loc, f (Fc.Location.Epoch.Add delta)) with + | Fc.Location.Epoch.Accepted bal -> do! aux (Transaction.Events.Added { balance = bal }) + | Fc.Location.Epoch.DupFromPreviousEpoch -> failwith "TODO walk back to previous epoch" + | Transaction.Log (Transaction.Adjusted e) -> + let! _count = inventory.Ingest([Fc.Inventory.Epoch.Events.Adjusted { transactionId = transactionId }]) + do! aux Transaction.Events.Logged + | Transaction.Log (Transaction.Transferred e) -> + let! _count = inventory.Ingest([Fc.Inventory.Epoch.Events.Transferred { transactionId = transactionId }]) + do! aux Transaction.Events.Logged + | Transaction.Finish -> + () + } + aux + + member __.Apply(transactionId, update) = + execute transactionId update diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index 746c01b49..5fca01731 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -10,13 +10,12 @@ module Events = let [] CategoryId = "InventoryEpoch" let (|For|) (inventoryId, epochId) = FsCodec.StreamName.compose CategoryId [InventoryId.toString inventoryId; InventoryEpochId.toString epochId] - type TransactionInfo = { transactionId : InventoryTransactionId } - + type TransactionRef = { transactionId : InventoryTransactionId } type Snapshotted = { closed: bool; ids : InventoryTransactionId[] } type Event = - | Adjusted of TransactionInfo - | Transferred of TransactionInfo + | Adjusted of TransactionRef + | Transferred of TransactionRef | Closed | Snapshotted of Snapshotted interface TypeShape.UnionContract.IUnionContract diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 90f4f0410..31c168ce7 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -38,24 +38,23 @@ module Events = interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() -type TerminalState = - | Adjusted of Events.AdjustmentRequested - | Transferred of Added - | TransferFailed of Events.TransferRequested -and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } type Action = | Adjust of LocationId * int | Remove of LocationId * int | Add of LocationId * int - | Log of TerminalState + | Log of LoggingState | Finish +and LoggingState = + | Adjusted of Events.AdjustmentRequested + | Transferred of Added +and Added = { request : Events.TransferRequested; removed : Events.Removed; added : Events.Added } module Fold = type State = | Initial | Running of RunningState - | Logging of TerminalState + | Logging of LoggingState | Completed of TerminalState and RunningState = | Adjust of Events.AdjustmentRequested @@ -63,6 +62,10 @@ module Fold = and TransferState = | Requested of Events.TransferRequested | Adding of Removed + and TerminalState = + | Adjusted of Events.AdjustmentRequested + | Transferred of Added + | TransferFailed of Events.TransferRequested and Removed = { request : Events.TransferRequested; removed : Events.Removed } let initial = Initial let evolve state event = @@ -71,7 +74,7 @@ module Fold = | Initial, Events.AdjustmentRequested r -> Running (Adjust r) | Running (Adjust r), Events.Adjusted -> - Logging (Adjusted r) + Logging (LoggingState.Adjusted r) (* Transfer Process *) | Initial, Events.TransferRequested e -> @@ -83,11 +86,13 @@ module Fold = | Running (Transfer (Requested s)), Events.Removed e -> Running (Transfer (Adding { request = s; removed = e })) | Running (Transfer (Adding s)), Events.Added e -> - Logging (Transferred { request = s.request; removed = s.removed; added = e }) + Logging (LoggingState.Transferred { request = s.request; removed = s.removed; added = e }) (* Log result *) - | Logging s, Events.Logged -> - Completed s + | Logging (LoggingState.Adjusted s), Events.Logged -> + Completed (Adjusted s) + | Logging (LoggingState.Transferred s), Events.Logged -> + Completed (Transferred s) (* Any disallowed state changes represent gaps in the model, so we fail fast *) | state, event -> failwithf "Unexpected %A when %A" event state diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index 838f9d174..ed4fde94a 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -2,26 +2,28 @@ namespace Fc.Location [] type Wip<'R> = - | Pending of decide : (Epoch.Fold.Balance -> 'R * Epoch.Events.Event list) + | Pending of decide : (Epoch.Fold.State -> 'R * Epoch.Events.Event list) | Complete of 'R /// Manages Reads and Writes for a Series of Epochs, with a running total being carried forward to the next Epoch when it's marked Closed -type Service internal (zeroBalance, shouldClose, series : Series.Service, epochs : Epoch.Service) = +type Service internal (zeroBalance, toBalanceCarriedForward, shouldClose, series : Series.Service, epochs : Epoch.Service) = - let rec execute locationId originEpochId = + let execute locationId originEpochId = let rec aux epochId balanceToCarryForward wip = async { let decide state = match wip with Complete r -> r, [] | Pending decide -> decide state match! epochs.Sync(locationId, epochId, balanceToCarryForward, decide, shouldClose) with - | { balance = bal; result = Some res; isOpen = true } -> + | { result = Some res; isOpen = true } -> if originEpochId <> epochId then do! series.AdvanceIngestionEpoch(locationId, epochId) - return bal, res - | { balance = bal; result = Some res } -> + return res + | { history = history; result = Some res } -> let successorEpochId = LocationEpochId.next epochId - return! aux successorEpochId (Some bal) (Complete res) - | { balance = bal } -> + let cf = toBalanceCarriedForward history + return! aux successorEpochId (Some cf) (Complete res) + | { history = history } -> let successorEpochId = LocationEpochId.next epochId - return! aux successorEpochId (Some bal) wip } + let cf = toBalanceCarriedForward history + return! aux successorEpochId (Some cf) wip } aux member __.Execute(locationId, decide) = async { @@ -35,12 +37,12 @@ type Service internal (zeroBalance, shouldClose, series : Series.Service, epochs [] module Helpers = - let create (zeroBalance, shouldClose) (series, epochs) = - Service(zeroBalance, shouldClose, series, epochs) + let create (zeroBalance, toBalanceCarriedForward, shouldClose) (series, epochs) = + Service(zeroBalance, toBalanceCarriedForward, shouldClose, series, epochs) module Cosmos = - let createService (zeroBalance, shouldClose) (context, cache, maxAttempts) = + let createService (zeroBalance, toBalanceCarriedForward, shouldClose) (context, cache, maxAttempts) = let series = Series.Cosmos.createService (context, cache, maxAttempts) let epochs = Epoch.Cosmos.createService (context, cache, maxAttempts) - create (zeroBalance, shouldClose) (series, epochs) + create (zeroBalance, toBalanceCarriedForward, shouldClose) (series, epochs) diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 421b7a052..91cec84df 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -10,71 +10,121 @@ module Events = let [] CategoryId = "LocationEpoch" let (|For|) (locationId, epochId) = FsCodec.StreamName.compose CategoryId [LocationId.toString locationId; LocationEpochId.toString epochId] - type CarriedForward = { initial : int } - type Delta = { delta : int; transaction : InventoryTransactionId } - type Value = { value : int; transaction : InventoryTransactionId } + type CarriedForward = { initial : int; recentTransactions : InventoryTransactionId[] } type Event = | CarriedForward of CarriedForward + | Added of {| delta : int; id : InventoryTransactionId |} + | Removed of {| delta : int; id : InventoryTransactionId |} + | Reset of {| value : int; id : InventoryTransactionId |} | Closed - | Added of Delta - | Removed of Delta - | Reset of Value interface TypeShape.UnionContract.IUnionContract let codec = FsCodec.NewtonsoftJson.Codec.Create() module Fold = - type Balance = int - type OpenState = { count : int; value : Balance } - type State = Initial | Open of OpenState | Closed of Balance + type State = + | Initial + | Open of Record list // reverse order, i.e. most revent first + | Closed of Record list // trimmed + and Record = + | Init of Events.CarriedForward + | Step of Step + and Step = { balance : Balance; id : InventoryTransactionId } + and Balance = int let initial = Initial + let (|Current|) = function + | (Init { initial = bal } | Step { balance = bal }) :: _ -> bal + | [] -> failwith "Cannot transact when no CarriedForward" let evolve state event = match event, state with - | Events.CarriedForward e, Initial -> Open { count = 0; value = e.initial } - | Events.Added e, Open bal -> Open { count = bal.count + 1; value = bal.value + e.delta } - | Events.Removed e, Open bal -> Open { count = bal.count + 1; value = bal.value - e.delta } - | Events.Reset e, Open bal -> Open { count = bal.count + 1; value = e.value } - | Events.Closed, Open { value = bal } -> Closed bal - | Events.CarriedForward _, (Open _|Closed _ as x) -> failwithf "CarriedForward : Unexpected %A" x - | (Events.Added _|Events.Removed _|Events.Reset _|Events.Closed) as e, (Initial|Closed _ as s) -> failwithf "Unexpected %A when %A" e s + | Events.CarriedForward e, Initial -> Open [Init e] + | Events.Added e, Open (Current cur as log) -> Open (Step { id = e.id ; balance = cur + e.delta } :: log) + | Events.Removed e, Open (Current cur as log) -> Open (Step { id = e.id ; balance = cur - e.delta } :: log) + | Events.Reset e, Open log -> Open (Step { id = e.id ; balance = e.value } :: log) + | Events.Closed, Open log -> Closed log + | Events.CarriedForward _, (Open _ | Closed _ as x) -> failwithf "CarriedForward : Unexpected %A" x + | (Events.Added _ | Events.Removed _ | Events.Reset _ | Events.Closed) as e, (Initial | Closed _ as s) -> + failwithf "Unexpected %A when %A" e s let fold = Seq.fold evolve /// Holds events accumulated from a series of decisions while also evolving the presented `state` to reflect the pended events type private Accumulator() = let acc = ResizeArray() member __.Ingest state : 'res * Events.Event list -> 'res * Fold.State = function - | res, [] -> res, state - | res, [e] -> acc.Add e; res, Fold.evolve state e - | res, xs -> acc.AddRange xs; res, Fold.fold state (Seq.ofList xs) + | res, [] -> res, state + | res, [e] -> acc.Add e; res, Fold.evolve state e + | res, xs -> acc.AddRange xs; res, Fold.fold state (Seq.ofList xs) member __.Accumulated = List.ofSeq acc -type Result<'t> = { balance : Fold.Balance; result : 't option; isOpen : bool } +type Result<'t> = { history : Fold.Record list; result : 't option; isOpen : bool } -let sync (balanceCarriedForward : Fold.Balance option) (decide : Fold.Balance -> 't*Events.Event list) shouldClose state : Result<'t>*Events.Event list = +let sync (carriedForward : Events.CarriedForward option) + (decide : Fold.State -> 't * Events.Event list) + shouldClose + state + : Result<'t> * Events.Event list = let acc = Accumulator() - // We require a CarriedForward event at the start of any Epoch's event stream + // 1. Guarantee a CarriedForward event at the start of any Epoch's event stream let (), state = acc.Ingest state <| match state with - | Fold.Initial -> (), [Events.CarriedForward { initial = Option.get balanceCarriedForward }] + | Fold.Initial -> (), [Events.CarriedForward (Option.get carriedForward )] | Fold.Open _ | Fold.Closed _ -> (), [] - // Run, unless we determine we're in Closed state + // 2. Transact (unless we determine we're in Closed state) let result, state = acc.Ingest state <| match state with - | Fold.Initial -> failwith "We've just guaranteed not Initial" - | Fold.Open { value = bal } -> let r, es = decide bal in Some r, es - | Fold.Closed _ -> None, [] - // Finally (iff we're `Open`, have run a `decide` and `shouldClose`), we generate a Closed event - let (balance, isOpen), _ = + | Fold.Initial -> failwith "We've just guaranteed not Initial" + | Fold.Open history -> let r, es = decide state in Some r, es + | Fold.Closed _ -> None, [] + // 3. Finally (iff we're `Open`, have run a `decide` and `shouldClose`), we generate a Closed event + let (history, isOpen), _ = acc.Ingest state <| match state with - | Fold.Initial -> failwith "Can't be Initial" - | Fold.Open ({ value = bal } as openState) when shouldClose openState -> (bal, false), [Events.Closed] - | Fold.Open { value = bal } -> (bal, true), [] - | Fold.Closed bal -> (bal, false), [] - { balance = balance; result = result; isOpen = isOpen }, acc.Accumulated + | Fold.Initial -> failwith "Can't be Initial" + | Fold.Open history -> + if shouldClose history then (history, false), [Events.Closed] + else (history, true), [] + | Fold.Closed history -> (history, false), [] + { history = history; result = result; isOpen = isOpen }, acc.Accumulated + +type DupCheckResult = NotDuplicate | IdempotentInsert of Fold.Balance | DupCarriedForward +let private tryFindDup transactionId (history : Fold.Record list) = + let tryMatch : Fold.Record -> Fold.Balance option option = function + | Fold.Step { balance = bal; id = id } when id = transactionId -> Some (Some bal) + | Fold.Init { recentTransactions = prevs } when prevs |> Array.contains transactionId -> Some None + | _ -> None + match history |> Seq.tryPick tryMatch with + | None -> NotDuplicate + | Some None -> DupCarriedForward + | Some (Some bal) -> IdempotentInsert bal + +type Command = + | Reset of value : int + | Add of delta : int + | Remove of delta : int + +type Result = Accepted of Fold.Balance | DupFromPreviousEpoch + +let decide transactionId command (state: Fold.State) = + match state with + | Fold.Closed _ | Fold.Initial -> failwithf "Cannot apply in state %A" state + | Fold.Open history -> + + match tryFindDup transactionId history with + | IdempotentInsert bal -> Accepted bal, [] + | DupCarriedForward -> DupFromPreviousEpoch, [] + | NotDuplicate -> + + let e = + match command with + | Reset value -> Events.Reset {| value = value; id = transactionId |} + | Add delta -> Events.Added {| delta = delta; id = transactionId |} + | Remove delta -> Events.Removed {| delta = delta; id = transactionId |} + match Fold.evolve state e with + | Fold.Open (Fold.Current cur) -> Accepted cur, [] + | s -> failwithf "Unexpected state %A" s type Service internal (log, resolve, maxAttempts) = From dbc1f44cb32e91aab4f21402cd409c1fa61eacbd Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Fri, 21 Feb 2020 23:15:21 +0000 Subject: [PATCH 30/45] Minor renames; tests not yet compiling --- equinox-fc/Domain.Tests/LocationEpochTests.fs | 6 +++--- equinox-fc/Domain.Tests/LocationTests.fs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/equinox-fc/Domain.Tests/LocationEpochTests.fs b/equinox-fc/Domain.Tests/LocationEpochTests.fs index b0c244314..4184d9d13 100644 --- a/equinox-fc/Domain.Tests/LocationEpochTests.fs +++ b/equinox-fc/Domain.Tests/LocationEpochTests.fs @@ -7,8 +7,8 @@ open Swensen.Unquote let interpret transactionId delta _balance = match delta with | 0 -> (), [] - | delta when delta < 0 -> (), [Events.Removed { delta = -delta; transaction = transactionId }] - | delta -> (), [Events.Added { delta = delta; transaction = transactionId }] + | delta when delta < 0 -> (), [Events.Removed {| delta = -delta; id = transactionId |}] + | delta -> (), [Events.Added {| delta = delta; id = transactionId |}] let validateAndInterpret transactionId expectedBalance delta balance = test <@ expectedBalance = balance @> @@ -28,7 +28,7 @@ let [] properties transactionId carriedForward delta1 closeImmediately let cfEvents events = events |> List.filter (function Events.CarriedForward _ -> true | _ -> false) let closeEvents events = events |> List.filter (function Events.Closed -> true | _ -> false) let state1 = Fold.fold Fold.initial events - let expectedBalance = carriedForward + delta1 + let expectedBalance = carriedForward.initial + delta1 // Only expect closing if it was requested let expectImmediateClose = closeImmediately test <@ Option.isSome res.result diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index 52e6b75f7..536505c57 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -38,8 +38,8 @@ let run (service : Location.Service) (IdsAtLeastOne locations, deltas : _[], tra let adjust delta (bal : Epoch.Fold.Balance) = let value = max -bal delta if value = 0 then 0, [] - elif value < 0 then value, [Epoch.Events.Removed { delta = -value; transaction = transactionId }] - else value, [Epoch.Events.Added { delta = value; transaction = transactionId }] + elif value < 0 then value, [Epoch.Events.Removed {| delta = -value; id = transactionId |}] + else value, [Epoch.Events.Added {| delta = value; id = transactionId |}] let! appliedDeltas = seq { for loc, x in updates -> async { let! _, eff = service.Execute(loc, adjust x) in return loc,eff } } |> Async.Parallel let expectedBalances = Seq.append (seq { for l in locations -> l, 0}) appliedDeltas |> Seq.groupBy fst |> Seq.map (fun (l, xs) -> l, xs |> Seq.sumBy snd) |> Set.ofSeq From 9d1a9c1849358bac3cdfe8716a1366d9fefe5bd8 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sun, 23 Feb 2020 19:55:22 +0000 Subject: [PATCH 31/45] WIP --- dotnet-templates.sln | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/dotnet-templates.sln b/dotnet-templates.sln index 6f7b1f5ce..baa05a488 100644 --- a/dotnet-templates.sln +++ b/dotnet-templates.sln @@ -90,6 +90,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "equinox-fc\Domain EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "equinox-fc\Domain.Tests\Domain.Tests.fsproj", "{49890A45-D6C2-4EF6-87AD-39960E03E254}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Equinox.Templates", "src\Equinox.Templates\Equinox.Templates.fsproj", "{8C92B728-85A5-4231-863A-E4236E46CC36}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -150,6 +152,10 @@ Global {49890A45-D6C2-4EF6-87AD-39960E03E254}.Debug|Any CPU.Build.0 = Debug|Any CPU {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.ActiveCfg = Release|Any CPU {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.Build.0 = Release|Any CPU + {8C92B728-85A5-4231-863A-E4236E46CC36}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {8C92B728-85A5-4231-863A-E4236E46CC36}.Debug|Any CPU.Build.0 = Debug|Any CPU + {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.ActiveCfg = Release|Any CPU + {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(NestedProjects) = preSolution {F66A5BFE-7C81-44DC-97DE-3FD8C83B8F06} = {B72FFAAE-7801-41B2-86F5-FD90E97A30F7} From b473d2bf29a50afab9797009679be79f4edcf74f Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Tue, 25 Feb 2020 01:55:32 +0000 Subject: [PATCH 32/45] Remove sln mess --- dotnet-templates.sln | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/dotnet-templates.sln b/dotnet-templates.sln index baa05a488..0b2fe0309 100644 --- a/dotnet-templates.sln +++ b/dotnet-templates.sln @@ -90,8 +90,6 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "equinox-fc\Domain EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "equinox-fc\Domain.Tests\Domain.Tests.fsproj", "{49890A45-D6C2-4EF6-87AD-39960E03E254}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Equinox.Templates", "src\Equinox.Templates\Equinox.Templates.fsproj", "{8C92B728-85A5-4231-863A-E4236E46CC36}" -EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -140,10 +138,6 @@ Global {F66A5BFE-7C81-44DC-97DE-3FD8C83B8F06}.Debug|Any CPU.Build.0 = Debug|Any CPU {F66A5BFE-7C81-44DC-97DE-3FD8C83B8F06}.Release|Any CPU.ActiveCfg = Release|Any CPU {F66A5BFE-7C81-44DC-97DE-3FD8C83B8F06}.Release|Any CPU.Build.0 = Release|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Debug|Any CPU.Build.0 = Debug|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.ActiveCfg = Release|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.Build.0 = Release|Any CPU {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}.Debug|Any CPU.Build.0 = Debug|Any CPU {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -152,10 +146,6 @@ Global {49890A45-D6C2-4EF6-87AD-39960E03E254}.Debug|Any CPU.Build.0 = Debug|Any CPU {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.ActiveCfg = Release|Any CPU {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.Build.0 = Release|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Debug|Any CPU.Build.0 = Debug|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.ActiveCfg = Release|Any CPU - {8C92B728-85A5-4231-863A-E4236E46CC36}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(NestedProjects) = preSolution {F66A5BFE-7C81-44DC-97DE-3FD8C83B8F06} = {B72FFAAE-7801-41B2-86F5-FD90E97A30F7} From edb99a78cb08484d3c2db2951e968fcf606afe3d Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Tue, 25 Feb 2020 01:55:45 +0000 Subject: [PATCH 33/45] Cover denial of Remove action --- equinox-fc/Domain/Inventory.fs | 29 +++++++++++++---------- equinox-fc/Domain/InventoryTransaction.fs | 5 ++-- equinox-fc/Domain/LocationEpoch.fs | 17 ++++++------- 3 files changed, 28 insertions(+), 23 deletions(-) diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index 80943ea48..3658b863d 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -94,26 +94,29 @@ module Processor = match action with | Transaction.Adjust (loc, bal) -> match! locations.Execute(loc, f (Fc.Location.Epoch.Reset bal)) with - | Fc.Location.Epoch.Accepted _ -> do! aux (Transaction.Events.Adjusted) - | Fc.Location.Epoch.DupFromPreviousEpoch -> failwith "TODO walk back to previous epoch" + | Fc.Location.Epoch.Accepted _ -> return! aux (Transaction.Events.Adjusted) + | Fc.Location.Epoch.Denied -> return failwith "Cannot Deny Reset" + | Fc.Location.Epoch.DupFromPreviousEpoch -> return failwith "TODO walk back to previous epoch" | Transaction.Remove (loc, delta) -> match! locations.Execute(loc, f (Fc.Location.Epoch.Remove delta)) with - | Fc.Location.Epoch.Accepted bal -> do! aux (Transaction.Events.Removed { balance = bal }) - | Fc.Location.Epoch.DupFromPreviousEpoch -> failwith "TODO walk back to previous epoch" + | Fc.Location.Epoch.Accepted bal -> return! aux (Transaction.Events.Removed { balance = bal }) + | Fc.Location.Epoch.Denied -> return! aux Transaction.Events.Failed + | Fc.Location.Epoch.DupFromPreviousEpoch -> return failwith "TODO walk back to previous epoch" | Transaction.Add (loc, delta) -> match! locations.Execute(loc, f (Fc.Location.Epoch.Add delta)) with - | Fc.Location.Epoch.Accepted bal -> do! aux (Transaction.Events.Added { balance = bal }) - | Fc.Location.Epoch.DupFromPreviousEpoch -> failwith "TODO walk back to previous epoch" - | Transaction.Log (Transaction.Adjusted e) -> + | Fc.Location.Epoch.Accepted bal -> return! aux (Transaction.Events.Added { balance = bal }) + | Fc.Location.Epoch.Denied -> return failwith "Cannot Deny Add" + | Fc.Location.Epoch.DupFromPreviousEpoch -> return failwith "TODO walk back to previous epoch" + | Transaction.Log (Transaction.Adjusted _) -> let! _count = inventory.Ingest([Fc.Inventory.Epoch.Events.Adjusted { transactionId = transactionId }]) - do! aux Transaction.Events.Logged - | Transaction.Log (Transaction.Transferred e) -> + return! aux Transaction.Events.Logged + | Transaction.Log (Transaction.Transferred _) -> let! _count = inventory.Ingest([Fc.Inventory.Epoch.Events.Transferred { transactionId = transactionId }]) - do! aux Transaction.Events.Logged - | Transaction.Finish -> - () + return! aux Transaction.Events.Logged + | Transaction.Finish success -> + return success } aux - member __.Apply(transactionId, update) = + member __.TryApply(transactionId, update) = execute transactionId update diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 31c168ce7..40e76e8b4 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -43,7 +43,7 @@ type Action = | Remove of LocationId * int | Add of LocationId * int | Log of LoggingState - | Finish + | Finish of success : bool and LoggingState = | Adjusted of Events.AdjustmentRequested | Transferred of Added @@ -118,7 +118,8 @@ module Fold = | Running (Transfer (Requested r)) -> Action.Remove (r.source, r.quantity) | Running (Transfer (Adding r)) -> Action.Add (r.request.destination, r.request.quantity) | Logging s -> Action.Log s - | Completed _ -> Finish + | Completed (TransferFailed _) -> Finish false + | Completed (Transferred _ | Adjusted _) -> Finish true /// Given an event from the Process's timeline, yields the State, in order that it can be completed let decide update (state : Fold.State) : Action * Events.Event list = diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 91cec84df..b5c32f86f 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -105,25 +105,26 @@ type Command = | Add of delta : int | Remove of delta : int -type Result = Accepted of Fold.Balance | DupFromPreviousEpoch +type Result = Denied | Accepted of Fold.Balance | DupFromPreviousEpoch let decide transactionId command (state: Fold.State) = match state with | Fold.Closed _ | Fold.Initial -> failwithf "Cannot apply in state %A" state - | Fold.Open history -> + | Fold.Open (Fold.Current cur as history) -> match tryFindDup transactionId history with | IdempotentInsert bal -> Accepted bal, [] | DupCarriedForward -> DupFromPreviousEpoch, [] | NotDuplicate -> - let e = + let accepted, events = match command with - | Reset value -> Events.Reset {| value = value; id = transactionId |} - | Add delta -> Events.Added {| delta = delta; id = transactionId |} - | Remove delta -> Events.Removed {| delta = delta; id = transactionId |} - match Fold.evolve state e with - | Fold.Open (Fold.Current cur) -> Accepted cur, [] + | Reset value -> true, [Events.Reset {| value = value; id = transactionId |}] + | Add delta -> true, [Events.Added {| delta = delta; id = transactionId |}] + | Remove delta when delta > cur -> false, [] + | Remove delta -> true, [Events.Removed {| delta = delta; id = transactionId |}] + match Fold.fold state events with + | Fold.Open (Fold.Current cur) -> (if accepted then Accepted cur else Denied), events | s -> failwithf "Unexpected state %A" s type Service internal (log, resolve, maxAttempts) = From 29077e15ced95ef4dcda502d5b294fd40e8843f8 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 26 Feb 2020 09:59:05 +0000 Subject: [PATCH 34/45] Add explicit Service action methods on Process Manager --- equinox-fc/Domain/Inventory.fs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index 3658b863d..d972eee93 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -118,5 +118,9 @@ module Processor = } aux - member __.TryApply(transactionId, update) = - execute transactionId update + member __.Adjust(transactionId, location, quantity) = + execute transactionId (Fc.Inventory.Transaction.Events.AdjustmentRequested { location = location; quantity = quantity }) + + member __.TryTransfer(transactionId, source, destination, quantity) = + execute transactionId (Fc.Inventory.Transaction.Events.TransferRequested { source = source; destination = destination; quantity = quantity }) + From c69b8e4790f44151e769ac8a7c5a6ae2b8159cb1 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 26 Feb 2020 13:05:57 +0000 Subject: [PATCH 35/45] Add Watchdog --- dotnet-templates.sln | 7 + equinox-fc/Domain/Infrastructure.fs | 1 + equinox-fc/Domain/Inventory.fs | 11 +- equinox-fc/Domain/InventoryTransaction.fs | 41 ++- equinox-fc/Watchdog/Handler.fs | 54 +++ equinox-fc/Watchdog/Program.fs | 395 ++++++++++++++++++++++ equinox-fc/Watchdog/Watchdog.fsproj | 26 ++ 7 files changed, 531 insertions(+), 4 deletions(-) create mode 100644 equinox-fc/Watchdog/Handler.fs create mode 100644 equinox-fc/Watchdog/Program.fs create mode 100644 equinox-fc/Watchdog/Watchdog.fsproj diff --git a/dotnet-templates.sln b/dotnet-templates.sln index 0b2fe0309..150ced066 100644 --- a/dotnet-templates.sln +++ b/dotnet-templates.sln @@ -90,6 +90,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "equinox-fc\Domain EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "equinox-fc\Domain.Tests\Domain.Tests.fsproj", "{49890A45-D6C2-4EF6-87AD-39960E03E254}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Watchdog", "equinox-fc\Watchdog\Watchdog.fsproj", "{46B8B7C9-3334-4C13-A339-57571C14F2B9}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -146,6 +148,10 @@ Global {49890A45-D6C2-4EF6-87AD-39960E03E254}.Debug|Any CPU.Build.0 = Debug|Any CPU {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.ActiveCfg = Release|Any CPU {49890A45-D6C2-4EF6-87AD-39960E03E254}.Release|Any CPU.Build.0 = Release|Any CPU + {46B8B7C9-3334-4C13-A339-57571C14F2B9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {46B8B7C9-3334-4C13-A339-57571C14F2B9}.Debug|Any CPU.Build.0 = Debug|Any CPU + {46B8B7C9-3334-4C13-A339-57571C14F2B9}.Release|Any CPU.ActiveCfg = Release|Any CPU + {46B8B7C9-3334-4C13-A339-57571C14F2B9}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(NestedProjects) = preSolution {F66A5BFE-7C81-44DC-97DE-3FD8C83B8F06} = {B72FFAAE-7801-41B2-86F5-FD90E97A30F7} @@ -161,5 +167,6 @@ Global {36C2D70A-F292-4481-8ADA-5066A80F92B2} = {1F3C9245-F973-43A3-97C9-5E527B93060C} {B3CFC965-6AB9-47E8-AA47-548A8D8A2E2C} = {4946576F-1558-49ED-A272-6F4D92FB0031} {49890A45-D6C2-4EF6-87AD-39960E03E254} = {4946576F-1558-49ED-A272-6F4D92FB0031} + {46B8B7C9-3334-4C13-A339-57571C14F2B9} = {4946576F-1558-49ED-A272-6F4D92FB0031} EndGlobalSection EndGlobal diff --git a/equinox-fc/Domain/Infrastructure.fs b/equinox-fc/Domain/Infrastructure.fs index 02863a4a3..2f41917e5 100644 --- a/equinox-fc/Domain/Infrastructure.fs +++ b/equinox-fc/Domain/Infrastructure.fs @@ -32,4 +32,5 @@ type InventoryTransactionId = string and [] inventoryTransactionId module InventoryTransactionId = let parse (value : string) : InventoryTransactionId = %value + let (|Parse|) = parse let toString (value : InventoryTransactionId) : string = %value diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index d972eee93..14754695f 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -91,10 +91,11 @@ module Processor = let f = Fc.Location.Epoch.decide transactionId let rec aux update = async { let! action = transactions.Apply(transactionId, update) + let aux event = aux (Some event) match action with | Transaction.Adjust (loc, bal) -> match! locations.Execute(loc, f (Fc.Location.Epoch.Reset bal)) with - | Fc.Location.Epoch.Accepted _ -> return! aux (Transaction.Events.Adjusted) + | Fc.Location.Epoch.Accepted _ -> return! aux Transaction.Events.Adjusted | Fc.Location.Epoch.Denied -> return failwith "Cannot Deny Reset" | Fc.Location.Epoch.DupFromPreviousEpoch -> return failwith "TODO walk back to previous epoch" | Transaction.Remove (loc, delta) -> @@ -117,10 +118,14 @@ module Processor = return success } aux + let run transactionId req = execute transactionId (Some req) member __.Adjust(transactionId, location, quantity) = - execute transactionId (Fc.Inventory.Transaction.Events.AdjustmentRequested { location = location; quantity = quantity }) + run transactionId (Fc.Inventory.Transaction.Events.AdjustmentRequested { location = location; quantity = quantity }) member __.TryTransfer(transactionId, source, destination, quantity) = - execute transactionId (Fc.Inventory.Transaction.Events.TransferRequested { source = source; destination = destination; quantity = quantity }) + run transactionId (Fc.Inventory.Transaction.Events.TransferRequested { source = source; destination = destination; quantity = quantity }) + /// Used by Watchdog to force conclusion of a transaction whose progress has stalled + member __.Push(transactionId) = async { + let! _ = execute transactionId None in () } \ No newline at end of file diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 40e76e8b4..9ee61b472 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -123,7 +123,10 @@ module Fold = /// Given an event from the Process's timeline, yields the State, in order that it can be completed let decide update (state : Fold.State) : Action * Events.Event list = - let events = Fold.filter update state + let events = + match update with + | None -> [] + | Some update -> Fold.filter update state let state' = Fold.fold state events Fold.nextAction state', events @@ -149,3 +152,39 @@ module Cosmos = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) let createService (context, cache) = createService (resolve (context, cache)) + +/// Handles requirement to infer when a transaction is 'stuck' +/// Note we don't want to couple to the state in a deep manner; thus we track: +/// a) when the request intent is established (aka when *Requested is logged) +/// b) when a transaction reports that it has Completed +module Watchdog = + + module Events = + + // TOCONSIDER: this can be written more generically by just grabbing the time of the very first event + type Event = + | AdjustmentRequested + | TransferRequested + | Completed + interface TypeShape.UnionContract.IUnionContract + type TimestampAndEvent = System.DateTimeOffset * Event + let codec = + let up (encoded : FsCodec.ITimelineEvent<_>, message) : TimestampAndEvent = encoded.Timestamp, message + let down _union = failwith "Not Implemented" + FsCodec.NewtonsoftJson.Codec.Create(up, down) + + module Fold = + + type State = Initial | Active of startTime: System.DateTimeOffset | Completed + let initial = Initial + let evolve _state = function + | startTime, (Events.AdjustmentRequested | Events.TransferRequested ) -> Active startTime + | _, Events.Completed -> Completed + let fold : State -> Events.TimestampAndEvent seq -> State = Seq.fold evolve + + type Status = Complete | Active | Stuck + let categorize cutoffTime = function + | Fold.Initial -> Active // cover (hypothetical) corner case where we don't have any valid events yet + | Fold.Active startTime when startTime < cutoffTime -> Stuck + | Fold.Active _ -> Active + | Fold.Completed -> Complete diff --git a/equinox-fc/Watchdog/Handler.fs b/equinox-fc/Watchdog/Handler.fs new file mode 100644 index 000000000..908923a04 --- /dev/null +++ b/equinox-fc/Watchdog/Handler.fs @@ -0,0 +1,54 @@ +module Fc.Watchdog.Handler + +open System + +[] +type Outcome = Completed | Deferred | Nudged + +type Stats(log, ?statsInterval, ?stateInterval) = + inherit Propulsion.Streams.Projector.Stats(log, defaultArg statsInterval (TimeSpan.FromMinutes 1.), defaultArg stateInterval (TimeSpan.FromMinutes 5.)) + + let mutable completed, deferred, resolved = 0, 0, 0 + + override __.HandleOk res = res |> function + | Outcome.Completed -> completed <- completed + 1 + | Outcome.Deferred -> deferred <- deferred + 1 + | Outcome.Nudged -> resolved <- resolved + 1 + + override __.DumpStats () = + if completed <> 0 || deferred <> 0 then + log.Information(" Completed {completed} Deferred {deferred} Resolved {resolved}", completed, deferred, resolved) + completed <- 0; deferred <- 0; resolved <- 0 + +open Fc.Inventory.Transaction + +let fold : Watchdog.Events.TimestampAndEvent seq -> Watchdog.Fold.State = + Watchdog.Fold.fold Watchdog.Fold.initial + +let (|FoldToWatchdogState|) (span : Propulsion.Streams.StreamSpan<_>) : Watchdog.Fold.State = + span.events + |> Seq.choose Watchdog.Events.codec.TryDecode + |> fold + +let tryHandle driveTransaction (stream, span : Propulsion.Streams.StreamSpan<_>) : Async = async { + let processingStuckCutoff = let now = DateTimeOffset.UtcNow in now.AddSeconds -10. + match stream, span with + | FsCodec.StreamName.CategoryAndId (Events.CategoryId, InventoryTransactionId.Parse transId), FoldToWatchdogState state -> + match Watchdog.categorize processingStuckCutoff state with + | Watchdog.Complete -> + return Outcome.Completed + | Watchdog.Active -> + // Visiting every second is not too expensive; we don't want to be warming the data center for no purpose + do! Async.Sleep 1000 // ms + return Outcome.Deferred + | Watchdog.Stuck -> + do! driveTransaction transId + return Outcome.Nudged + | _ -> return failwith "Not a relevant event" } + +let handleStreamEvents tryHandle (stream, span : Propulsion.Streams.StreamSpan<_>) : Async = async { + match! tryHandle (stream, span) with + // if we're deferring, we need to retain the events (all of them, as the time of the first one is salient) + | Outcome.Deferred as r -> return span.index, r + // if it's now complete (either organically, or with our help), we can release all the events pertaining to this transaction + | Outcome.Completed | Outcome.Nudged as r -> return span.index + span.events.LongLength, r } diff --git a/equinox-fc/Watchdog/Program.fs b/equinox-fc/Watchdog/Program.fs new file mode 100644 index 000000000..5d7cc4219 --- /dev/null +++ b/equinox-fc/Watchdog/Program.fs @@ -0,0 +1,395 @@ +module Fc.Watchdog.Program + +open Propulsion.Cosmos +open Propulsion.EventStore +open Serilog +open System + +module EnvVar = + + let tryGet varName : string option = Environment.GetEnvironmentVariable varName |> Option.ofObj + let set varName value : unit = Environment.SetEnvironmentVariable(varName, value) + +module Settings = + + let private initEnvVar var key loadF = + if None = EnvVar.tryGet var then + printfn "Setting %s from %A" var key + EnvVar.set var (loadF key) + + let initialize () = + // e.g. initEnvVar "EQUINOX_COSMOS_COLLECTION" "CONSUL KEY" readFromConsul + () // TODO add any custom logic preprocessing commandline arguments and/or gathering custom defaults from external sources, etc + +module CmdParser = + + exception MissingArg of string + let private getEnvVarForArgumentOrThrow varName argName = + match EnvVar.tryGet varName with + | None -> raise (MissingArg(sprintf "Please provide a %s, either as an argument or via the %s environment variable" argName varName)) + | Some x -> x + let private defaultWithEnvVar varName argName = function + | None -> getEnvVarForArgumentOrThrow varName argName + | Some x -> x + open Argu + open Equinox.Cosmos + open Equinox.EventStore + [] + type Parameters = + | [] ConsumerGroupName of string + | [] MaxReadAhead of int + | [] MaxWriters of int + | [] Verbose + | [] VerboseConsole + + + | [] Es of ParseResults + | [] SrcCosmos of ParseResults + interface IArgParserTemplate with + member a.Usage = + match a with + | ConsumerGroupName _ -> "Projector consumer group name." + | MaxReadAhead _ -> "maximum number of batches to let processing get ahead of completion. Default: 16." + | MaxWriters _ -> "maximum number of concurrent streams on which to process at any time. Default: 64." + | Verbose -> "request Verbose Logging. Default: off." + | VerboseConsole -> "request Verbose Console Logging. Default: off." + | Es _ -> "specify EventStore input parameters." + | SrcCosmos _ -> "specify CosmosDB input parameters." + and Arguments(a : ParseResults) = + member __.ConsumerGroupName = a.GetResult ConsumerGroupName + member __.Verbose = a.Contains Parameters.Verbose + member __.VerboseConsole = a.Contains VerboseConsole + member __.MaxReadAhead = a.GetResult(MaxReadAhead, 16) + member __.MaxConcurrentStreams = a.GetResult(MaxWriters, 64) + member __.StatsInterval = TimeSpan.FromMinutes 1. + + member val Source : Choice = + match a.TryGetSubCommand() with + | Some (Es es) -> Choice1Of2 (EsSourceArguments es) + | Some (SrcCosmos cosmos) -> Choice2Of2 (CosmosSourceArguments cosmos) + | _ -> raise (MissingArg "Must specify one of cosmos or es for Src") + member x.SourceParams() : Choice = + match x.Source with + | Choice1Of2 srcE -> + let startPos, cosmos = srcE.StartPos, srcE.Cosmos + Log.Information("Processing Consumer Group {groupName} from {startPos} (force: {forceRestart}) in Database {db} Container {container}", + x.ConsumerGroupName, startPos, srcE.ForceRestart, cosmos.Database, cosmos.Container) + Log.Information("Ingesting in batches of [{minBatchSize}..{batchSize}], reading up to {maxReadAhead} uncommitted batches ahead", + srcE.MinBatchSize, srcE.StartingBatchSize, x.MaxReadAhead) + Choice1Of2 (srcE, cosmos, + { groupName = x.ConsumerGroupName; start = startPos; checkpointInterval = srcE.CheckpointInterval; tailInterval = srcE.TailInterval + forceRestart = srcE.ForceRestart + batchSize = srcE.StartingBatchSize; minBatchSize = srcE.MinBatchSize; gorge = srcE.Gorge; streamReaders = 0 }) + | Choice2Of2 srcC -> + let disco, auxColl = + match srcC.LeaseContainer with + | None -> srcC.Discovery, { database = srcC.Database; container = srcC.Container + "-aux" } + | Some sc -> srcC.Discovery, { database = srcC.Database; container = sc } + Log.Information("Max read backlog: {maxReadAhead}", x.MaxReadAhead) + Log.Information("Processing Lease {leaseId} in Database {db} Container {container} with maximum document count limited to {maxDocuments}", + x.ConsumerGroupName, auxColl.database, auxColl.container, srcC.MaxDocuments) + if srcC.FromTail then Log.Warning("(If new projector group) Skipping projection of all existing events.") + srcC.LagFrequency |> Option.iter (fun s -> Log.Information("Dumping lag stats at {lagS:n0}s intervals", s.TotalSeconds)) + Choice2Of2 (srcC, (disco, auxColl, x.ConsumerGroupName, srcC.FromTail, srcC.MaxDocuments, srcC.LagFrequency)) + and [] CosmosSourceParameters = + | [] FromTail + | [] MaxDocuments of int + | [] LagFreqM of float + | [] LeaseContainer of string + + | [] ConnectionMode of Equinox.Cosmos.ConnectionMode + | [] Connection of string + | [] Database of string + | [] Container of string // Actually Mandatory, but stating that is not supported + | [] Timeout of float + | [] Retries of int + | [] RetriesWaitTime of float + + | [] Cosmos of ParseResults + interface IArgParserTemplate with + member a.Usage = a |> function + | FromTail -> "(iff the Consumer Name is fresh) - force skip to present Position. Default: Never skip an event." + | MaxDocuments _ -> "maximum item count to request from feed. Default: unlimited" + | LagFreqM _ -> "frequency (in minutes) to dump lag stats. Default: off" + | LeaseContainer _ -> "specify Container Name for Leases container. Default: `sourceContainer` + `-aux`." + + | ConnectionMode _ -> "override the connection mode. Default: Direct." + | Connection _ -> "specify a connection string for a Cosmos account. (optional if environment variable EQUINOX_COSMOS_CONNECTION specified)" + | Database _ -> "specify a database name for Cosmos account. (optional if environment variable EQUINOX_COSMOS_DATABASE specified)" + | Container _ -> "specify a container name within `Database`" + | Timeout _ -> "specify operation timeout in seconds. Default: 5." + | Retries _ -> "specify operation retries. Default: 1." + | RetriesWaitTime _ -> "specify max wait-time for retry when being throttled by Cosmos in seconds. Default: 5." + + | Cosmos _ -> "CosmosDb Sink parameters." + and CosmosSourceArguments(a : ParseResults) = + member __.FromTail = a.Contains CosmosSourceParameters.FromTail + member __.MaxDocuments = a.TryGetResult MaxDocuments + member __.LagFrequency = a.TryGetResult LagFreqM |> Option.map TimeSpan.FromMinutes + member __.LeaseContainer = a.TryGetResult CosmosSourceParameters.LeaseContainer + + member __.Mode = a.GetResult(CosmosSourceParameters.ConnectionMode, Equinox.Cosmos.ConnectionMode.Direct) + member __.Discovery = Discovery.FromConnectionString __.Connection + member __.Connection = a.TryGetResult CosmosSourceParameters.Connection |> defaultWithEnvVar "EQUINOX_COSMOS_CONNECTION" "Connection" + member __.Database = a.TryGetResult CosmosSourceParameters.Database |> defaultWithEnvVar "EQUINOX_COSMOS_DATABASE" "Database" + member __.Container = a.GetResult CosmosSourceParameters.Container + member __.Timeout = a.GetResult(CosmosSourceParameters.Timeout, 5.) |> TimeSpan.FromSeconds + member __.Retries = a.GetResult(CosmosSourceParameters.Retries, 1) + member __.MaxRetryWaitTime = a.GetResult(CosmosSourceParameters.RetriesWaitTime, 5.) |> TimeSpan.FromSeconds + member x.BuildConnectionDetails() = + let (Discovery.UriAndKey (endpointUri, _)) as discovery = x.Discovery + Log.Information("Source CosmosDb {mode} {endpointUri} Database {database} Container {container}", + x.Mode, endpointUri, x.Database, x.Container) + Log.Information("Source CosmosDb timeout {timeout}s; Throttling retries {retries}, max wait {maxRetryWaitTime}s", + (let t = x.Timeout in t.TotalSeconds), x.Retries, (let t = x.MaxRetryWaitTime in t.TotalSeconds)) + let c = Equinox.Cosmos.Connector(x.Timeout, x.Retries, x.MaxRetryWaitTime, Log.Logger, mode=x.Mode) + discovery, { database = x.Database; container = x.Container }, c + + member val Cosmos = + match a.TryGetSubCommand() with + | Some (CosmosSourceParameters.Cosmos cosmos) -> CosmosArguments cosmos + | _ -> raise (MissingArg "Must specify cosmos details") + and [] EsSourceParameters = + | [] FromTail + | [] Gorge of int + | [] Tail of intervalS: float + | [] ForceRestart + | [] BatchSize of int + | [] MinBatchSize of int + | [] Position of int64 + | [] Chunk of int + | [] Percent of float + + | [] Verbose + | [] Timeout of float + | [] Retries of int + | [] HeartbeatTimeout of float + | [] Tcp + | [] Host of string + | [] Port of int + | [] Username of string + | [] Password of string + + | [] Cosmos of ParseResults + interface IArgParserTemplate with + member a.Usage = a |> function + | FromTail -> "Start the processing from the Tail" + | Gorge _ -> "Request Parallel readers phase during initial catchup, running one chunk (256MB) apart. Default: off" + | Tail _ -> "attempt to read from tail at specified interval in Seconds. Default: 1" + | ForceRestart _ -> "Forget the current committed position; start from (and commit) specified position. Default: start from specified position or resume from committed." + | BatchSize _ -> "maximum item count to request from feed. Default: 4096" + | MinBatchSize _ -> "minimum item count to drop down to in reaction to read failures. Default: 512" + | Position _ -> "EventStore $all Stream Position to commence from" + | Chunk _ -> "EventStore $all Chunk to commence from" + | Percent _ -> "EventStore $all Stream Position to commence from (as a percentage of current tail position)" + + | Verbose -> "Include low level Store logging." + | Tcp -> "Request connecting direct to a TCP/IP endpoint. Default: Use Clustered mode with Gossip-driven discovery (unless environment variable EQUINOX_ES_TCP specifies 'true')." + | Host _ -> "TCP mode: specify a hostname to connect to directly. Clustered mode: use Gossip protocol against all A records returned from DNS query. (optional if environment variable EQUINOX_ES_HOST specified)" + | Port _ -> "specify a custom port. Uses value of environment variable EQUINOX_ES_PORT if specified. Defaults for Cluster and Direct TCP/IP mode are 30778 and 1113 respectively." + | Username _ -> "specify a username. (optional if environment variable EQUINOX_ES_USERNAME specified)" + | Password _ -> "specify a Password. (optional if environment variable EQUINOX_ES_PASSWORD specified)" + | Timeout _ -> "specify operation timeout in seconds. Default: 20." + | Retries _ -> "specify operation retries. Default: 3." + | HeartbeatTimeout _ -> "specify heartbeat timeout in seconds. Default: 1.5." + + | Cosmos _ -> "CosmosDB (Checkpoint) Store parameters." + and EsSourceArguments(a : ParseResults) = + member __.Gorge = a.TryGetResult Gorge + member __.TailInterval = a.GetResult(Tail, 1.) |> TimeSpan.FromSeconds + member __.ForceRestart = a.Contains ForceRestart + member __.StartingBatchSize = a.GetResult(BatchSize, 4096) + member __.MinBatchSize = a.GetResult(MinBatchSize, 512) + member __.StartPos = + match a.TryGetResult Position, a.TryGetResult Chunk, a.TryGetResult Percent, a.Contains EsSourceParameters.FromTail with + | Some p, _, _, _ -> Absolute p + | _, Some c, _, _ -> StartPos.Chunk c + | _, _, Some p, _ -> Percentage p + | None, None, None, true -> StartPos.TailOrCheckpoint + | None, None, None, _ -> StartPos.StartOrCheckpoint + + member __.Discovery = + match __.Tcp, __.Port with + | false, None -> Discovery.GossipDns __.Host + | false, Some p -> Discovery.GossipDnsCustomPort (__.Host, p) + | true, None -> Discovery.Uri (UriBuilder("tcp", __.Host).Uri) + | true, Some p -> Discovery.Uri (UriBuilder("tcp", __.Host, p).Uri) + member __.Tcp = + a.Contains EsSourceParameters.Tcp + || EnvVar.tryGet "EQUINOX_ES_TCP" |> Option.exists (fun s -> String.Equals(s, bool.TrueString, StringComparison.OrdinalIgnoreCase)) + member __.Port = match a.TryGetResult Port with Some x -> Some x | None -> EnvVar.tryGet "EQUINOX_ES_PORT" |> Option.map int + member __.Host = a.TryGetResult Host |> defaultWithEnvVar "EQUINOX_ES_HOST" "Host" + member __.User = a.TryGetResult Username |> defaultWithEnvVar "EQUINOX_ES_USERNAME" "Username" + member __.Password = a.TryGetResult Password |> defaultWithEnvVar "EQUINOX_ES_PASSWORD" "Password" + member __.Retries = a.GetResult(EsSourceParameters.Retries, 3) + member __.Timeout = a.GetResult(EsSourceParameters.Timeout, 20.) |> TimeSpan.FromSeconds + member __.Heartbeat = a.GetResult(HeartbeatTimeout, 1.5) |> TimeSpan.FromSeconds + member x.Connect(log: ILogger, storeLog: ILogger, appName, connectionStrategy) = + let s (x : TimeSpan) = x.TotalSeconds + let discovery = x.Discovery + log.ForContext("host", x.Host).ForContext("port", x.Port) + .Information("EventStore {discovery} heartbeat: {heartbeat}s Timeout: {timeout}s Retries {retries}", + discovery, s x.Heartbeat, s x.Timeout, x.Retries) + let log=if storeLog.IsEnabled Serilog.Events.LogEventLevel.Debug then Logger.SerilogVerbose storeLog else Logger.SerilogNormal storeLog + let tags=["M", Environment.MachineName; "I", Guid.NewGuid() |> string] + Connector(x.User, x.Password, x.Timeout, x.Retries, log=log, heartbeatTimeout=x.Heartbeat, tags=tags) + .Establish(appName, discovery, connectionStrategy) |> Async.RunSynchronously + + member __.CheckpointInterval = TimeSpan.FromHours 1. + member val Cosmos : CosmosArguments = + match a.TryGetSubCommand() with + | Some (EsSourceParameters.Cosmos cosmos) -> CosmosArguments cosmos + | _ -> raise (MissingArg "Must specify `cosmos` checkpoint store when source is `es`") + and [] CosmosParameters = + | [] Connection of string + | [] ConnectionMode of ConnectionMode + | [] Database of string + | [] Container of string + | [] Timeout of float + | [] Retries of int + | [] RetriesWaitTime of float + interface IArgParserTemplate with + member a.Usage = + match a with + | ConnectionMode _ -> "override the connection mode. Default: Direct." + | Connection _ -> "specify a connection string for a Cosmos account. (optional if environment variable EQUINOX_COSMOS_CONNECTION specified)" + | Database _ -> "specify a database name for Cosmos store. (optional if environment variable EQUINOX_COSMOS_DATABASE specified)" + | Container _ -> "specify a container name for Cosmos store. (optional if environment variable EQUINOX_COSMOS_CONTAINER specified)" + | Timeout _ -> "specify operation timeout in seconds. Default: 5." + | Retries _ -> "specify operation retries. Default: 1." + | RetriesWaitTime _ -> "specify max wait-time for retry when being throttled by Cosmos in seconds. Default: 5." + and CosmosArguments(a : ParseResults) = + member __.Mode = a.GetResult(CosmosParameters.ConnectionMode, Equinox.Cosmos.ConnectionMode.Direct) + member __.Connection = a.TryGetResult CosmosParameters.Connection |> defaultWithEnvVar "EQUINOX_COSMOS_CONNECTION" "Connection" + member __.Database = a.TryGetResult CosmosParameters.Database |> defaultWithEnvVar "EQUINOX_COSMOS_DATABASE" "Database" + member __.Container = a.TryGetResult CosmosParameters.Container |> defaultWithEnvVar "EQUINOX_COSMOS_CONTAINER" "Container" + member __.Timeout = a.GetResult(CosmosParameters.Timeout, 5.) |> TimeSpan.FromSeconds + member __.Retries = a.GetResult(CosmosParameters.Retries, 1) + member __.MaxRetryWaitTime = a.GetResult(CosmosParameters.RetriesWaitTime, 5.) |> TimeSpan.FromSeconds + member x.BuildConnectionDetails() = + let (Discovery.UriAndKey (endpointUri, _) as discovery) = Discovery.FromConnectionString x.Connection + Log.Information("CosmosDb {mode} {endpointUri} Database {database} Container {container}", + x.Mode, endpointUri, x.Database, x.Container) + Log.Information("CosmosDb timeout {timeout}s; Throttling retries {retries}, max wait {maxRetryWaitTime}s", + (let t = x.Timeout in t.TotalSeconds), x.Retries, (let t = x.MaxRetryWaitTime in t.TotalSeconds)) + let connector = Equinox.Cosmos.Connector(x.Timeout, x.Retries, x.MaxRetryWaitTime, Log.Logger, mode=x.Mode) + discovery, x.Database, x.Container, connector + + /// Parse the commandline; can throw exceptions in response to missing arguments and/or `-h`/`--help` args + let parse argv = + let programName = System.Reflection.Assembly.GetEntryAssembly().GetName().Name + let parser = ArgumentParser.Create(programName = programName) + parser.ParseCommandLine argv |> Arguments + +module Logging = + + let initialize verbose changeLogVerbose = + Log.Logger <- + LoggerConfiguration() + .Destructure.FSharpTypes() + .Enrich.FromLogContext() + |> fun c -> if verbose then c.MinimumLevel.Debug() else c + // LibLog writes to the global logger, so we need to control the emission + |> fun c -> let cfpl = if changeLogVerbose then Serilog.Events.LogEventLevel.Debug else Serilog.Events.LogEventLevel.Warning + c.MinimumLevel.Override("Microsoft.Azure.Documents.ChangeFeedProcessor", cfpl) + |> fun c -> let isCfp429a = Filters.Matching.FromSource("Microsoft.Azure.Documents.ChangeFeedProcessor.LeaseManagement.DocumentServiceLeaseUpdater").Invoke + let isCfp429b = Filters.Matching.FromSource("Microsoft.Azure.Documents.ChangeFeedProcessor.PartitionManagement.LeaseRenewer").Invoke + let isCfp429c = Filters.Matching.FromSource("Microsoft.Azure.Documents.ChangeFeedProcessor.PartitionManagement.PartitionLoadBalancer").Invoke + let isCfp429d = Filters.Matching.FromSource("Microsoft.Azure.Documents.ChangeFeedProcessor.FeedProcessing.PartitionProcessor").Invoke + let isCfp x = isCfp429a x || isCfp429b x || isCfp429c x || isCfp429d x + if changeLogVerbose then c else c.Filter.ByExcluding(fun x -> isCfp x) + |> fun c -> let t = "[{Timestamp:HH:mm:ss} {Level:u3}] {partitionKeyRangeId,2} {Message:lj} {NewLine}{Exception}" + c.WriteTo.Console(theme=Sinks.SystemConsole.Themes.AnsiConsoleTheme.Code, outputTemplate=t) + |> fun c -> c.CreateLogger() + +let [] AppName = "Watchdog" + +module EventStoreContext = + let cache = Equinox.Cache(AppName, sizeMb = 10) + let create connection = Equinox.EventStore.Context(connection, Equinox.EventStore.BatchingPolicy(maxBatchSize=500)) + let tryMapEvent isWhitelisted (x : EventStore.ClientAPI.ResolvedEvent) = + match x.Event with + | e when not e.IsJson || e.EventStreamId.StartsWith "$" || not (isWhitelisted e.EventStreamId) -> None + | PropulsionStreamEvent e -> Some e + +let transactionStreamPrefix = sprintf "%s-" Fc.Inventory.Transaction.Events.CategoryId +let isTransactionStream : string -> bool = function sn -> sn.StartsWith transactionStreamPrefix + +let build (args : CmdParser.Arguments) = + match args.SourceParams() with + | Choice1Of2 (srcE, cosmos, spec) -> + let connectEs () = srcE.Connect(Log.Logger, Log.Logger, AppName, Equinox.EventStore.ConnectionStrategy.ClusterSingle Equinox.EventStore.NodePreference.PreferSlave) + let (discovery, database, container, connector) = cosmos.BuildConnectionDetails() + + let connection = connector.Connect(AppName, discovery) |> Async.RunSynchronously + let cache = Equinox.Cache(AppName, sizeMb = 10) + let context = Equinox.Cosmos.Context(connection, database, container) + + let resolveCheckpointStream = + let codec = FsCodec.NewtonsoftJson.Codec.Create() + let caching = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, TimeSpan.FromMinutes 20.) + let access = Equinox.Cosmos.AccessStrategy.Custom (Checkpoint.Fold.isOrigin, Checkpoint.Fold.transmute) + fun target -> Equinox.Cosmos.Resolver(context, codec, Checkpoint.Fold.fold, Checkpoint.Fold.initial, caching, access).Resolve(target, Equinox.AllowStale) + let checkpoints = Checkpoint.CheckpointSeries(spec.groupName, Log.ForContext(), resolveCheckpointStream) + let inventoryService = + let inventoryId = InventoryId.parse "FC000" + let maxTransactionsPerEpoch = 100 + let lookBackLimit = 10 + Fc.Inventory.Cosmos.create inventoryId maxTransactionsPerEpoch lookBackLimit (context, cache) + let transactionService = Fc.Inventory.Transaction.Cosmos.createService (context, cache) + let locations = + let zeroBalance : Fc.Location.Epoch.Events.CarriedForward = { initial = 0; recentTransactions = [||] } + let chooseTransactionIds = function + | Fc.Location.Epoch.Fold.Init { recentTransactions = ids } -> Seq.ofArray ids + | Fc.Location.Epoch.Fold.Step { id = id } -> Seq.singleton id + let toBalanceCarriedForward (Fc.Location.Epoch.Fold.Current cur as records) : Fc.Location.Epoch.Events.CarriedForward = + { initial = cur; recentTransactions = records |> Seq.collect chooseTransactionIds |> Seq.truncate 5 |> Seq.toArray } + let shouldClose x = false + let maxAttempts = 3 + Fc.Location.Cosmos.createService (zeroBalance, toBalanceCarriedForward, shouldClose) (context, cache, maxAttempts) + let processor = Fc.Inventory.Processor.Service(transactionService, locations, inventoryService) + + let handle = Handler.handleStreamEvents (Handler.tryHandle processor.Push) + let sink = + Propulsion.Streams.StreamsProjector.Start( + Log.Logger, args.MaxReadAhead, args.MaxConcurrentStreams, handle, stats = Handler.Stats(Log.Logger)) + let connect () = let c = connectEs () in c.ReadConnection + let runPipeline = + EventStoreSource.Run( + Log.Logger, sink, checkpoints, connect, spec, EventStoreContext.tryMapEvent isTransactionStream, + args.MaxReadAhead, args.StatsInterval) + sink, runPipeline + | Choice2Of2 (srcCosmos, (auxDiscovery, aux, leaseId, startFromTail, maxDocuments, lagFrequency)) -> + let (discovery, database, container, connector) = srcCosmos.Cosmos.BuildConnectionDetails() + let handle (_stream, _span) : Async = failwith "TODO" // Handler.handleStreamEvents (Handler.tryHandle driveTransaction) + let sink = + Propulsion.Streams.StreamsProjector.Start( + Log.Logger, args.MaxReadAhead, args.MaxConcurrentStreams, handle, stats = Handler.Stats(Log.Logger)) + let mapToStreamItems (docs : Microsoft.Azure.Documents.Document seq) : Propulsion.Streams.StreamEvent<_> seq = + docs + |> Seq.collect EquinoxCosmosParser.enumStreamEvents + |> Seq.filter (fun e -> e.stream |> FsCodec.StreamName.toString |> isTransactionStream) + let source = { database = database; container = container } + let createObserver () = CosmosSource.CreateObserver(Log.Logger, sink.StartIngester, mapToStreamItems) + let runPipeline = + CosmosSource.Run(Log.Logger, connector.CreateClient(AppName, discovery), source, aux, + leaseId, startFromTail, createObserver, + ?maxDocuments=maxDocuments, ?lagReportFreq=lagFrequency, auxClient=connector.CreateClient(AppName, auxDiscovery)) + sink, runPipeline + +let run argv = + try let args = CmdParser.parse argv + Logging.initialize args.Verbose args.VerboseConsole + Settings.initialize () + let projector, runSourcePipeline = build args + runSourcePipeline |> Async.Start + projector.AwaitCompletion() |> Async.RunSynchronously + if projector.RanToCompletion then 0 else 2 + with :? Argu.ArguParseException as e -> eprintfn "%s" e.Message; 1 + | CmdParser.MissingArg msg -> eprintfn "%s" msg; 1 + | e -> Log.Fatal(e, "Exiting"); 1 + +[] +let main argv = + try run argv + finally Log.CloseAndFlush() diff --git a/equinox-fc/Watchdog/Watchdog.fsproj b/equinox-fc/Watchdog/Watchdog.fsproj new file mode 100644 index 000000000..ebc91054c --- /dev/null +++ b/equinox-fc/Watchdog/Watchdog.fsproj @@ -0,0 +1,26 @@ + + + + Exe + netcoreapp3.1 + 5 + + + + + + + + + + + + + + + + + + + + From 16bd1393c16ac2fbc1396e958cf7a9d89c09312a Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 26 Feb 2020 13:28:13 +0000 Subject: [PATCH 36/45] Add Watchdog to Fc sln --- equinox-fc/Fc.sln | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/equinox-fc/Fc.sln b/equinox-fc/Fc.sln index bfb82d823..7496986dc 100644 --- a/equinox-fc/Fc.sln +++ b/equinox-fc/Fc.sln @@ -12,6 +12,8 @@ ProjectSection(SolutionItems) = preProject README.md = README.md EndProjectSection EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Watchdog", "Watchdog\Watchdog.fsproj", "{B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -49,5 +51,17 @@ Global {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|x64.Build.0 = Release|Any CPU {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|x86.ActiveCfg = Release|Any CPU {AA589DC7-D0B7-4F95-BC29-6B89AF4E9280}.Release|x86.Build.0 = Release|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Debug|Any CPU.Build.0 = Debug|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Debug|x64.ActiveCfg = Debug|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Debug|x64.Build.0 = Debug|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Debug|x86.ActiveCfg = Debug|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Debug|x86.Build.0 = Debug|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Release|Any CPU.ActiveCfg = Release|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Release|Any CPU.Build.0 = Release|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Release|x64.ActiveCfg = Release|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Release|x64.Build.0 = Release|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Release|x86.ActiveCfg = Release|Any CPU + {B57DFA65-DC4F-4673-A5DC-7B00A08EFFF0}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection EndGlobal From 5ce47742875bfa8fe806d9ca1feeb1870cbb2b6a Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 27 Feb 2020 07:21:13 +0000 Subject: [PATCH 37/45] Tidy wiring --- equinox-fc/Watchdog/Program.fs | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/equinox-fc/Watchdog/Program.fs b/equinox-fc/Watchdog/Program.fs index 5d7cc4219..15d6e5693 100644 --- a/equinox-fc/Watchdog/Program.fs +++ b/equinox-fc/Watchdog/Program.fs @@ -331,6 +331,21 @@ let build (args : CmdParser.Arguments) = let access = Equinox.Cosmos.AccessStrategy.Custom (Checkpoint.Fold.isOrigin, Checkpoint.Fold.transmute) fun target -> Equinox.Cosmos.Resolver(context, codec, Checkpoint.Fold.fold, Checkpoint.Fold.initial, caching, access).Resolve(target, Equinox.AllowStale) let checkpoints = Checkpoint.CheckpointSeries(spec.groupName, Log.ForContext(), resolveCheckpointStream) + let handle (_stream, _span) : Async = failwith "TODO" // Handler.handleStreamEvents (Handler.tryHandle driveTransaction) + let sink = + Propulsion.Streams.StreamsProjector.Start( + Log.Logger, args.MaxReadAhead, args.MaxConcurrentStreams, handle, stats = Handler.Stats(Log.Logger)) + let connect () = let c = connectEs () in c.ReadConnection + let runPipeline = + EventStoreSource.Run( + Log.Logger, sink, checkpoints, connect, spec, EventStoreContext.tryMapEvent isTransactionStream, + args.MaxReadAhead, args.StatsInterval) + sink, runPipeline + | Choice2Of2 (srcCosmos, (auxDiscovery, aux, leaseId, startFromTail, maxDocuments, lagFrequency)) -> + let (discovery, database, container, connector) = srcCosmos.Cosmos.BuildConnectionDetails() + let connection = connector.Connect(AppName, discovery) |> Async.RunSynchronously + let cache = Equinox.Cache(AppName, sizeMb = 10) + let context = Equinox.Cosmos.Context(connection, database, container) let inventoryService = let inventoryId = InventoryId.parse "FC000" let maxTransactionsPerEpoch = 100 @@ -350,18 +365,6 @@ let build (args : CmdParser.Arguments) = let processor = Fc.Inventory.Processor.Service(transactionService, locations, inventoryService) let handle = Handler.handleStreamEvents (Handler.tryHandle processor.Push) - let sink = - Propulsion.Streams.StreamsProjector.Start( - Log.Logger, args.MaxReadAhead, args.MaxConcurrentStreams, handle, stats = Handler.Stats(Log.Logger)) - let connect () = let c = connectEs () in c.ReadConnection - let runPipeline = - EventStoreSource.Run( - Log.Logger, sink, checkpoints, connect, spec, EventStoreContext.tryMapEvent isTransactionStream, - args.MaxReadAhead, args.StatsInterval) - sink, runPipeline - | Choice2Of2 (srcCosmos, (auxDiscovery, aux, leaseId, startFromTail, maxDocuments, lagFrequency)) -> - let (discovery, database, container, connector) = srcCosmos.Cosmos.BuildConnectionDetails() - let handle (_stream, _span) : Async = failwith "TODO" // Handler.handleStreamEvents (Handler.tryHandle driveTransaction) let sink = Propulsion.Streams.StreamsProjector.Start( Log.Logger, args.MaxReadAhead, args.MaxConcurrentStreams, handle, stats = Handler.Stats(Log.Logger)) From ba7c3152e306aeb68c9f934bff15e35d3bee35db Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Tue, 10 Mar 2020 13:08:36 +0000 Subject: [PATCH 38/45] Apply style changes from 4.2 --- equinox-fc/Domain/Inventory.fs | 8 ++--- equinox-fc/Domain/InventoryEpoch.fs | 24 +++++++-------- equinox-fc/Domain/InventorySeries.fs | 28 ++++++++--------- equinox-fc/Domain/InventoryTransaction.fs | 37 +++++++++++++++-------- equinox-fc/Domain/Location.fs | 2 +- equinox-fc/Domain/LocationEpoch.fs | 27 +++++++++-------- equinox-fc/Domain/LocationSeries.fs | 16 +++++----- equinox-fc/Watchdog/Handler.fs | 12 ++------ equinox-fc/Watchdog/Program.fs | 6 ++-- 9 files changed, 84 insertions(+), 76 deletions(-) diff --git a/equinox-fc/Domain/Inventory.fs b/equinox-fc/Domain/Inventory.fs index 14754695f..490d7c847 100644 --- a/equinox-fc/Domain/Inventory.fs +++ b/equinox-fc/Domain/Inventory.fs @@ -70,7 +70,7 @@ type Service2 internal (inventoryId, series : Series.Service, epochs : Epoch.Ser module internal Helpers = - let createService inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) = + let create inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) = let remainingEpochCapacity (state: Epoch.Fold.State) = let currentLen = state.ids.Count max 0 (maxTransactionsPerEpoch - currentLen) @@ -79,9 +79,9 @@ module internal Helpers = module Cosmos = let create inventoryId maxTransactionsPerEpoch lookBackLimit (context, cache) = - let series = Series.Cosmos.createService (context, cache) - let epochs = Epoch.Cosmos.createService (context, cache) - Helpers.createService inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) + let series = Series.Cosmos.create (context, cache) + let epochs = Epoch.Cosmos.create (context, cache) + Helpers.create inventoryId maxTransactionsPerEpoch lookBackLimit (series, epochs) module Processor = diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index 5fca01731..74d5b6d50 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -3,13 +3,13 @@ /// See Inventory.Service for surface level API which manages the ingestion, including transitioning to a new Epoch when an epoch reaches 'full' state module Fc.Inventory.Epoch +let [] Category = "InventoryEpoch" +let streamName (inventoryId, epochId) = FsCodec.StreamName.compose Category [InventoryId.toString inventoryId; InventoryEpochId.toString epochId] + // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] CategoryId = "InventoryEpoch" - let (|For|) (inventoryId, epochId) = FsCodec.StreamName.compose CategoryId [InventoryId.toString inventoryId; InventoryEpochId.toString epochId] - type TransactionRef = { transactionId : InventoryTransactionId } type Snapshotted = { closed: bool; ids : InventoryTransactionId[] } @@ -70,9 +70,7 @@ let decideSync capacity events (state : Fold.State) : Result * Events.Event list let state' = Fold.fold state events { isClosed = closed; added = allowing; rejected = residual; transactionIds = state'.ids }, events -type Service internal (log, resolve, maxAttempts) = - - let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) +type Service internal (resolve : InventoryId * InventoryEpochId -> Equinox.Stream) = /// Attempt ingestion of `events` into the cited Epoch. /// - None will be accepted if the Epoch is `closed` @@ -83,14 +81,16 @@ type Service internal (log, resolve, maxAttempts) = let stream = resolve (inventoryId, epochId) stream.Transact(decideSync capacity events) -let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) +let create resolver = + let resolve locationId = + let stream = resolver (streamName locationId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) + Service (resolve) module Cosmos = - open Equinox.Cosmos - let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) let resolve (context, cache) = - let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let createService (context, cache) = createService (resolve (context, cache)) + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve + let create (context, cache) = create (resolve (context, cache)) diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index 2e0ce93fe..a93f5a67d 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -3,13 +3,13 @@ /// See Inventory.Service for the surface API which manages the writing module Fc.Inventory.Series +let [] Category = "InventorySeries" +let streamName inventoryId = FsCodec.StreamName.create Category (InventoryId.toString inventoryId) + // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] CategoryId = "InventorySeries" - let (|For|) inventoryId = FsCodec.StreamName.create CategoryId (InventoryId.toString inventoryId) - type Started = { epoch : InventoryEpochId } type Event = | Started of Started @@ -30,9 +30,7 @@ let interpretAdvanceIngestionEpoch epochId (state : Fold.State) = if queryActiveEpoch state >= epochId then [] else [Events.Started { epoch = epochId }] -type Service internal (log, resolve, maxAttempts) = - - let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) +type Service internal (resolve : InventoryId -> Equinox.Stream) = member __.ReadIngestionEpoch(inventoryId) : Async = let stream = resolve inventoryId @@ -42,19 +40,21 @@ type Service internal (log, resolve, maxAttempts) = let stream = resolve inventoryId stream.Transact(interpretAdvanceIngestionEpoch epochId) -let createService resolve = - Service(Serilog.Log.ForContext(), resolve, maxAttempts = 2) +let create resolver = + let resolve locationId = + let stream = resolver (streamName locationId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) + Service (resolve) module Cosmos = - open Equinox.Cosmos - + let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent let resolve (context, cache) = - let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // For this stream, we uniformly use stale reads as: // a) we don't require any information from competing writers // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale - fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id, opt) - let createService (context, cache) = - createService (resolve (context, cache)) + fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) + let create (context, cache) = + create (resolve (context, cache)) diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index 9ee61b472..ecb9acbc1 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -9,13 +9,13 @@ /// This represents the case where a 'happy path' actor died, or experienced another impediment on the path. module Fc.Inventory.Transaction +let [] Category = "InventoryTransaction" +let streamName transactionId = FsCodec.StreamName.create Category (InventoryTransactionId.toString transactionId) + // NB - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] CategoryId = "InventoryTransaction" - let (|For|) transactionId = FsCodec.StreamName.create CategoryId (InventoryTransactionId.toString transactionId) - type AdjustmentRequested = { location : LocationId; quantity : int } type TransferRequested = { source : LocationId; destination : LocationId; quantity : int } type Removed = { balance : int } @@ -130,28 +130,28 @@ let decide update (state : Fold.State) : Action * Events.Event list = let state' = Fold.fold state events Fold.nextAction state', events -type Service internal (log, resolve, maxAttempts) = - - let resolve (Events.For streamId) = Equinox.Stream(log, resolve streamId, maxAttempts) +type Service internal (resolve : InventoryTransactionId -> Equinox.Stream) = member __.Apply(transactionId, update) : Async = let stream = resolve transactionId stream.Transact(decide update) -let createService resolve = Service(Serilog.Log.ForContext(), resolve, maxAttempts = 3) +let create resolver = + let resolve inventoryTransactionId = + let stream = resolver (streamName inventoryTransactionId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) + Service (resolve) module Cosmos = - open Equinox.Cosmos - // in the happy path case, the event stream will typically be short, and the state cached, so snapshotting is less critical let accessStrategy = Equinox.Cosmos.AccessStrategy.Unoptimized // ... and there will generally be a single actor touching it at a given time, so we don't need to do a load (which would be more expensive than normal given the `accessStrategy`) before we sync let opt = Equinox.AllowStale let resolve (context, cache) = - let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) - let createService (context, cache) = createService (resolve (context, cache)) + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) + let createService (context, cache) = create (resolve (context, cache)) /// Handles requirement to infer when a transaction is 'stuck' /// Note we don't want to couple to the state in a deep manner; thus we track: @@ -188,3 +188,16 @@ module Watchdog = | Fold.Active startTime when startTime < cutoffTime -> Stuck | Fold.Active _ -> Active | Fold.Completed -> Complete + + let fold : Events.TimestampAndEvent seq -> Fold.State = + Fold.fold Fold.initial + + let (|FoldToWatchdogState|) events : Fold.State = + events + |> Seq.choose Events.codec.TryDecode + |> fold + + let (|Match|_|) = function + | FsCodec.StreamName.CategoryAndId (Category, InventoryTransactionId.Parse transId), FoldToWatchdogState state -> + Some (transId, state) + | _ -> None \ No newline at end of file diff --git a/equinox-fc/Domain/Location.fs b/equinox-fc/Domain/Location.fs index ed4fde94a..37c08479d 100644 --- a/equinox-fc/Domain/Location.fs +++ b/equinox-fc/Domain/Location.fs @@ -44,5 +44,5 @@ module Cosmos = let createService (zeroBalance, toBalanceCarriedForward, shouldClose) (context, cache, maxAttempts) = let series = Series.Cosmos.createService (context, cache, maxAttempts) - let epochs = Epoch.Cosmos.createService (context, cache, maxAttempts) + let epochs = Epoch.Cosmos.create (context, cache, maxAttempts) create (zeroBalance, toBalanceCarriedForward, shouldClose) (series, epochs) diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index b5c32f86f..a356c6a79 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -3,13 +3,13 @@ /// See Location.Service for the logic that allows competing readers/writers to co-operate in bringing this about module Fc.Location.Epoch +let [] Category = "LocationEpoch" +let streamName (locationId, epochId) = FsCodec.StreamName.compose Category [LocationId.toString locationId; LocationEpochId.toString epochId] + // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] CategoryId = "LocationEpoch" - let (|For|) (locationId, epochId) = FsCodec.StreamName.compose CategoryId [LocationId.toString locationId; LocationEpochId.toString epochId] - type CarriedForward = { initial : int; recentTransactions : InventoryTransactionId[] } type Event = | CarriedForward of CarriedForward @@ -24,7 +24,7 @@ module Fold = type State = | Initial - | Open of Record list // reverse order, i.e. most revent first + | Open of Record list // reverse order, i.e. most recent first | Closed of Record list // trimmed and Record = | Init of Events.CarriedForward @@ -127,22 +127,23 @@ let decide transactionId command (state: Fold.State) = | Fold.Open (Fold.Current cur) -> (if accepted then Accepted cur else Denied), events | s -> failwithf "Unexpected state %A" s -type Service internal (log, resolve, maxAttempts) = - - let resolve (Events.For id) = Equinox.Stream(log, resolve id, maxAttempts) +type Service internal (resolve : LocationId * LocationEpochId -> Equinox.Stream) = member __.Sync<'R>(locationId, epochId, prevEpochBalanceCarriedForward, decide, shouldClose) : Async> = let stream = resolve (locationId, epochId) stream.Transact(sync prevEpochBalanceCarriedForward decide shouldClose) -let create resolve maxAttempts = Service(Serilog.Log.ForContext(), resolve, maxAttempts = maxAttempts) +let create resolver maxAttempts = + let resolve locId = + let stream = resolver (streamName locId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = maxAttempts) + Service (resolve) module Cosmos = - open Equinox.Cosmos - + let accessStrategy = Equinox.Cosmos.AccessStrategy.Unoptimized let resolve (context, cache) = - let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.Unoptimized).Resolve - let createService (context, cache, maxAttempts) = + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve + let create (context, cache, maxAttempts) = create (resolve (context, cache)) maxAttempts diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index 72306eb40..35c77707f 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -1,13 +1,13 @@ /// Manages the active epoch for a given Location module Fc.Location.Series +let [] Category = "LocationSeries" +let streamName locationId = FsCodec.StreamName.create Category (LocationId.toString locationId) + // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care [] module Events = - let [] CategoryId = "LocationSeries" - let (|For|) locationId = FsCodec.StreamName.create CategoryId (LocationId.toString locationId) - type Started = { epoch : LocationEpochId } type Event = | Started of Started @@ -27,9 +27,7 @@ let interpretAdvanceIngestionEpoch (epochId : LocationEpochId) (state : Fold.Sta [if state |> Option.forall (fun s -> s < epochId) then yield Events.Started { epoch = epochId }] -type Service internal (log, resolve, maxAttempts) = - - let resolve (Events.For id) = Equinox.Stream(log, resolve id, maxAttempts) +type Service internal (resolve : LocationId -> Equinox.Stream) = member __.TryReadIngestionEpoch(locationId) : Async = let stream = resolve locationId @@ -39,7 +37,11 @@ type Service internal (log, resolve, maxAttempts) = let stream = resolve locationId stream.Transact(interpretAdvanceIngestionEpoch epochId) -let create resolve maxAttempts = Service(Serilog.Log.ForContext(), resolve, maxAttempts) +let create resolver maxAttempts = + let resolve locId = + let stream = resolver (streamName locId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = maxAttempts) + Service (resolve) module Cosmos = diff --git a/equinox-fc/Watchdog/Handler.fs b/equinox-fc/Watchdog/Handler.fs index 908923a04..b96deb7a3 100644 --- a/equinox-fc/Watchdog/Handler.fs +++ b/equinox-fc/Watchdog/Handler.fs @@ -22,18 +22,10 @@ type Stats(log, ?statsInterval, ?stateInterval) = open Fc.Inventory.Transaction -let fold : Watchdog.Events.TimestampAndEvent seq -> Watchdog.Fold.State = - Watchdog.Fold.fold Watchdog.Fold.initial - -let (|FoldToWatchdogState|) (span : Propulsion.Streams.StreamSpan<_>) : Watchdog.Fold.State = - span.events - |> Seq.choose Watchdog.Events.codec.TryDecode - |> fold - let tryHandle driveTransaction (stream, span : Propulsion.Streams.StreamSpan<_>) : Async = async { let processingStuckCutoff = let now = DateTimeOffset.UtcNow in now.AddSeconds -10. - match stream, span with - | FsCodec.StreamName.CategoryAndId (Events.CategoryId, InventoryTransactionId.Parse transId), FoldToWatchdogState state -> + match stream, span.events with + | Watchdog.Match (transId, state) -> match Watchdog.categorize processingStuckCutoff state with | Watchdog.Complete -> return Outcome.Completed diff --git a/equinox-fc/Watchdog/Program.fs b/equinox-fc/Watchdog/Program.fs index 15d6e5693..610f722a5 100644 --- a/equinox-fc/Watchdog/Program.fs +++ b/equinox-fc/Watchdog/Program.fs @@ -312,7 +312,7 @@ module EventStoreContext = | e when not e.IsJson || e.EventStreamId.StartsWith "$" || not (isWhitelisted e.EventStreamId) -> None | PropulsionStreamEvent e -> Some e -let transactionStreamPrefix = sprintf "%s-" Fc.Inventory.Transaction.Events.CategoryId +let transactionStreamPrefix = sprintf "%s-" Fc.Inventory.Transaction.Category let isTransactionStream : string -> bool = function sn -> sn.StartsWith transactionStreamPrefix let build (args : CmdParser.Arguments) = @@ -355,8 +355,8 @@ let build (args : CmdParser.Arguments) = let locations = let zeroBalance : Fc.Location.Epoch.Events.CarriedForward = { initial = 0; recentTransactions = [||] } let chooseTransactionIds = function - | Fc.Location.Epoch.Fold.Init { recentTransactions = ids } -> Seq.ofArray ids - | Fc.Location.Epoch.Fold.Step { id = id } -> Seq.singleton id + | Fc.Location.Epoch.Fold.Init { recentTransactions = ids } -> Seq.ofArray ids + | Fc.Location.Epoch.Fold.Step { id = id } -> Seq.singleton id let toBalanceCarriedForward (Fc.Location.Epoch.Fold.Current cur as records) : Fc.Location.Epoch.Events.CarriedForward = { initial = cur; recentTransactions = records |> Seq.collect chooseTransactionIds |> Seq.truncate 5 |> Seq.toArray } let shouldClose x = false From e73d6f353f40e517e68bfb6fe1574b73211a1fba Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Tue, 10 Mar 2020 13:24:04 +0000 Subject: [PATCH 39/45] Stragglers --- equinox-fc/Domain.Tests/LocationTests.fs | 8 ++++---- equinox-fc/Domain/InventoryEpoch.fs | 10 +++++----- equinox-fc/Domain/InventorySeries.fs | 4 ++-- equinox-fc/Domain/InventoryTransaction.fs | 4 ++-- equinox-fc/Domain/LocationEpoch.fs | 8 ++++---- equinox-fc/Domain/LocationSeries.fs | 8 ++++---- 6 files changed, 21 insertions(+), 21 deletions(-) diff --git a/equinox-fc/Domain.Tests/LocationTests.fs b/equinox-fc/Domain.Tests/LocationTests.fs index 536505c57..7e2217f7d 100644 --- a/equinox-fc/Domain.Tests/LocationTests.fs +++ b/equinox-fc/Domain.Tests/LocationTests.fs @@ -15,16 +15,16 @@ module Location = module Series = - let resolve store = Resolver(store, Series.Events.codec, Series.Fold.fold, Series.Fold.initial).Resolve + let resolver store = Resolver(store, Series.Events.codec, Series.Fold.fold, Series.Fold.initial).Resolve module Epoch = - let resolve store = Resolver(store, Epoch.Events.codec, Epoch.Fold.fold, Epoch.Fold.initial).Resolve + let resolver store = Resolver(store, Epoch.Events.codec, Epoch.Fold.fold, Epoch.Fold.initial).Resolve let createService (zeroBalance, shouldClose) store = let maxAttempts = Int32.MaxValue - let series = Series.create (Series.resolve store) maxAttempts - let epochs = Epoch.create (Epoch.resolve store) maxAttempts + let series = Series.create (Series.resolver store) maxAttempts + let epochs = Epoch.create (Epoch.resolver store) maxAttempts create (zeroBalance, shouldClose) (series, epochs) let run (service : Location.Service) (IdsAtLeastOne locations, deltas : _[], transactionId) = Async.RunSynchronously <| async { diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index 74d5b6d50..9942b5f2e 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -82,15 +82,15 @@ type Service internal (resolve : InventoryId * InventoryEpochId -> Equinox.Strea stream.Transact(decideSync capacity events) let create resolver = - let resolve locationId = - let stream = resolver (streamName locationId) + let resolve ids = + let stream = resolver (streamName ids) Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) - Service (resolve) + Service(resolve) module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) - let resolve (context, cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let create (context, cache) = create (resolve (context, cache)) + let create (context, cache) = create (resolver (context, cache)) diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index a93f5a67d..011f24fee 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -49,7 +49,7 @@ let create resolver = module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent - let resolve (context, cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // For this stream, we uniformly use stale reads as: // a) we don't require any information from competing writers @@ -57,4 +57,4 @@ module Cosmos = let opt = Equinox.ResolveOption.AllowStale fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) let create (context, cache) = - create (resolve (context, cache)) + create (resolver (context, cache)) diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index ecb9acbc1..a6f8d5bf3 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -148,10 +148,10 @@ module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.Unoptimized // ... and there will generally be a single actor touching it at a given time, so we don't need to do a load (which would be more expensive than normal given the `accessStrategy`) before we sync let opt = Equinox.AllowStale - let resolve (context, cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) - let createService (context, cache) = create (resolve (context, cache)) + let createService (context, cache) = create (resolver (context, cache)) /// Handles requirement to infer when a transaction is 'stuck' /// Note we don't want to couple to the state in a deep manner; thus we track: diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index a356c6a79..330e3dd2d 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -134,16 +134,16 @@ type Service internal (resolve : LocationId * LocationEpochId -> Equinox.Stream< stream.Transact(sync prevEpochBalanceCarriedForward decide shouldClose) let create resolver maxAttempts = - let resolve locId = - let stream = resolver (streamName locId) + let resolve locationId = + let stream = resolver (streamName locationId) Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = maxAttempts) Service (resolve) module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.Unoptimized - let resolve (context, cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve let create (context, cache, maxAttempts) = - create (resolve (context, cache)) maxAttempts + create (resolver (context, cache)) maxAttempts diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index 35c77707f..e113a7c67 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -38,8 +38,8 @@ type Service internal (resolve : LocationId -> Equinox.Stream(), stream, maxAttempts = maxAttempts) Service (resolve) @@ -47,9 +47,9 @@ module Cosmos = open Equinox.Cosmos - let resolve (context, cache) = + let resolver (context, cache) = let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) let opt = Equinox.ResolveOption.AllowStale fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id, opt) let createService (context, cache, maxAttempts) = - create (resolve (context, cache)) maxAttempts + create (resolver (context, cache)) maxAttempts From e236bcd5fcd18cbf29506b4f51a9c5378576e190 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sat, 30 Nov 2019 00:44:05 +0000 Subject: [PATCH 40/45] Allocation example from Equinox 174 --- equinox-fc/Domain.Tests/AllocationTests.fs | 10 + equinox-fc/Domain.Tests/AllocatorTests.fs | 59 +++++ equinox-fc/Domain.Tests/Domain.Tests.fsproj | 4 + equinox-fc/Domain.Tests/TicketListTests.fs | 45 ++++ equinox-fc/Domain.Tests/TicketTests.fs | 82 +++++++ equinox-fc/Domain/Allocation.fs | 254 ++++++++++++++++++++ equinox-fc/Domain/Allocator.fs | 78 ++++++ equinox-fc/Domain/Domain.fsproj | 6 + equinox-fc/Domain/Infrastructure.fs | 28 +++ equinox-fc/Domain/ListAllocation.fs | 22 ++ equinox-fc/Domain/Ticket.fs | 85 +++++++ equinox-fc/Domain/TicketList.fs | 67 ++++++ 12 files changed, 740 insertions(+) create mode 100644 equinox-fc/Domain.Tests/AllocationTests.fs create mode 100644 equinox-fc/Domain.Tests/AllocatorTests.fs create mode 100644 equinox-fc/Domain.Tests/TicketListTests.fs create mode 100644 equinox-fc/Domain.Tests/TicketTests.fs create mode 100644 equinox-fc/Domain/Allocation.fs create mode 100644 equinox-fc/Domain/Allocator.fs create mode 100644 equinox-fc/Domain/ListAllocation.fs create mode 100644 equinox-fc/Domain/Ticket.fs create mode 100644 equinox-fc/Domain/TicketList.fs diff --git a/equinox-fc/Domain.Tests/AllocationTests.fs b/equinox-fc/Domain.Tests/AllocationTests.fs new file mode 100644 index 000000000..f6c92ff1c --- /dev/null +++ b/equinox-fc/Domain.Tests/AllocationTests.fs @@ -0,0 +1,10 @@ +module AllocationTests + +open Allocation +open FsCheck.Xunit +open Swensen.Unquote + +let [] ``codec can roundtrip`` event = + let ee = Events.codec.Encode(None,event) + let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) + test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/AllocatorTests.fs b/equinox-fc/Domain.Tests/AllocatorTests.fs new file mode 100644 index 000000000..fddfe5183 --- /dev/null +++ b/equinox-fc/Domain.Tests/AllocatorTests.fs @@ -0,0 +1,59 @@ +module AllocatorTests + +open Allocator +open FsCheck.Xunit +open Swensen.Unquote +open System + +type Command = + | Commence of AllocationId * DateTimeOffset + | Complete of AllocationId * Events.Reason + +type Result = + | Accepted + | Conflict of AllocationId + +let execute cmd state = + match cmd with + | Commence (a,c) -> + match decideCommence a c state with + | CommenceResult.Accepted, es -> Accepted,es + | CommenceResult.Conflict a, es -> Conflict a,es + | Complete (a,r) -> let es = decideComplete a r state in Accepted, es + +let [] properties c1 c2 = + let res,events = execute c1 Folds.initial + let state1 = Folds.fold Folds.initial events + match c1, res, events, state1 with + | Commence (a,c), Accepted, [Events.Commenced ({ allocationId = ea; cutoff = ec } as e)], state -> + test <@ a = ea && c = ec && state = Some e @> + | Complete _, Accepted, [], None -> + () // Non-applicable Complete requests are simply ignored + | _, res, l, _ -> + test <@ List.isEmpty l && res = Accepted @> + + let res,events = execute c2 state1 + let state2 = Folds.fold state1 events + match state1, c2, res, events, state2 with + // As per above, normal commence + | None, Commence (a,c), Accepted, [Events.Commenced ({ allocationId = ea; cutoff = ec } as e)], state -> + test <@ a = ea && c = ec && state = Some e @> + // Idempotent accept if same allocationId + | Some active as s1, Commence (a,_), Accepted, [], s2 -> + test <@ s1 = s2 && active.allocationId = a @> + // Conflict reports owner allocator + | Some active as s1, Commence (a2,_), Conflict a1, [], s2 -> + test <@ s1 = s2 && a2 <> a1 && a1 = active.allocationId @> + // Correct complete for same allocator is accepted + | Some active, Complete (a,r), Accepted, [Events.Completed { allocationId = ea; reason = er }], None -> + test <@ er = r && ea = a && active.allocationId = a @> + // Completes not for the same allocator are ignored + | Some active as s1, Complete (a,_), Accepted, [], s2 -> + test <@ active.allocationId <> a && s2 = s1 @> + | _, _, res, l, _ -> + test <@ List.isEmpty l && res = Accepted @> + +let [] ``codec can roundtrip`` event = + let ee = Events.codec.Encode(None,event) + let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) + test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/Domain.Tests.fsproj b/equinox-fc/Domain.Tests/Domain.Tests.fsproj index a8213b6eb..76190995d 100644 --- a/equinox-fc/Domain.Tests/Domain.Tests.fsproj +++ b/equinox-fc/Domain.Tests/Domain.Tests.fsproj @@ -12,6 +12,10 @@ + + + + diff --git a/equinox-fc/Domain.Tests/TicketListTests.fs b/equinox-fc/Domain.Tests/TicketListTests.fs new file mode 100644 index 000000000..c2d8ea059 --- /dev/null +++ b/equinox-fc/Domain.Tests/TicketListTests.fs @@ -0,0 +1,45 @@ +module TicketListTests + +open FsCheck.Xunit +open Swensen.Unquote +open TicketList + +let [] properties c1 c2 = + let events = interpret c1 Folds.initial + let state1 = Folds.fold Folds.initial events + match c1, events, state1 with + // Empty request -> no Event + | (_,[]), [], state -> + test <@ Set.isEmpty state @> + | (a,t), [Events.Allocated { allocatorId = ea; ticketIds = et }], state -> + test <@ a = ea @> + test <@ state = set t @> + test <@ state = set et @> + | _, l, _ -> + test <@ List.isEmpty l @> + + let events = interpret c2 state1 + let state2 = Folds.fold state1 events + test <@ Folds.fold state2 [Folds.snapshot state2] = state2 @> + match state1, c2, events, state2 with + // Empty request -> no Event, same state + | s1, (_,[]), [], state -> + test <@ state = s1 @> + // Redundant request -> No Event, same state + | s1, (_,t), [], _ -> + test <@ Set.isSuperset s1 (set t) @> + // Two consecutive commands should both manifest in the state + | s1, (a,t), [Events.Allocated { allocatorId = ea; ticketIds = et }], state -> + test <@ a = ea @> + let et = Set et + test <@ Set.isSuperset (set t) et @> + test <@ Set.intersect s1 et |> Set.isEmpty @> + test <@ Set.isSuperset state s1 @> + test <@ Set.isSuperset state et @> + | _, _, l, _ -> + test <@ List.isEmpty l @> + +let [] ``codec can roundtrip`` event = + let ee = Events.codec.Encode(None,event) + let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) + test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/TicketTests.fs b/equinox-fc/Domain.Tests/TicketTests.fs new file mode 100644 index 000000000..32179871a --- /dev/null +++ b/equinox-fc/Domain.Tests/TicketTests.fs @@ -0,0 +1,82 @@ +module TicketTests + +open FsCheck.Xunit +open Swensen.Unquote +open Ticket +open Ticket.Folds + +/// We want to generate Allocate requests with and without the same listId in some cases +let (|MaybeSameCommands|) = function + | Allocate _ as x, Allocate _, cmd3, Choice1Of2 () -> x, x, cmd3 + | cmd1, (Allocate _ as x), Allocate _, Choice1Of2 () -> cmd1, x, x + | cmd1, cmd2, cmd3, (Choice1Of2 ()|Choice2Of2 ()) -> cmd1, cmd2, cmd3 + +/// Explicitly generate sequences with the same allocator running twice or three times +let (|MaybeSameIds|) = function + | Choice1Of4 a -> a, a, a + | Choice2Of4 (a,b) -> a, a, b + | Choice3Of4 (a,b) -> a, b, b + | Choice4Of4 (a,b,c) -> a, b, c + +let (|Invariants|) = function + // Revokes always succeed iff Unallocated + | Unallocated, Revoke, true, [], Unallocated -> + () + // Everything else fails + | _, _, res, e, _ -> + test <@ not res && List.isEmpty e @> + +let (|ReservedCases|_|) allocator = function + // Reserve given unallocated + | Unallocated, Reserve, true, [Events.Reserved { allocatorId = a }], state -> + test <@ a = allocator && state = Reserved a @> + Some () + // Idempotent reserve request + | Reserved a, Reserve, true, [], _ -> + test <@ a = allocator @> + Some () + // Revokes not by the owner are reported as successful, but we force the real owner to do the real relinquish + | (Reserved by | Allocated(by,_)), Revoke, true, [], _ -> + test <@ by <> allocator @> + Some () + // Revokes succeed iff by the owner + | (Reserved by | Allocated(by,_)), Revoke, true, [Events.Revoked], Unallocated -> + test <@ by = allocator @> + Some () + // Reservations can transition to Allocations as long as it's the same Allocator requesting + | Reserved a, Allocate l, true, [Events.Allocated { allocatorId = ea; listId = el }], Allocated (sa,sl) -> + test <@ a = allocator && a = ea && a = sa && l = el && l = sl @> + Some() + | _ -> None + +let [] properties (MaybeSameIds (a1,a2,a3)) (MaybeSameCommands (c1,c2,c3)) = + let res, events = decide a1 c1 Folds.initial + let state1 = Folds.fold Folds.initial events + + match Folds.initial, c1, res, events, state1 with + | _, Reserve, true, [Events.Reserved { allocatorId = a }], Reserved sa -> + test <@ a = a1 && sa = a1 @> + | Invariants -> () + + let res, events = decide a2 c2 state1 + let state2 = Folds.fold state1 events + match state1, c2, res, events, state2 with + | ReservedCases a2 -> () + | Invariants -> () + + let res, events = decide a3 c3 state2 + let state3 = Folds.fold state2 events + match state2, c3, res, events, state3 with + // Idempotent allocate ignore + | Allocated (a,l), Allocate l3, true, [], _ -> + test <@ a = a3 && l = l3 @> + // Allocated -> Revoked + | Allocated (a,_), Revoke, true, [Events.Revoked], Unallocated -> + test <@ a = a3 @> + | ReservedCases a3 -> () + | Invariants -> () + +let [] ``codec can roundtrip`` event = + let ee = Events.codec.Encode(None,event) + let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) + test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain/Allocation.fs b/equinox-fc/Domain/Allocation.fs new file mode 100644 index 000000000..c13676ec0 --- /dev/null +++ b/equinox-fc/Domain/Allocation.fs @@ -0,0 +1,254 @@ +module Allocation + +let [] Category = "Allocation" +let streamName allocationId = FsCodec.StreamName.create Category (AllocationId.toString allocationId) + +// NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +module Events = + + type Commenced = { ticketIds : TicketId[] } + type Tickets = { ticketIds : TicketId[] } + type Allocated = { ticketIds : TicketId[]; listId : TicketListId } + type Assigned = { listId : TicketListId } + type Snapshotted = { ticketIds : TicketId[] } + type Event = + /// Records full set of targets (so Abort can Revoke all potential in flight Reservations) + | Commenced of Commenced + /// Tickets verified as not being attainable (Allocated, not just Reserved) + | Failed of Tickets + /// Tickets verified as having been marked Reserved + | Reserved of Tickets + /// Confirming cited tickets are to be allocated to the cited list + | Allocated of Allocated + /// Records intention to release cited tickets (while Running, not implicitly via Aborted) + | Released of Tickets + /// Transitioning to phase where (Commenced-Allocated) get Returned by performing Releases on the Tickets + | Cancelled + /// Confirming cited tickets have been assigned to the list + | Assigned of Assigned + /// Records confirmed Revokes of cited Tickets + | Revoked of Tickets + /// Allocated + Returned = Commenced ==> Open for a new Commenced to happen + | Completed + // Dummy event to make Equinox.EventStore happy (see `module EventStore`) + | Snapshotted + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + +module Fold = + + type State = NotStarted | Running of States | Canceling of States | Completed + and States = + { unknown : Set + failed : Set + reserved : Set + assigning : Events.Allocated list + releasing : Set + stats : Stats } + and Stats = + { requested : int + denied : int + reserved : int + releasing : int + assigned : int list } + let (|Idle|Acquiring|Releasing|) = function NotStarted | Completed -> Idle | Running s -> Acquiring s | Canceling s -> Releasing s + module States = + let (|ToSet|) = set + let private withKnown xs x = { x with unknown = Set.difference x.unknown xs } + let withFailed (ToSet xs) x = { withKnown xs x with failed = x.failed |> Set.union xs } + let withReserved (ToSet xs) x = { withKnown xs x with reserved = x.reserved |> Set.union xs } + let withRevoked (ToSet xs) x = { withKnown xs x with reserved = Set.difference x.reserved xs } + let withReleasing (ToSet xs) x ={ withKnown xs x with releasing = x.releasing |> Set.union xs } // TODO + let withAssigned listId x = // TODO + let decided,remaining = x.assigning |> List.partition (fun x -> x.listId = listId) + let xs = seq { for x in decided do yield! x.ticketIds } + { withRevoked xs x with assigning = remaining } + let initial = NotStarted + let evolve state = function + | Events.Commenced e -> + match state with + | NotStarted -> Running { unknown = set e.ticketIds; failed = Set.empty; reserved = Set.empty; assigning = []; releasing = Set.empty + stats = { requested = 0; denied = 0; reserved = 0; releasing = 0; assigned = [] } } + | x -> failwithf "Can only Commence when NotStarted, not %A" x + | Events.Failed e -> + match state with + | Idle -> failwith "Cannot have Failed if Idle" + | Acquiring s -> Running (s |> States.withFailed e.ticketIds) + | Releasing s -> Canceling (s |> States.withFailed e.ticketIds) + | Events.Reserved e -> + match state with + | Idle -> failwith "Cannot have Reserved if Idle" + | Acquiring s -> Running (s |> States.withReserved e.ticketIds) + | Releasing s -> Canceling (s |> States.withReserved e.ticketIds) + | Events.Allocated e -> + match state with + | Idle -> failwith "Cannot have Allocating if Idle" + | Acquiring s -> Running { s with assigning = e :: s.assigning} + | Releasing s -> Canceling { s with assigning = e :: s.assigning} + | Events.Released e -> + match state with + | Idle -> failwith "Cannot have Releasing if Idle" + | Acquiring s -> Running (s |> States.withReleasing e.ticketIds) + | Releasing s -> Canceling (s |> States.withReleasing e.ticketIds) + | Events.Cancelled -> + match state with + | Acquiring s -> Canceling s + | x -> failwithf "Can only Abort when Running, not %A" x + | Events.Assigned e -> + match state with + | Idle -> failwith "Cannot have Allocated if Idle" + | Acquiring s -> Running (s |> States.withAssigned e.listId) + | Releasing s -> Canceling (s |> States.withAssigned e.listId) + | Events.Revoked e -> + match state with + | Idle -> failwith "Cannot have Released if Idle" + | Acquiring s -> Running (s |> States.withRevoked e.ticketIds) + | Releasing s -> Canceling (s |> States.withRevoked e.ticketIds) + | Events.Completed -> + match state with + | Acquiring s + | Releasing s when Set.isEmpty s.unknown && Set.isEmpty s.reserved && List.isEmpty s.assigning -> + Completed + | x -> failwithf "Can only Complete when reservations and unknowns resolved, not %A" x + | Events.Snapshotted -> state // Dummy event, see EventStore bindings + let fold : State -> Events.Event seq -> State = Seq.fold evolve + let isOrigin = function Events.Completed -> true | Events.Snapshotted | _ -> false + +/// Current state of the workflow based on the present state of the Aggregate +type ProcessState = + | NotStarted + | Running of reserved : TicketId list * toAssign : Events.Allocated list * toRelease : TicketId list * toReserve : TicketId list + | Idle of reserved : TicketId list + | Cancelling of toAssign : Events.Allocated list * toRelease : TicketId list + | Completed + static member FromFoldState = function + | Fold.NotStarted -> + NotStarted + | Fold.Running e -> + match Set.toList e.reserved, e.assigning, Set.toList e.releasing, Set.toList e.unknown with + | res, [], [], [] -> + Idle (reserved = res) + | res, ass, rel, tor -> + Running (reserved = res, toAssign = ass, toRelease = rel, toReserve = tor) + | Fold.Canceling e -> + Cancelling (toAssign = e.assigning, toRelease = [yield! e.reserved; yield! e.unknown; yield! e.releasing]) + | Fold.Completed -> + Completed + +/// Updates recording attained progress +type Update = + | Failed of tickets : TicketId list + | Reserved of tickets : TicketId list + | Assigned of listId : TicketListId + | Revoked of tickets : TicketId list + +let (|ToSet|) xs = set xs +let (|SetEmpty|_|) s = if Set.isEmpty s then Some () else None + +/// Map processed work to associated events that are to be recorded in the stream +let decideUpdate update state = + let owned (s : Fold.States) = Set.union s.releasing (set <| seq { yield! s.unknown; yield! s.reserved }) + match state, update with + | (Fold.Completed | Fold.NotStarted), (Failed _|Reserved _|Assigned _|Revoked _) as x -> + failwithf "Folds.Completed or NotStarted cannot handle (Failed|Revoked|Assigned) %A" x + | (Fold.Running s|Fold.Canceling s), Reserved (ToSet xs) -> + match set s.unknown |> Set.intersect xs with SetEmpty -> [] | changed -> [Events.Reserved { ticketIds = Set.toArray changed }] + | (Fold.Running s|Fold.Canceling s), Failed (ToSet xs) -> + match owned s |> Set.intersect xs with SetEmpty -> [] | changed -> [Events.Failed { ticketIds = Set.toArray changed }] + | (Fold.Running s|Fold.Canceling s), Revoked (ToSet xs) -> + match owned s |> Set.intersect xs with SetEmpty -> [] | changed -> [Events.Revoked { ticketIds = Set.toArray changed }] + | (Fold.Running s|Fold.Canceling s), Assigned listId -> + if s.assigning |> List.exists (fun x -> x.listId = listId) then [Events.Assigned { listId = listId }] else [] + +/// Holds events accumulated from a series of decisions while also evolving the presented `state` to reflect the pended events +type private Accumulator() = + let acc = ResizeArray() + member __.Ingest state : 'res * Events.Event list -> 'res * Fold.State = function + | res, [] -> res,state + | res, [e] -> acc.Add e; res,Fold.evolve state e + | res, xs -> acc.AddRange xs; res,Fold.fold state (Seq.ofList xs) + member __.Accumulated = List.ofSeq acc + +/// Impetus provided to the Aggregate Service from the Process Manager +type Command = + | Commence of tickets : TicketId list + | Apply of assign : Events.Allocated list * release : TicketId list + | Cancel + +/// Apply updates, decide whether Command is applicable, emit state reflecting work to be completed to conclude the in-progress workflow (if any) +let sync (updates : Update seq, command : Command) (state : Fold.State) : (bool*ProcessState) * Events.Event list = + let acc = Accumulator() + + (* Apply any updates *) + let mutable state = state + for x in updates do + let (),state' = acc.Ingest state ((),decideUpdate x state) + state <- state' + + (* Decide whether the Command is now acceptable *) + let accepted,state = + acc.Ingest state <| + match state, command with + (* Ignore on the basis of being idempotent in the face of retries *) + // TOCONSIDER how to represent that a request is being denied e.g. due to timeout vs due to being complete + | (Fold.Idle | Fold.Releasing _), Apply _ -> + false, [] + (* Defer; Need to allow current request to progress before it can be considered *) + | (Fold.Acquiring _ | Fold.Releasing _), Commence _ -> + true, [] // TODO validate idempotent ? + (* Ok on the basis of idempotency *) + | (Fold.Idle | Fold.Releasing _), Cancel -> + true, [] + (* Ok; Currently idle, normal Commence request*) + | Fold.Idle, Commence tickets -> + true,[Events.Commenced { ticketIds = Array.ofList tickets }] + (* Ok; normal apply to distribute held tickets *) + | Fold.Acquiring s, Apply (assign,release) -> + let avail = System.Collections.Generic.HashSet s.reserved + let toAssign = [for a in assign -> { a with ticketIds = a.ticketIds |> Array.where avail.Remove }] + let toRelease = (Set.empty,release) ||> List.fold (fun s x -> if avail.Remove x then Set.add x s else s) + true, [ + for x in toAssign do if (not << Array.isEmpty) x.ticketIds then yield Events.Allocated x + match toRelease with SetEmpty -> () | toRelease -> yield Events.Released { ticketIds = Set.toArray toRelease }] + (* Ok, normal Cancel *) + | Fold.Acquiring _, Cancel -> + true, [Events.Cancelled] + + (* Yield outstanding processing requirements (if any), together with events accumulated based on the `updates` *) + (accepted, ProcessState.FromFoldState state), acc.Accumulated + +type Service internal (resolve : AllocationId -> Equinox.Stream) = + + member __.Sync(allocationId,updates,command) : Async = + let stream = resolve allocationId + stream.Transact(sync (updates,command)) + +let create resolver = + let resolve pickListId = + let stream = resolver (streamName pickListId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) + Service (resolve) + +module EventStore = + + let resolver (context,cache) = + let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale + // We should be reaching Completed state frequently so no actual Snapshots should get written + fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy).Resolve(id,opt) + let create (context,cache) = + create (resolver (context,cache)) + +module Cosmos = + + let resolver (context,cache) = + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale + // TODO impl snapshots + let makeEmptyUnfolds events _state = events,[] + let accessStrategy = Equinox.Cosmos.AccessStrategy.Custom (Fold.isOrigin,makeEmptyUnfolds) + fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) + let create (context,cache) = + create (resolver (context, cache)) \ No newline at end of file diff --git a/equinox-fc/Domain/Allocator.fs b/equinox-fc/Domain/Allocator.fs new file mode 100644 index 000000000..c4ba63dbf --- /dev/null +++ b/equinox-fc/Domain/Allocator.fs @@ -0,0 +1,78 @@ +module Allocator + +open System + +let [] Category = "Allocator" +let streamName allocatorId = FsCodec.StreamName.create Category (AllocatorId.toString allocatorId) + +// NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +module Events = + + type Commenced = { allocationId : AllocationId; cutoff : DateTimeOffset } + type Completed = { allocationId : AllocationId; reason : Reason } + and [)>] + Reason = Ok | TimedOut | Cancelled + type Snapshotted = { active : Commenced option } + type Event = + | Commenced of Commenced + | Completed of Completed + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + +module Fold = + + type State = Events.Commenced option + let initial = None + let evolve _state = function + | Events.Commenced e -> Some e + | Events.Completed _ -> None + let fold : State -> Events.Event seq -> State = Seq.fold evolve + +type CommenceResult = Accepted | Conflict of AllocationId + +let decideCommence allocationId cutoff : Fold.State -> CommenceResult*Events.Event list = function + | None -> Accepted, [Events.Commenced { allocationId = allocationId; cutoff = cutoff }] + | Some { allocationId = tid } when allocationId = tid -> Accepted, [] // Accept replay idempotently + | Some curr -> Conflict curr.allocationId, [] // Reject attempts at commencing overlapping transactions + +let decideComplete allocationId reason : Fold.State -> Events.Event list = function + | Some { allocationId = tid } when allocationId = tid -> [Events.Completed { allocationId = allocationId; reason = reason }] + | Some _ | None -> [] // Assume replay; accept but don't write + +type Service internal (resolve : AllocatorId -> Equinox.Stream) = + + member __.Commence(allocatorId, allocationId, cutoff) : Async = + let stream = resolve allocatorId + stream.Transact(decideCommence allocationId cutoff) + + member __.Complete(allocatorId, allocationId, reason) : Async = + let stream = resolve allocatorId + stream.Transact(decideComplete allocationId reason) + +let create resolver = + let resolve pickListId = + let stream = resolver (streamName pickListId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) + Service (resolve) + +module EventStore = + + let accessStrategy = Equinox.EventStore.AccessStrategy.LatestKnownEvent + let resolver (context,cache) = + let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale + fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) + let create (context,cache) = + create (resolver (context,cache)) + +module Cosmos = + + let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent + let resolver (context,cache) = + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale + fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) + let create (context,cache) = + create (resolver (context,cache)) diff --git a/equinox-fc/Domain/Domain.fsproj b/equinox-fc/Domain/Domain.fsproj index 9e1499c82..a443df179 100644 --- a/equinox-fc/Domain/Domain.fsproj +++ b/equinox-fc/Domain/Domain.fsproj @@ -15,9 +15,15 @@ + + + + + + diff --git a/equinox-fc/Domain/Infrastructure.fs b/equinox-fc/Domain/Infrastructure.fs index 2f41917e5..4c263fab8 100644 --- a/equinox-fc/Domain/Infrastructure.fs +++ b/equinox-fc/Domain/Infrastructure.fs @@ -2,6 +2,8 @@ namespace global open FSharp.UMX // see https://github.com/fsprojects/FSharp.UMX - % operator and ability to apply units of measure to Guids+strings +(* Locations *) + type LocationId = string and [] locationId module LocationId = @@ -34,3 +36,29 @@ module InventoryTransactionId = let parse (value : string) : InventoryTransactionId = %value let (|Parse|) = parse let toString (value : InventoryTransactionId) : string = %value + +(* Tickets *) + +type TicketId = string +and [] ticketId +module TicketId = + let parse (value : string) : TicketId = let raw = value in %raw + let toString (value : TicketId) : string = %value + +type TicketListId = string +and [] ticketListId +module TicketListId = + let parse (value : string) : TicketListId = let raw = value in %raw + let toString (value : TicketListId) : string = %value + +type AllocationId = string +and [] allocationId +module AllocationId = + let parse (value : string) : AllocationId = let raw = value in %raw + let toString (value : AllocationId) : string = %value + +type AllocatorId = string +and [] allocatorId +module AllocatorId = + let parse (value : string) : AllocatorId = let raw = value in %raw + let toString (value : AllocatorId) : string = %value \ No newline at end of file diff --git a/equinox-fc/Domain/ListAllocation.fs b/equinox-fc/Domain/ListAllocation.fs new file mode 100644 index 000000000..51662d008 --- /dev/null +++ b/equinox-fc/Domain/ListAllocation.fs @@ -0,0 +1,22 @@ +module ListAllocation + +open System + +type Service(maxListLen, allocators : Allocator.Service, allocations : Allocation.Service, lists : TicketList.Service, tickets : Ticket.Service) = + + member __.Commence(allocatorId, allocationId, tickets, transactionTimeout) : Async<_> = async { + let cutoff = let now = DateTimeOffset.UtcNow in now.Add transactionTimeout + let! state = allocators.Commence(allocatorId, allocationId, cutoff) + // TODO cancel timed out conflicting work + let! (_,state) = allocations.Sync(allocationId, Seq.empty, Allocation.Commence tickets) + return state } + + member __.Read(allocationId) : Async<_> = async { + let! (_,state) = allocations.Sync(allocationId, Seq.empty, Allocation.Command.Apply ([],[])) + // TODO incorporate allocator state + return state } + + member __.Cancel(allocatorId,allocationId) : Async<_> = async { + let! (_,state) = allocations.Sync(allocationId, Seq.empty, Allocation.Command.Cancel) + // TODO propagate to allocator with reason + return state } diff --git a/equinox-fc/Domain/Ticket.fs b/equinox-fc/Domain/Ticket.fs new file mode 100644 index 000000000..46b918459 --- /dev/null +++ b/equinox-fc/Domain/Ticket.fs @@ -0,0 +1,85 @@ +module Ticket + +let [] Category = "Ticket" +let streamName ticketId = FsCodec.StreamName.create Category (TicketId.toString ticketId) + +// NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +module Events = + + type Reserved = { allocatorId : AllocatorId } + type Allocated = { allocatorId : AllocatorId; listId : TicketListId } + + type Event = + | Reserved of Reserved + | Allocated of Allocated + | Revoked + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + +module Fold = + + type State = Unallocated | Reserved of by : AllocatorId | Allocated of by : AllocatorId * on : TicketListId + let initial = Unallocated + let private evolve _state = function + | Events.Reserved e -> Reserved e.allocatorId + | Events.Allocated e -> Allocated (e.allocatorId, e.listId) + | Events.Revoked -> Unallocated + // because each event supersedes the previous one, we only ever need to fold the last event + let fold state events = + Seq.tryLast events |> Option.fold evolve state + +type Command = + /// permitted if nobody owns it (or idempotently ok if we are the owner) + | Reserve + /// permitted if the allocator has it reserved (or idempotently ok if already on list) + | Allocate of on : TicketListId + /// must be performed by the owner; attempts by non-owner to deallocate get ignored as a new owner now has that responsibility + /// (but are not failures from an Allocator's perspective) + | Revoke + +let decide (allocator : AllocatorId) (command : Command) (state : Fold.State) : bool * Events.Event list = + match command, state with + | Reserve, Fold.Unallocated -> true,[Events.Reserved { allocatorId = allocator }] // normal case -> allow+record + | Reserve, Fold.Reserved by when by = allocator -> true,[] // idempotently permit + | Reserve, (Fold.Reserved _ | Fold.Allocated _) -> false,[] // report failure, nothing to write + | Allocate list, Fold.Allocated (by,l) when by = allocator && l = list -> true,[] // idempotent processing + | Allocate list, Fold.Reserved by when by = allocator -> true,[Events.Allocated { allocatorId = allocator; listId = list }] // normal + | Allocate _, (Fold.Allocated _ | Fold.Unallocated | Fold.Reserved _) -> false,[] // Fail if someone else has reserved or allocated, or we are jumping straight to Allocated without Reserving first + | Revoke, Fold.Unallocated -> true,[] // idempotent handling + | Revoke, (Fold.Reserved by | Fold.Allocated (by,_)) when by = allocator -> true,[Events.Revoked] // release Reservation or Allocation + | Revoke, (Fold.Reserved _ | Fold.Allocated _ ) -> true,[] // NOTE we report success of achieving the intent (but, critically, we leave it to the actual owner to manage any actual revoke) + +type Service internal (resolve : TicketId -> Equinox.Stream) = + + /// Attempts to achieve the intent represented by `command`. High level semantics as per comments on Command (see decide for lowdown) + /// `false` is returned if a competing allocator holds it (or we're attempting to jump straight to Allocated without first Reserving) + member __.Sync(pickTicketId, allocator, command : Command) : Async = + let stream = resolve pickTicketId + stream.Transact(decide allocator command) + +let create resolver = + let resolve ticketId = + let stream = resolver (streamName ticketId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) + Service (resolve) + +module EventStore = + + let accessStrategy = Equinox.EventStore.AccessStrategy.LatestKnownEvent + let resolver (context,cache) = + let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // because we only ever need the last event, we use the Equinox.EventStore access strategy that optimizes around that + Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve + let create (context,cache)= + create (resolver (context, cache)) + +module Cosmos = + + let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent + let resolver (context,cache) = + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // because we only ever need the last event to build the state, we feed the events we are writing + // (there's always exactly one if we are writing), into the unfolds slot so a single point read with etag check gets us state in one trip + Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve + let create (context,cache) = + create (resolver (context, cache)) \ No newline at end of file diff --git a/equinox-fc/Domain/TicketList.fs b/equinox-fc/Domain/TicketList.fs new file mode 100644 index 000000000..72365bdbd --- /dev/null +++ b/equinox-fc/Domain/TicketList.fs @@ -0,0 +1,67 @@ +module TicketList + +let [] Category = "TicketList" +let streamName listId = FsCodec.StreamName.create Category (TicketListId.toString listId) + +// NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care +module Events = + + type Allocated = { allocatorId : AllocatorId; ticketIds : TicketId[] } + type Snapshotted = { ticketIds : TicketId[] } + type Event = + | Allocated of Allocated + | Snapshotted of Snapshotted + interface TypeShape.UnionContract.IUnionContract + let codec = FsCodec.NewtonsoftJson.Codec.Create() + +module Fold = + + type State = Set + let initial = Set.empty + let evolve state = function + | Events.Allocated e -> (state,e.ticketIds) ||> Array.fold (fun m x -> Set.add x m) + | Events.Snapshotted e -> Set.ofArray e.ticketIds + let fold : State -> Events.Event seq -> State = Seq.fold evolve + let isOrigin = function Events.Snapshotted _ -> true | Events.Allocated _ -> false + let snapshot state = Events.Snapshotted { ticketIds = Set.toArray state } + +let interpret (allocatorId : AllocatorId, allocated : TicketId list) (state : Fold.State) : Events.Event list = + match allocated |> Seq.except state |> Seq.distinct |> Seq.toArray with + | [||] -> [] + | news -> [Events.Allocated { allocatorId = allocatorId; ticketIds = news }] + +type Service internal (resolve : TicketListId -> Equinox.Stream) = + + member __.Sync(pickListId,allocatorId,assignedTickets) : Async = + let stream = resolve pickListId + stream.Transact(interpret (allocatorId,assignedTickets)) + +let create resolver = + let resolve pickListId = + let stream = resolver (streamName pickListId) + Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) + Service (resolve) + +module EventStore = + + let resolver (context,cache) = + let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong + let opt = Equinox.ResolveOption.AllowStale + // we _could_ use this Access Strategy, but because we are only generally doing a single shot write, its unwarranted + // let accessStrategy = AccessStrategy.RollingSnapshots (Folds.isOrigin,Folds.snapshot) + fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy).Resolve(id,opt) + let create (context,cache) = + create (resolver (context, cache)) + +module Cosmos = + + let resolver (context,cache) = + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong + let opt = Equinox.ResolveOption.AllowStale + // we want reads and writes (esp idempotent ones) to have optimal RU efficiency so we go the extra mile to do snapshotting into the Tip + let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) + fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) + let create (context,cache)= + create (resolver (context, cache)) \ No newline at end of file From 8bb5e6c7b84681c50d8a7c1768250af0396fcd84 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sat, 7 Dec 2019 10:17:40 +0000 Subject: [PATCH 41/45] Aggregate layout/naming consistency --- equinox-fc/Domain.Tests/AllocatorTests.fs | 30 +++++++++---------- equinox-fc/Domain.Tests/TicketListTests.fs | 20 ++++++------- equinox-fc/Domain.Tests/TicketTests.fs | 32 ++++++++++---------- equinox-fc/Domain/Allocation.fs | 34 +++++++++++----------- equinox-fc/Domain/Allocator.fs | 4 +-- equinox-fc/Domain/Ticket.fs | 22 +++++++------- equinox-fc/Domain/TicketList.fs | 12 ++++---- 7 files changed, 77 insertions(+), 77 deletions(-) diff --git a/equinox-fc/Domain.Tests/AllocatorTests.fs b/equinox-fc/Domain.Tests/AllocatorTests.fs index fddfe5183..bca6d2fb3 100644 --- a/equinox-fc/Domain.Tests/AllocatorTests.fs +++ b/equinox-fc/Domain.Tests/AllocatorTests.fs @@ -15,45 +15,45 @@ type Result = let execute cmd state = match cmd with - | Commence (a,c) -> + | Commence (a, c) -> match decideCommence a c state with - | CommenceResult.Accepted, es -> Accepted,es - | CommenceResult.Conflict a, es -> Conflict a,es - | Complete (a,r) -> let es = decideComplete a r state in Accepted, es + | CommenceResult.Accepted, es -> Accepted, es + | CommenceResult.Conflict a, es -> Conflict a, es + | Complete (a, r) -> let es = decideComplete a r state in Accepted, es let [] properties c1 c2 = - let res,events = execute c1 Folds.initial - let state1 = Folds.fold Folds.initial events + let res, events = execute c1 Fold.initial + let state1 = Fold.fold Fold.initial events match c1, res, events, state1 with - | Commence (a,c), Accepted, [Events.Commenced ({ allocationId = ea; cutoff = ec } as e)], state -> + | Commence (a, c), Accepted, [Events.Commenced ({ allocationId = ea; cutoff = ec } as e)], state -> test <@ a = ea && c = ec && state = Some e @> | Complete _, Accepted, [], None -> () // Non-applicable Complete requests are simply ignored | _, res, l, _ -> test <@ List.isEmpty l && res = Accepted @> - let res,events = execute c2 state1 - let state2 = Folds.fold state1 events + let res, events = execute c2 state1 + let state2 = Fold.fold state1 events match state1, c2, res, events, state2 with // As per above, normal commence - | None, Commence (a,c), Accepted, [Events.Commenced ({ allocationId = ea; cutoff = ec } as e)], state -> + | None, Commence (a, c), Accepted, [Events.Commenced ({ allocationId = ea; cutoff = ec } as e)], state -> test <@ a = ea && c = ec && state = Some e @> // Idempotent accept if same allocationId - | Some active as s1, Commence (a,_), Accepted, [], s2 -> + | Some active as s1, Commence (a, _), Accepted, [], s2 -> test <@ s1 = s2 && active.allocationId = a @> // Conflict reports owner allocator - | Some active as s1, Commence (a2,_), Conflict a1, [], s2 -> + | Some active as s1, Commence (a2, _), Conflict a1, [], s2 -> test <@ s1 = s2 && a2 <> a1 && a1 = active.allocationId @> // Correct complete for same allocator is accepted - | Some active, Complete (a,r), Accepted, [Events.Completed { allocationId = ea; reason = er }], None -> + | Some active, Complete (a, r), Accepted, [Events.Completed { allocationId = ea; reason = er }], None -> test <@ er = r && ea = a && active.allocationId = a @> // Completes not for the same allocator are ignored - | Some active as s1, Complete (a,_), Accepted, [], s2 -> + | Some active as s1, Complete (a, _), Accepted, [], s2 -> test <@ active.allocationId <> a && s2 = s1 @> | _, _, res, l, _ -> test <@ List.isEmpty l && res = Accepted @> let [] ``codec can roundtrip`` event = - let ee = Events.codec.Encode(None,event) + let ee = Events.codec.Encode(None, event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/TicketListTests.fs b/equinox-fc/Domain.Tests/TicketListTests.fs index c2d8ea059..5932f8805 100644 --- a/equinox-fc/Domain.Tests/TicketListTests.fs +++ b/equinox-fc/Domain.Tests/TicketListTests.fs @@ -5,13 +5,13 @@ open Swensen.Unquote open TicketList let [] properties c1 c2 = - let events = interpret c1 Folds.initial - let state1 = Folds.fold Folds.initial events + let events = interpret c1 Fold.initial + let state1 = Fold.fold Fold.initial events match c1, events, state1 with // Empty request -> no Event - | (_,[]), [], state -> + | (_, []), [], state -> test <@ Set.isEmpty state @> - | (a,t), [Events.Allocated { allocatorId = ea; ticketIds = et }], state -> + | (a, t), [Events.Allocated { allocatorId = ea; ticketIds = et }], state -> test <@ a = ea @> test <@ state = set t @> test <@ state = set et @> @@ -19,17 +19,17 @@ let [] properties c1 c2 = test <@ List.isEmpty l @> let events = interpret c2 state1 - let state2 = Folds.fold state1 events - test <@ Folds.fold state2 [Folds.snapshot state2] = state2 @> + let state2 = Fold.fold state1 events + test <@ Fold.fold state2 [Fold.snapshot state2] = state2 @> match state1, c2, events, state2 with // Empty request -> no Event, same state - | s1, (_,[]), [], state -> + | s1, (_, []), [], state -> test <@ state = s1 @> // Redundant request -> No Event, same state - | s1, (_,t), [], _ -> + | s1, (_, t), [], _ -> test <@ Set.isSuperset s1 (set t) @> // Two consecutive commands should both manifest in the state - | s1, (a,t), [Events.Allocated { allocatorId = ea; ticketIds = et }], state -> + | s1, (a, t), [Events.Allocated { allocatorId = ea; ticketIds = et }], state -> test <@ a = ea @> let et = Set et test <@ Set.isSuperset (set t) et @> @@ -40,6 +40,6 @@ let [] properties c1 c2 = test <@ List.isEmpty l @> let [] ``codec can roundtrip`` event = - let ee = Events.codec.Encode(None,event) + let ee = Events.codec.Encode(None, event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain.Tests/TicketTests.fs b/equinox-fc/Domain.Tests/TicketTests.fs index 32179871a..ffb05d87f 100644 --- a/equinox-fc/Domain.Tests/TicketTests.fs +++ b/equinox-fc/Domain.Tests/TicketTests.fs @@ -3,7 +3,7 @@ module TicketTests open FsCheck.Xunit open Swensen.Unquote open Ticket -open Ticket.Folds +open Ticket.Fold /// We want to generate Allocate requests with and without the same listId in some cases let (|MaybeSameCommands|) = function @@ -14,9 +14,9 @@ let (|MaybeSameCommands|) = function /// Explicitly generate sequences with the same allocator running twice or three times let (|MaybeSameIds|) = function | Choice1Of4 a -> a, a, a - | Choice2Of4 (a,b) -> a, a, b - | Choice3Of4 (a,b) -> a, b, b - | Choice4Of4 (a,b,c) -> a, b, c + | Choice2Of4 (a, b) -> a, a, b + | Choice3Of4 (a, b) -> a, b, b + | Choice4Of4 (a, b, c) -> a, b, c let (|Invariants|) = function // Revokes always succeed iff Unallocated @@ -36,47 +36,47 @@ let (|ReservedCases|_|) allocator = function test <@ a = allocator @> Some () // Revokes not by the owner are reported as successful, but we force the real owner to do the real relinquish - | (Reserved by | Allocated(by,_)), Revoke, true, [], _ -> + | (Reserved by | Allocated(by, _)), Revoke, true, [], _ -> test <@ by <> allocator @> Some () // Revokes succeed iff by the owner - | (Reserved by | Allocated(by,_)), Revoke, true, [Events.Revoked], Unallocated -> + | (Reserved by | Allocated(by, _)), Revoke, true, [Events.Revoked], Unallocated -> test <@ by = allocator @> Some () // Reservations can transition to Allocations as long as it's the same Allocator requesting - | Reserved a, Allocate l, true, [Events.Allocated { allocatorId = ea; listId = el }], Allocated (sa,sl) -> + | Reserved a, Allocate l, true, [Events.Allocated { allocatorId = ea; listId = el }], Allocated (sa, sl) -> test <@ a = allocator && a = ea && a = sa && l = el && l = sl @> Some() | _ -> None -let [] properties (MaybeSameIds (a1,a2,a3)) (MaybeSameCommands (c1,c2,c3)) = - let res, events = decide a1 c1 Folds.initial - let state1 = Folds.fold Folds.initial events +let [] properties (MaybeSameIds (a1, a2, a3)) (MaybeSameCommands (c1, c2, c3)) = + let res, events = decide a1 c1 Fold.initial + let state1 = Fold.fold Fold.initial events - match Folds.initial, c1, res, events, state1 with + match Fold.initial, c1, res, events, state1 with | _, Reserve, true, [Events.Reserved { allocatorId = a }], Reserved sa -> test <@ a = a1 && sa = a1 @> | Invariants -> () let res, events = decide a2 c2 state1 - let state2 = Folds.fold state1 events + let state2 = Fold.fold state1 events match state1, c2, res, events, state2 with | ReservedCases a2 -> () | Invariants -> () let res, events = decide a3 c3 state2 - let state3 = Folds.fold state2 events + let state3 = Fold.fold state2 events match state2, c3, res, events, state3 with // Idempotent allocate ignore - | Allocated (a,l), Allocate l3, true, [], _ -> + | Allocated (a, l), Allocate l3, true, [], _ -> test <@ a = a3 && l = l3 @> // Allocated -> Revoked - | Allocated (a,_), Revoke, true, [Events.Revoked], Unallocated -> + | Allocated (a, _), Revoke, true, [Events.Revoked], Unallocated -> test <@ a = a3 @> | ReservedCases a3 -> () | Invariants -> () let [] ``codec can roundtrip`` event = - let ee = Events.codec.Encode(None,event) + let ee = Events.codec.Encode(None, event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain/Allocation.fs b/equinox-fc/Domain/Allocation.fs index c13676ec0..ad54a3678 100644 --- a/equinox-fc/Domain/Allocation.fs +++ b/equinox-fc/Domain/Allocation.fs @@ -60,7 +60,7 @@ module Fold = let withRevoked (ToSet xs) x = { withKnown xs x with reserved = Set.difference x.reserved xs } let withReleasing (ToSet xs) x ={ withKnown xs x with releasing = x.releasing |> Set.union xs } // TODO let withAssigned listId x = // TODO - let decided,remaining = x.assigning |> List.partition (fun x -> x.listId = listId) + let decided, remaining = x.assigning |> List.partition (fun x -> x.listId = listId) let xs = seq { for x in decided do yield! x.ticketIds } { withRevoked xs x with assigning = remaining } let initial = NotStarted @@ -164,9 +164,9 @@ let decideUpdate update state = type private Accumulator() = let acc = ResizeArray() member __.Ingest state : 'res * Events.Event list -> 'res * Fold.State = function - | res, [] -> res,state - | res, [e] -> acc.Add e; res,Fold.evolve state e - | res, xs -> acc.AddRange xs; res,Fold.fold state (Seq.ofList xs) + | res, [] -> res, state + | res, [e] -> acc.Add e; res, Fold.evolve state e + | res, xs -> acc.AddRange xs; res, Fold.fold state (Seq.ofList xs) member __.Accumulated = List.ofSeq acc /// Impetus provided to the Aggregate Service from the Process Manager @@ -182,31 +182,31 @@ let sync (updates : Update seq, command : Command) (state : Fold.State) : (bool* (* Apply any updates *) let mutable state = state for x in updates do - let (),state' = acc.Ingest state ((),decideUpdate x state) + let (), state' = acc.Ingest state ((), decideUpdate x state) state <- state' (* Decide whether the Command is now acceptable *) - let accepted,state = + let accepted, state = acc.Ingest state <| match state, command with (* Ignore on the basis of being idempotent in the face of retries *) // TOCONSIDER how to represent that a request is being denied e.g. due to timeout vs due to being complete - | (Fold.Idle | Fold.Releasing _), Apply _ -> + | (Fold.Idle|Fold.Releasing _), Apply _ -> false, [] (* Defer; Need to allow current request to progress before it can be considered *) - | (Fold.Acquiring _ | Fold.Releasing _), Commence _ -> + | (Fold.Acquiring _|Fold.Releasing _), Commence _ -> true, [] // TODO validate idempotent ? (* Ok on the basis of idempotency *) - | (Fold.Idle | Fold.Releasing _), Cancel -> + | (Fold.Idle|Fold.Releasing _), Cancel -> true, [] (* Ok; Currently idle, normal Commence request*) | Fold.Idle, Commence tickets -> - true,[Events.Commenced { ticketIds = Array.ofList tickets }] + true, [Events.Commenced { ticketIds = Array.ofList tickets }] (* Ok; normal apply to distribute held tickets *) - | Fold.Acquiring s, Apply (assign,release) -> + | Fold.Acquiring s, Apply (assign, release) -> let avail = System.Collections.Generic.HashSet s.reserved let toAssign = [for a in assign -> { a with ticketIds = a.ticketIds |> Array.where avail.Remove }] - let toRelease = (Set.empty,release) ||> List.fold (fun s x -> if avail.Remove x then Set.add x s else s) + let toRelease = (Set.empty, release) ||> List.fold (fun s x -> if avail.Remove x then Set.add x s else s) true, [ for x in toAssign do if (not << Array.isEmpty) x.ticketIds then yield Events.Allocated x match toRelease with SetEmpty -> () | toRelease -> yield Events.Released { ticketIds = Set.toArray toRelease }] @@ -219,9 +219,9 @@ let sync (updates : Update seq, command : Command) (state : Fold.State) : (bool* type Service internal (resolve : AllocationId -> Equinox.Stream) = - member __.Sync(allocationId,updates,command) : Async = + member __.Sync(allocationId, updates, command) : Async = let stream = resolve allocationId - stream.Transact(sync (updates,command)) + stream.Transact(sync (updates, command)) let create resolver = let resolve pickListId = @@ -237,7 +237,7 @@ module EventStore = let opt = Equinox.ResolveOption.AllowStale // We should be reaching Completed state frequently so no actual Snapshots should get written fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy).Resolve(id,opt) - let create (context,cache) = + let create (context, cache) = create (resolver (context,cache)) module Cosmos = @@ -247,8 +247,8 @@ module Cosmos = // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale // TODO impl snapshots - let makeEmptyUnfolds events _state = events,[] + let makeEmptyUnfolds events _state = events, [] let accessStrategy = Equinox.Cosmos.AccessStrategy.Custom (Fold.isOrigin,makeEmptyUnfolds) fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) - let create (context,cache) = + let create (context, cache) = create (resolver (context, cache)) \ No newline at end of file diff --git a/equinox-fc/Domain/Allocator.fs b/equinox-fc/Domain/Allocator.fs index c4ba63dbf..10571e56e 100644 --- a/equinox-fc/Domain/Allocator.fs +++ b/equinox-fc/Domain/Allocator.fs @@ -63,7 +63,7 @@ module EventStore = // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) - let create (context,cache) = + let create (context, cache) = create (resolver (context,cache)) module Cosmos = @@ -74,5 +74,5 @@ module Cosmos = // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) - let create (context,cache) = + let create (context, cache) = create (resolver (context,cache)) diff --git a/equinox-fc/Domain/Ticket.fs b/equinox-fc/Domain/Ticket.fs index 46b918459..09d8c6f82 100644 --- a/equinox-fc/Domain/Ticket.fs +++ b/equinox-fc/Domain/Ticket.fs @@ -39,15 +39,15 @@ type Command = let decide (allocator : AllocatorId) (command : Command) (state : Fold.State) : bool * Events.Event list = match command, state with - | Reserve, Fold.Unallocated -> true,[Events.Reserved { allocatorId = allocator }] // normal case -> allow+record - | Reserve, Fold.Reserved by when by = allocator -> true,[] // idempotently permit - | Reserve, (Fold.Reserved _ | Fold.Allocated _) -> false,[] // report failure, nothing to write - | Allocate list, Fold.Allocated (by,l) when by = allocator && l = list -> true,[] // idempotent processing - | Allocate list, Fold.Reserved by when by = allocator -> true,[Events.Allocated { allocatorId = allocator; listId = list }] // normal - | Allocate _, (Fold.Allocated _ | Fold.Unallocated | Fold.Reserved _) -> false,[] // Fail if someone else has reserved or allocated, or we are jumping straight to Allocated without Reserving first - | Revoke, Fold.Unallocated -> true,[] // idempotent handling - | Revoke, (Fold.Reserved by | Fold.Allocated (by,_)) when by = allocator -> true,[Events.Revoked] // release Reservation or Allocation - | Revoke, (Fold.Reserved _ | Fold.Allocated _ ) -> true,[] // NOTE we report success of achieving the intent (but, critically, we leave it to the actual owner to manage any actual revoke) + | Reserve, Fold.Unallocated -> true, [Events.Reserved { allocatorId = allocator }] // normal case -> allow+record + | Reserve, Fold.Reserved by when by = allocator -> true, [] // idempotently permit + | Reserve, (Fold.Reserved _ | Fold.Allocated _) -> false, [] // report failure, nothing to write + | Allocate list, Fold.Allocated (by, l) when by = allocator && l = list -> true, [] // idempotent processing + | Allocate list, Fold.Reserved by when by = allocator -> true, [Events.Allocated { allocatorId = allocator; listId = list }] // normal + | Allocate _, (Fold.Allocated _ | Fold.Unallocated | Fold.Reserved _) -> false, [] // Fail if someone else has reserved or allocated, or we are jumping straight to Allocated without Reserving first + | Revoke, Fold.Unallocated -> true, [] // idempotent handling + | Revoke, (Fold.Reserved by | Fold.Allocated (by, _)) when by = allocator -> true, [Events.Revoked] // release Reservation or Allocation + | Revoke, (Fold.Reserved _ | Fold.Allocated _ ) -> true, [] // NOTE we report success of achieving the intent (but, critically, we leave it to the actual owner to manage any actual revoke) type Service internal (resolve : TicketId -> Equinox.Stream) = @@ -70,7 +70,7 @@ module EventStore = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // because we only ever need the last event, we use the Equinox.EventStore access strategy that optimizes around that Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let create (context,cache)= + let create (context, cache) = create (resolver (context, cache)) module Cosmos = @@ -81,5 +81,5 @@ module Cosmos = // because we only ever need the last event to build the state, we feed the events we are writing // (there's always exactly one if we are writing), into the unfolds slot so a single point read with etag check gets us state in one trip Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let create (context,cache) = + let create (context, cache) = create (resolver (context, cache)) \ No newline at end of file diff --git a/equinox-fc/Domain/TicketList.fs b/equinox-fc/Domain/TicketList.fs index 72365bdbd..0428f444c 100644 --- a/equinox-fc/Domain/TicketList.fs +++ b/equinox-fc/Domain/TicketList.fs @@ -19,7 +19,7 @@ module Fold = type State = Set let initial = Set.empty let evolve state = function - | Events.Allocated e -> (state,e.ticketIds) ||> Array.fold (fun m x -> Set.add x m) + | Events.Allocated e -> (state, e.ticketIds) ||> Array.fold (fun m x -> Set.add x m) | Events.Snapshotted e -> Set.ofArray e.ticketIds let fold : State -> Events.Event seq -> State = Seq.fold evolve let isOrigin = function Events.Snapshotted _ -> true | Events.Allocated _ -> false @@ -32,9 +32,9 @@ let interpret (allocatorId : AllocatorId, allocated : TicketId list) (state : Fo type Service internal (resolve : TicketListId -> Equinox.Stream) = - member __.Sync(pickListId,allocatorId,assignedTickets) : Async = + member __.Sync(pickListId, allocatorId, assignedTickets) : Async = let stream = resolve pickListId - stream.Transact(interpret (allocatorId,assignedTickets)) + stream.Transact(interpret (allocatorId, assignedTickets)) let create resolver = let resolve pickListId = @@ -49,9 +49,9 @@ module EventStore = // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong let opt = Equinox.ResolveOption.AllowStale // we _could_ use this Access Strategy, but because we are only generally doing a single shot write, its unwarranted - // let accessStrategy = AccessStrategy.RollingSnapshots (Folds.isOrigin,Folds.snapshot) + // let accessStrategy = AccessStrategy.RollingSnapshots (Folds.isOrigin, Folds.snapshot) fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy).Resolve(id,opt) - let create (context,cache) = + let create (context, cache) = create (resolver (context, cache)) module Cosmos = @@ -63,5 +63,5 @@ module Cosmos = // we want reads and writes (esp idempotent ones) to have optimal RU efficiency so we go the extra mile to do snapshotting into the Tip let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) - let create (context,cache)= + let create (context, cache)= create (resolver (context, cache)) \ No newline at end of file From d68c643303a91b9100800e4fa268501e6c51dca8 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sat, 7 Dec 2019 12:19:54 +0000 Subject: [PATCH 42/45] Formatting consistency --- equinox-fc/Domain.Tests/AllocationTests.fs | 2 +- equinox-fc/Domain/ListAllocation.fs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/equinox-fc/Domain.Tests/AllocationTests.fs b/equinox-fc/Domain.Tests/AllocationTests.fs index f6c92ff1c..a8f7fd3d4 100644 --- a/equinox-fc/Domain.Tests/AllocationTests.fs +++ b/equinox-fc/Domain.Tests/AllocationTests.fs @@ -5,6 +5,6 @@ open FsCheck.Xunit open Swensen.Unquote let [] ``codec can roundtrip`` event = - let ee = Events.codec.Encode(None,event) + let ee = Events.codec.Encode(None, event) let ie = FsCodec.Core.TimelineEvent.Create(0L, ee.EventType, ee.Data) test <@ Some event = Events.codec.TryDecode ie @> \ No newline at end of file diff --git a/equinox-fc/Domain/ListAllocation.fs b/equinox-fc/Domain/ListAllocation.fs index 51662d008..0485d9077 100644 --- a/equinox-fc/Domain/ListAllocation.fs +++ b/equinox-fc/Domain/ListAllocation.fs @@ -8,15 +8,15 @@ type Service(maxListLen, allocators : Allocator.Service, allocations : Allocatio let cutoff = let now = DateTimeOffset.UtcNow in now.Add transactionTimeout let! state = allocators.Commence(allocatorId, allocationId, cutoff) // TODO cancel timed out conflicting work - let! (_,state) = allocations.Sync(allocationId, Seq.empty, Allocation.Commence tickets) + let! _, state = allocations.Sync(allocationId, Seq.empty, Allocation.Commence tickets) return state } member __.Read(allocationId) : Async<_> = async { - let! (_,state) = allocations.Sync(allocationId, Seq.empty, Allocation.Command.Apply ([],[])) + let! _, state = allocations.Sync(allocationId, Seq.empty, Allocation.Command.Apply ([], [])) // TODO incorporate allocator state return state } - member __.Cancel(allocatorId,allocationId) : Async<_> = async { - let! (_,state) = allocations.Sync(allocationId, Seq.empty, Allocation.Command.Cancel) + member __.Cancel(allocatorId, allocationId) : Async<_> = async { + let! _, state = allocations.Sync(allocationId, Seq.empty, Allocation.Command.Cancel) // TODO propagate to allocator with reason return state } From aee536716d90b762c8d728fb71a6525b2535e150 Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Sat, 7 Dec 2019 12:28:07 +0000 Subject: [PATCH 43/45] Formatting consistency --- equinox-fc/Domain/Allocation.fs | 6 +++--- equinox-fc/Domain/Allocator.fs | 6 +++--- equinox-fc/Domain/Ticket.fs | 4 ++-- equinox-fc/Domain/TicketList.fs | 4 ++-- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/equinox-fc/Domain/Allocation.fs b/equinox-fc/Domain/Allocation.fs index ad54a3678..1fd7d485a 100644 --- a/equinox-fc/Domain/Allocation.fs +++ b/equinox-fc/Domain/Allocation.fs @@ -231,18 +231,18 @@ let create resolver = module EventStore = - let resolver (context,cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale // We should be reaching Completed state frequently so no actual Snapshots should get written fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy).Resolve(id,opt) let create (context, cache) = - create (resolver (context,cache)) + create (resolver (context, cache)) module Cosmos = - let resolver (context,cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale diff --git a/equinox-fc/Domain/Allocator.fs b/equinox-fc/Domain/Allocator.fs index 10571e56e..b83a3b4e5 100644 --- a/equinox-fc/Domain/Allocator.fs +++ b/equinox-fc/Domain/Allocator.fs @@ -58,13 +58,13 @@ let create resolver = module EventStore = let accessStrategy = Equinox.EventStore.AccessStrategy.LatestKnownEvent - let resolver (context,cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) let create (context, cache) = - create (resolver (context,cache)) + create (resolver (context, cache)) module Cosmos = @@ -75,4 +75,4 @@ module Cosmos = let opt = Equinox.ResolveOption.AllowStale fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) let create (context, cache) = - create (resolver (context,cache)) + create (resolver (context, cache)) diff --git a/equinox-fc/Domain/Ticket.fs b/equinox-fc/Domain/Ticket.fs index 09d8c6f82..fdd00cc81 100644 --- a/equinox-fc/Domain/Ticket.fs +++ b/equinox-fc/Domain/Ticket.fs @@ -66,7 +66,7 @@ let create resolver = module EventStore = let accessStrategy = Equinox.EventStore.AccessStrategy.LatestKnownEvent - let resolver (context,cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // because we only ever need the last event, we use the Equinox.EventStore access strategy that optimizes around that Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve @@ -76,7 +76,7 @@ module EventStore = module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent - let resolver (context,cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // because we only ever need the last event to build the state, we feed the events we are writing // (there's always exactly one if we are writing), into the unfolds slot so a single point read with etag check gets us state in one trip diff --git a/equinox-fc/Domain/TicketList.fs b/equinox-fc/Domain/TicketList.fs index 0428f444c..c452ac24e 100644 --- a/equinox-fc/Domain/TicketList.fs +++ b/equinox-fc/Domain/TicketList.fs @@ -44,7 +44,7 @@ let create resolver = module EventStore = - let resolver (context,cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong let opt = Equinox.ResolveOption.AllowStale @@ -56,7 +56,7 @@ module EventStore = module Cosmos = - let resolver (context,cache) = + let resolver (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong let opt = Equinox.ResolveOption.AllowStale From f9500134960f85ddd57810a7406fd4177f13aeef Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Thu, 13 Feb 2020 19:53:48 +0000 Subject: [PATCH 44/45] Update to FsCodec 2.0.0-rc3 --- equinox-fc/Domain/Allocation.fs | 3 +++ equinox-fc/Domain/Allocator.fs | 3 +++ equinox-fc/Domain/Ticket.fs | 3 +++ equinox-fc/Domain/TicketList.fs | 3 +++ 4 files changed, 12 insertions(+) diff --git a/equinox-fc/Domain/Allocation.fs b/equinox-fc/Domain/Allocation.fs index 1fd7d485a..4bc4a5372 100644 --- a/equinox-fc/Domain/Allocation.fs +++ b/equinox-fc/Domain/Allocation.fs @@ -6,6 +6,9 @@ let streamName allocationId = FsCodec.StreamName.create Category (AllocationId.t // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = + let [] CategoryId = "Allocation" + let (|For|) id = FsCodec.StreamName.create CategoryId (AllocationId.toString id) + type Commenced = { ticketIds : TicketId[] } type Tickets = { ticketIds : TicketId[] } type Allocated = { ticketIds : TicketId[]; listId : TicketListId } diff --git a/equinox-fc/Domain/Allocator.fs b/equinox-fc/Domain/Allocator.fs index b83a3b4e5..01d778171 100644 --- a/equinox-fc/Domain/Allocator.fs +++ b/equinox-fc/Domain/Allocator.fs @@ -8,6 +8,9 @@ let streamName allocatorId = FsCodec.StreamName.create Category (AllocatorId.toS // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = + let [] CategoryId = "Allocator" + let (|For|) id = FsCodec.StreamName.create CategoryId (AllocatorId.toString id) + type Commenced = { allocationId : AllocationId; cutoff : DateTimeOffset } type Completed = { allocationId : AllocationId; reason : Reason } and [)>] diff --git a/equinox-fc/Domain/Ticket.fs b/equinox-fc/Domain/Ticket.fs index fdd00cc81..0f3a5a0fe 100644 --- a/equinox-fc/Domain/Ticket.fs +++ b/equinox-fc/Domain/Ticket.fs @@ -6,6 +6,9 @@ let streamName ticketId = FsCodec.StreamName.create Category (TicketId.toString // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = + let [] CategoryId = "Ticket" + let (|For|) id = FsCodec.StreamName.create CategoryId (TicketId.toString id) + type Reserved = { allocatorId : AllocatorId } type Allocated = { allocatorId : AllocatorId; listId : TicketListId } diff --git a/equinox-fc/Domain/TicketList.fs b/equinox-fc/Domain/TicketList.fs index c452ac24e..167f4930f 100644 --- a/equinox-fc/Domain/TicketList.fs +++ b/equinox-fc/Domain/TicketList.fs @@ -6,6 +6,9 @@ let streamName listId = FsCodec.StreamName.create Category (TicketListId.toStrin // NOTE - these types and the union case names reflect the actual storage formats and hence need to be versioned with care module Events = + let [] CategoryId = "TicketList" + let (|For|) id = FsCodec.StreamName.create CategoryId (TicketListId.toString id) + type Allocated = { allocatorId : AllocatorId; ticketIds : TicketId[] } type Snapshotted = { ticketIds : TicketId[] } type Event = From d13f4d7186a92a841be9de5bb575c8dfee0f045c Mon Sep 17 00:00:00 2001 From: Ruben Bartelink Date: Wed, 11 Mar 2020 09:54:36 +0000 Subject: [PATCH 45/45] Tidy resolvers --- equinox-fc/Domain/Allocation.fs | 36 ++++++++++----------- equinox-fc/Domain/Allocator.fs | 26 ++++++++-------- equinox-fc/Domain/InventoryEpoch.fs | 10 +++--- equinox-fc/Domain/InventorySeries.fs | 22 ++++++------- equinox-fc/Domain/InventoryTransaction.fs | 13 ++++---- equinox-fc/Domain/LocationEpoch.fs | 13 ++++---- equinox-fc/Domain/LocationSeries.fs | 19 ++++++------ equinox-fc/Domain/Ticket.fs | 20 ++++++------ equinox-fc/Domain/TicketList.fs | 38 +++++++++++------------ equinox-fc/Watchdog/Program.fs | 2 +- 10 files changed, 98 insertions(+), 101 deletions(-) diff --git a/equinox-fc/Domain/Allocation.fs b/equinox-fc/Domain/Allocation.fs index 4bc4a5372..026eea375 100644 --- a/equinox-fc/Domain/Allocation.fs +++ b/equinox-fc/Domain/Allocation.fs @@ -226,32 +226,32 @@ type Service internal (resolve : AllocationId -> Equinox.Stream(), stream, maxAttempts = 2) - Service (resolve) + Service(resolve) module EventStore = - let resolver (context, cache) = + // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale + let create (context, cache) = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent - let opt = Equinox.ResolveOption.AllowStale // We should be reaching Completed state frequently so no actual Snapshots should get written - fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy).Resolve(id,opt) - let create (context, cache) = - create (resolver (context, cache)) + let resolver = Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy) + let resolve id = resolver.Resolve(id, opt) + create resolve module Cosmos = - let resolver (context, cache) = - let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent - let opt = Equinox.ResolveOption.AllowStale - // TODO impl snapshots - let makeEmptyUnfolds events _state = events, [] - let accessStrategy = Equinox.Cosmos.AccessStrategy.Custom (Fold.isOrigin,makeEmptyUnfolds) - fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) + // TODO impl snapshots + let makeEmptyUnfolds events _state = events, [] + let accessStrategy = Equinox.Cosmos.AccessStrategy.Custom (Fold.isOrigin,makeEmptyUnfolds) + // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale let create (context, cache) = - create (resolver (context, cache)) \ No newline at end of file + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + let resolve id = resolver.Resolve(id,opt) + create resolve \ No newline at end of file diff --git a/equinox-fc/Domain/Allocator.fs b/equinox-fc/Domain/Allocator.fs index 01d778171..7a7fe38cc 100644 --- a/equinox-fc/Domain/Allocator.fs +++ b/equinox-fc/Domain/Allocator.fs @@ -52,30 +52,30 @@ type Service internal (resolve : AllocatorId -> Equinox.Stream(), stream, maxAttempts = 2) - Service (resolve) + Service(resolve) module EventStore = let accessStrategy = Equinox.EventStore.AccessStrategy.LatestKnownEvent - let resolver (context, cache) = + let create (context, cache) = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent let opt = Equinox.ResolveOption.AllowStale - fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) - let create (context, cache) = - create (resolver (context, cache)) + let resolver = Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + let resolve id = resolver.Resolve(id,opt) + create resolve module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent - let resolver (context,cache) = - let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent - let opt = Equinox.ResolveOption.AllowStale - fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id,opt) + // while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale let create (context, cache) = - create (resolver (context, cache)) + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + let resolve id = resolver.Resolve(id,opt) + create resolve diff --git a/equinox-fc/Domain/InventoryEpoch.fs b/equinox-fc/Domain/InventoryEpoch.fs index 9942b5f2e..bb12310e3 100644 --- a/equinox-fc/Domain/InventoryEpoch.fs +++ b/equinox-fc/Domain/InventoryEpoch.fs @@ -81,16 +81,16 @@ type Service internal (resolve : InventoryId * InventoryEpochId -> Equinox.Strea let stream = resolve (inventoryId, epochId) stream.Transact(decideSync capacity events) -let create resolver = +let create resolve = let resolve ids = - let stream = resolver (streamName ids) + let stream = resolve (streamName ids) Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = 2) Service(resolve) module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) - let resolver (context, cache) = + let create (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let create (context, cache) = create (resolver (context, cache)) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + create resolver.Resolve diff --git a/equinox-fc/Domain/InventorySeries.fs b/equinox-fc/Domain/InventorySeries.fs index 011f24fee..f16d16705 100644 --- a/equinox-fc/Domain/InventorySeries.fs +++ b/equinox-fc/Domain/InventorySeries.fs @@ -40,21 +40,21 @@ type Service internal (resolve : InventoryId -> Equinox.Stream(), stream, maxAttempts = 2) - Service (resolve) + Service(resolve) module Cosmos = + // For this stream, we uniformly use stale reads as: + // a) we don't require any information from competing writers + // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent + let opt = Equinox.ResolveOption.AllowStale let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent - let resolver (context, cache) = - let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - // For this stream, we uniformly use stale reads as: - // a) we don't require any information from competing writers - // b) while there are competing writers [which might cause us to have to retry a Transact], this should be infrequent - let opt = Equinox.ResolveOption.AllowStale - fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) let create (context, cache) = - create (resolver (context, cache)) + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + let resolve id = resolver.Resolve(id, opt) + create resolve diff --git a/equinox-fc/Domain/InventoryTransaction.fs b/equinox-fc/Domain/InventoryTransaction.fs index a6f8d5bf3..cbaa66aeb 100644 --- a/equinox-fc/Domain/InventoryTransaction.fs +++ b/equinox-fc/Domain/InventoryTransaction.fs @@ -136,11 +136,11 @@ type Service internal (resolve : InventoryTransactionId -> Equinox.Stream(), stream, maxAttempts = 2) - Service (resolve) + Service(resolve) module Cosmos = @@ -148,10 +148,11 @@ module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.Unoptimized // ... and there will generally be a single actor touching it at a given time, so we don't need to do a load (which would be more expensive than normal given the `accessStrategy`) before we sync let opt = Equinox.AllowStale - let resolver (context, cache) = + let create (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) - let createService (context, cache) = create (resolver (context, cache)) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + let resolve id = resolver.Resolve(id, opt) + create resolve /// Handles requirement to infer when a transaction is 'stuck' /// Note we don't want to couple to the state in a deep manner; thus we track: diff --git a/equinox-fc/Domain/LocationEpoch.fs b/equinox-fc/Domain/LocationEpoch.fs index 330e3dd2d..b5ef12c40 100644 --- a/equinox-fc/Domain/LocationEpoch.fs +++ b/equinox-fc/Domain/LocationEpoch.fs @@ -133,17 +133,16 @@ type Service internal (resolve : LocationId * LocationEpochId -> Equinox.Stream< let stream = resolve (locationId, epochId) stream.Transact(sync prevEpochBalanceCarriedForward decide shouldClose) -let create resolver maxAttempts = +let create resolve maxAttempts = let resolve locationId = - let stream = resolver (streamName locationId) + let stream = resolve (streamName locationId) Equinox.Stream(Serilog.Log.ForContext(), stream, maxAttempts = maxAttempts) - Service (resolve) + Service(resolve) module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.Unoptimized - let resolver (context, cache) = - let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve let create (context, cache, maxAttempts) = - create (resolver (context, cache)) maxAttempts + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + create resolver.Resolve maxAttempts diff --git a/equinox-fc/Domain/LocationSeries.fs b/equinox-fc/Domain/LocationSeries.fs index e113a7c67..606c4c468 100644 --- a/equinox-fc/Domain/LocationSeries.fs +++ b/equinox-fc/Domain/LocationSeries.fs @@ -37,19 +37,18 @@ type Service internal (resolve : LocationId -> Equinox.Stream(), stream, maxAttempts = maxAttempts) - Service (resolve) + Service(resolve) module Cosmos = - open Equinox.Cosmos - - let resolver (context, cache) = - let cacheStrategy = CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - let opt = Equinox.ResolveOption.AllowStale - fun id -> Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, AccessStrategy.LatestKnownEvent).Resolve(id, opt) + let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent + let opt = Equinox.ResolveOption.AllowStale let createService (context, cache, maxAttempts) = - create (resolver (context, cache)) maxAttempts + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + let resolve id = resolver.Resolve(id, opt) + create resolve maxAttempts diff --git a/equinox-fc/Domain/Ticket.fs b/equinox-fc/Domain/Ticket.fs index 0f3a5a0fe..69f2de7b2 100644 --- a/equinox-fc/Domain/Ticket.fs +++ b/equinox-fc/Domain/Ticket.fs @@ -60,29 +60,27 @@ type Service internal (resolve : TicketId -> Equinox.Stream(), stream, maxAttempts = 2) - Service (resolve) + Service(resolve) module EventStore = let accessStrategy = Equinox.EventStore.AccessStrategy.LatestKnownEvent - let resolver (context, cache) = + let create (context, cache) = let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // because we only ever need the last event, we use the Equinox.EventStore access strategy that optimizes around that - Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let create (context, cache) = - create (resolver (context, cache)) + let resolver = Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + create resolver.Resolve module Cosmos = let accessStrategy = Equinox.Cosmos.AccessStrategy.LatestKnownEvent - let resolver (context, cache) = + let create (context, cache) = let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) // because we only ever need the last event to build the state, we feed the events we are writing // (there's always exactly one if we are writing), into the unfolds slot so a single point read with etag check gets us state in one trip - Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve - let create (context, cache) = - create (resolver (context, cache)) \ No newline at end of file + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + create resolver.Resolve diff --git a/equinox-fc/Domain/TicketList.fs b/equinox-fc/Domain/TicketList.fs index 167f4930f..26993a743 100644 --- a/equinox-fc/Domain/TicketList.fs +++ b/equinox-fc/Domain/TicketList.fs @@ -39,32 +39,32 @@ type Service internal (resolve : TicketListId -> Equinox.Stream(), stream, maxAttempts = 2) - Service (resolve) + Service(resolve) module EventStore = - let resolver (context, cache) = - let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong - let opt = Equinox.ResolveOption.AllowStale - // we _could_ use this Access Strategy, but because we are only generally doing a single shot write, its unwarranted - // let accessStrategy = AccessStrategy.RollingSnapshots (Folds.isOrigin, Folds.snapshot) - fun id -> Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy).Resolve(id,opt) + // we _could_ use this Access Strategy, but because we are only generally doing a single shot write, its unwarranted + // let accessStrategy = AccessStrategy.RollingSnapshots (Folds.isOrigin, Folds.snapshot) + // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong + let opt = Equinox.ResolveOption.AllowStale let create (context, cache) = - create (resolver (context, cache)) + let cacheStrategy = Equinox.EventStore.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let resolver = Equinox.EventStore.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy) + let resolve id = resolver.Resolve(id,opt) + create resolve module Cosmos = - let resolver (context, cache) = - let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) - // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong - let opt = Equinox.ResolveOption.AllowStale - // we want reads and writes (esp idempotent ones) to have optimal RU efficiency so we go the extra mile to do snapshotting into the Tip - let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) - fun id -> Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy).Resolve(id, opt) + // while there are competing writers (which might cause us to have to retry a Transact and discover it is redundant), there is never a cost to being wrong + let opt = Equinox.ResolveOption.AllowStale + // we want reads and writes (esp idempotent ones) to have optimal RU efficiency so we go the extra mile to do snapshotting into the Tip + let accessStrategy = Equinox.Cosmos.AccessStrategy.Snapshot (Fold.isOrigin, Fold.snapshot) let create (context, cache)= - create (resolver (context, cache)) \ No newline at end of file + let cacheStrategy = Equinox.Cosmos.CachingStrategy.SlidingWindow (cache, System.TimeSpan.FromMinutes 20.) + let resolver = Equinox.Cosmos.Resolver(context, Events.codec, Fold.fold, Fold.initial, cacheStrategy, accessStrategy) + let resolve id = resolver.Resolve(id, opt) + create resolve \ No newline at end of file diff --git a/equinox-fc/Watchdog/Program.fs b/equinox-fc/Watchdog/Program.fs index 610f722a5..fe86c6514 100644 --- a/equinox-fc/Watchdog/Program.fs +++ b/equinox-fc/Watchdog/Program.fs @@ -351,7 +351,7 @@ let build (args : CmdParser.Arguments) = let maxTransactionsPerEpoch = 100 let lookBackLimit = 10 Fc.Inventory.Cosmos.create inventoryId maxTransactionsPerEpoch lookBackLimit (context, cache) - let transactionService = Fc.Inventory.Transaction.Cosmos.createService (context, cache) + let transactionService = Fc.Inventory.Transaction.Cosmos.create (context, cache) let locations = let zeroBalance : Fc.Location.Epoch.Events.CarriedForward = { initial = 0; recentTransactions = [||] } let chooseTransactionIds = function