Harness.hs

{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl 0.15.0.0 (language keiro-dsl 3) from aggregate OrderBook; do not edit.
module Generated.IdDomainMigration.OrderBook.Harness (harnessAssertions) where

import Generated.IdDomainMigration.OrderBook.Domain
import Generated.IdDomainMigration.OrderBook.Codec (encodeOrderBookEvent, parseOrderBookEvent, orderBookCodec)
import Generated.IdDomainMigration.OrderBook.Transducer (orderBookTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer, (!))
import Keiro.Codec (eventType)
import Generated.IdDomainMigration.Nominals (OrderId, parseOrderId)

-- | (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 orderBookTransducer))
  -- clock-free: spec samples no wall clock (verified at scaffold time)
  , ("golden round-trip: OrderRecorded", roundTrips sampleEventOrderRecorded)
  , ("accepts Record from OrderBookEmpty", acceptRecord)
  ]
  ++ forwardReplayRecord

roundTrips :: OrderBookEvent -> Bool
roundTrips e = parseOrderBookEvent (eventType orderBookCodec e) (encodeOrderBookEvent e) == Right e

sampleOrderId :: OrderId
sampleOrderId =
  case parseOrderId "ord_01h455vb4pex5vsknk084sn02q" of
    Right parsed -> parsed
    Left problem -> error (show problem)

sampleEventOrderRecorded :: OrderBookEvent
sampleEventOrderRecorded = OrderRecorded (OrderRecordedData sampleOrderId)

acceptRecord :: Bool
acceptRecord =
  case step orderBookTransducer (OrderBookEmpty, initialOrderBookRegs) (Record (RecordData sampleOrderId)) of
    Just (v, _, _) -> v == OrderBookRecorded
    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 orderBookTransducer (OrderBookEmpty, initialOrderBookRegs) (Record (RecordData sampleOrderId)) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, forwardRegs, emitted) ->
      case mapM (\event -> parseOrderBookEvent (eventType orderBookCodec event) (encodeOrderBookEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither orderBookTransducer (OrderBookEmpty, initialOrderBookRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              , (prefix <> "register orderId", (replayRegs ! #orderId) == (forwardRegs ! #orderId))
              ]
  where
    prefix = "forward/replay equality: Record from OrderBookEmpty -- "