Harness.hs

-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Incident; do not edit.
module Generated.ProcessTimers.Incident.Harness (harnessAssertions) where

import Generated.ProcessTimers.Incident.Domain
import Generated.ProcessTimers.Incident.Codec (encodeIncidentEvent, parseIncidentEvent, incidentCodec)
import Generated.ProcessTimers.Incident.Transducer (incidentTransducer)
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 incidentTransducer))
  -- clock-free: spec samples no wall clock (verified at scaffold time)
  , ("golden round-trip: IncidentEscalated", roundTrips sampleEventIncidentEscalated)
  , ("golden round-trip: IncidentReminded", roundTrips sampleEventIncidentReminded)
  , ("accepts EscalateIncident from IncidentOpen", acceptEscalateIncident)
  , ("accepts RemindIncident from IncidentOpen", acceptRemindIncident)
  ]
  ++ forwardReplayEscalateIncident
  ++ forwardReplayRemindIncident

roundTrips :: IncidentEvent -> Bool
roundTrips e = parseIncidentEvent (eventType incidentCodec e) (encodeIncidentEvent e) == Right e

sampleIncidentId :: IncidentId
sampleIncidentId =
  case parseIncidentId "inc_01h455vb4pex5vsknk084sn02q" of
    Right parsed -> parsed
    Left problem -> error (show problem)

sampleEventIncidentEscalated :: IncidentEvent
sampleEventIncidentEscalated = IncidentEscalated (IncidentEscalatedData sampleIncidentId)

sampleEventIncidentReminded :: IncidentEvent
sampleEventIncidentReminded = IncidentReminded (IncidentRemindedData sampleIncidentId)

acceptEscalateIncident :: Bool
acceptEscalateIncident =
  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of
    Just (v, _, _) -> v == IncidentEscalatedState
    Nothing -> False

acceptRemindIncident :: Bool
acceptRemindIncident =
  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (RemindIncident (RemindIncidentData sampleIncidentId)) of
    Just (v, _, _) -> v == IncidentOpen
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayEscalateIncident :: [(String, Bool)]
forwardReplayEscalateIncident =
  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (EscalateIncident (EscalateIncidentData sampleIncidentId)) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, _forwardRegs, emitted) ->
      case mapM (\event -> parseIncidentEvent (eventType incidentCodec event) (encodeIncidentEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither incidentTransducer (IncidentOpen, initialIncidentRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, _replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              ]
  where
    prefix = "forward/replay equality: EscalateIncident from IncidentOpen -- "

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayRemindIncident :: [(String, Bool)]
forwardReplayRemindIncident =
  case step incidentTransducer (IncidentOpen, initialIncidentRegs) (RemindIncident (RemindIncidentData sampleIncidentId)) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, _forwardRegs, emitted) ->
      case mapM (\event -> parseIncidentEvent (eventType incidentCodec event) (encodeIncidentEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither incidentTransducer (IncidentOpen, initialIncidentRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, _replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              ]
  where
    prefix = "forward/replay equality: RemindIncident from IncidentOpen -- "