Harness.hs

{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl 0.11.0.0 (language keiro-dsl 4) from aggregate ScalarLedger; do not edit.
module Generated.AggregateScalars.ScalarLedger.Harness (harnessAssertions) where

import Generated.AggregateScalars.ScalarLedger.Domain
import Generated.AggregateScalars.ScalarLedger.Codec (encodeScalarLedgerEvent, parseScalarLedgerEvent, scalarLedgerCodec)
import Generated.AggregateScalars.ScalarLedger.Transducer (scalarLedgerTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer, (!))
import Keiro.Codec (eventType)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)

-- | (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 scalarLedgerTransducer))
  -- clock-free: spec samples no wall clock (verified at scaffold time)
  , ("golden round-trip: ScalarsRecorded", roundTrips sampleEventScalarsRecorded)
  , ("golden round-trip: FieldIdentityObserved", roundTrips sampleEventFieldIdentityObserved)
  , ("accepts Record from ScalarLedgerEmpty", acceptRecord)
  ]
  ++ forwardReplayRecord

roundTrips :: ScalarLedgerEvent -> Bool
roundTrips e = parseScalarLedgerEvent (eventType scalarLedgerCodec e) (encodeScalarLedgerEvent e) == Right e

sampleObservedAt :: UTCTime
sampleObservedAt = UTCTime (fromGregorian 2026 1 2) (picosecondsToDiffTime 11045123456789012)

sampleEventScalarsRecorded :: ScalarLedgerEvent
sampleEventScalarsRecorded = ScalarsRecorded (ScalarsRecordedData sampleObservedAt 0)

sampleEventFieldIdentityObserved :: ScalarLedgerEvent
sampleEventFieldIdentityObserved = FieldIdentityObserved (FieldIdentityObservedData "sample-as" "sample-family" "sample-mdo" "sample-proc" "sample-qualified" "sample-rec" "sample-safe" "sample-signature" "sample-stock" "sample-unsafe" "sample-via" "sample-type" "sample-region")

acceptRecord :: Bool
acceptRecord =
  case step scalarLedgerTransducer (ScalarLedgerEmpty, initialScalarLedgerRegs) (Record (RecordData sampleObservedAt 0)) of
    Just (v, _, _) -> v == ScalarLedgerRecorded
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayRecord :: [(String, Bool)]
forwardReplayRecord =
  case step scalarLedgerTransducer (ScalarLedgerEmpty, initialScalarLedgerRegs) (Record (RecordData sampleObservedAt 0)) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, forwardRegs, emitted) ->
      case mapM (\event -> parseScalarLedgerEvent (eventType scalarLedgerCodec event) (encodeScalarLedgerEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither scalarLedgerTransducer (ScalarLedgerEmpty, initialScalarLedgerRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              , (prefix <> "register observedAt", (replayRegs ! #observedAt) == (forwardRegs ! #observedAt))
              , (prefix <> "register revision", (replayRegs ! #revision) == (forwardRegs ! #revision))
              ]
  where
    prefix = "forward/replay equality: Record from ScalarLedgerEmpty -- "