Allocation example from Equinox 174

equinox-fc/Domain.Tests/AllocationTests.fs

@@ -0,0 +1,10 @@
+module AllocationTests
+
+open Allocation
+open FsCheck.Xunit
+open Swensen.Unquote
+
+let [<Property>] ``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 @>

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 [<Property>] 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 [<Property>] ``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 @>

equinox-fc/Domain.Tests/Domain.Tests.fsproj

@@ -12,6 +12,10 @@
  <Compile Include="LocationSeriesTests.fs" />
  <Compile Include="LocationEpochTests.fs" />
  <Compile Include="LocationTests.fs" />
+ <Compile Include="TicketTests.fs" />
+ <Compile Include="TicketListTests.fs" />
+ <Compile Include="AllocatorTests.fs" />
+ <Compile Include="AllocationTests.fs" />
  </ItemGroup>
 
  <ItemGroup>

equinox-fc/Domain.Tests/TicketListTests.fs

@@ -0,0 +1,45 @@
+module TicketListTests
+
+open FsCheck.Xunit
+open Swensen.Unquote
+open TicketList
+
+let [<Property>] 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 [<Property>] ``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 @>

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 [<Property>] 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 [<Property>] ``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 @>