keiro-dsl-0.17.0.0: test/conformance-process-timers/Generated/ProcessTimers/IncidentSaga/Harness.hs
-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate IncidentSaga; do not edit.
module Generated.ProcessTimers.IncidentSaga.Harness (harnessAssertions) where
import Generated.ProcessTimers.IncidentSaga.Domain
import Generated.ProcessTimers.IncidentSaga.Codec (encodeIncidentSagaEvent, parseIncidentSagaEvent, incidentSagaCodec)
import Generated.ProcessTimers.IncidentSaga.Transducer (incidentSagaTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)
import Keiro.Codec (eventType)
import Generated.ProcessTimers.Nominals (IncidentId, parseIncidentId)
-- | (label, passed). A driver runs these and exits non-zero on any False,
-- naming the failing assertion. Filling a hole wrongly turns a specific
-- entry False; the scaffold cannot.
harnessAssertions :: [(String, Bool)]
harnessAssertions =
[ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions incidentSagaTransducer))
-- clock-free: spec samples no wall clock (verified at scaffold time)
, ("golden round-trip: IncidentRecorded", roundTrips sampleEventIncidentRecorded)
, ("accepts RecordIncident from IncidentSagaOpen", acceptRecordIncident)
]
++ forwardReplayRecordIncident
roundTrips :: IncidentSagaEvent -> Bool
roundTrips e = parseIncidentSagaEvent (eventType incidentSagaCodec e) (encodeIncidentSagaEvent e) == Right e
sampleIncidentId :: IncidentId
sampleIncidentId =
case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of
Right parsed -> parsed
Left problem -> error (show problem)
sampleEventIncidentRecorded :: IncidentSagaEvent
sampleEventIncidentRecorded = IncidentRecorded (IncidentRecordedData sampleIncidentId)
acceptRecordIncident :: Bool
acceptRecordIncident =
case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordIncident (RecordIncidentData sampleIncidentId)) of
Just (v, _, _) -> v == IncidentSagaOpen
Nothing -> False
-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayRecordIncident :: [(String, Bool)]
forwardReplayRecordIncident =
case step incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) (RecordIncident (RecordIncidentData sampleIncidentId)) of
Nothing -> [(prefix <> "forward step accepted", False)]
Just (forwardVertex, _forwardRegs, emitted) ->
case mapM (\event -> parseIncidentSagaEvent (eventType incidentSagaCodec event) (encodeIncidentSagaEvent event)) emitted of
Left _ -> [(prefix <> "emitted chain decodes", False)]
Right decodedEvents ->
case applyEventsEither incidentSagaTransducer (IncidentSagaOpen, initialIncidentSagaRegs) decodedEvents of
Left _ -> [(prefix <> "replay succeeds", False)]
Right (replayVertex, _replayRegs) ->
[ (prefix <> "final vertex", replayVertex == forwardVertex)
]
where
prefix = "forward/replay equality: RecordIncident from IncidentSagaOpen -- "