Harness.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.NominalScalars.NominalLedger.Harness (harnessAssertions) where

import Generated.NominalScalars.NominalLedger.Domain
import Generated.NominalScalars.NominalLedger.Codec (encodeNominalLedgerEvent, parseNominalLedgerEvent, nominalLedgerCodec)
import Generated.NominalScalars.NominalLedger.Transducer (nominalLedgerTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer, fieldWitnessAgrees, (!))
import Keiro.Codec (eventType)
import Data.List.NonEmpty qualified as NonEmpty
import Keiro.Codec.Nominal (nominalDomainRoundTrip, nominalFixtureCases, nominalFixtureDomain, nominalRepresentationRoundTrip, nominalToRepresentation)
import NominalConformance.Bindings qualified
import Generated.NominalScalars.NominalProjections qualified as NominalProjections

{- | (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 nominalLedgerTransducer))
  , ("clock-free: spec samples no wall clock", True)
  , ("golden round-trip: NominalsRecorded", roundTrips sampleEventNominalsRecorded)
  , ("accepts RecordNominals from NominalLedgerEmpty", acceptRecordNominals)
  ]
  ++ nominalConformanceAssertions
  ++ forwardReplayRecordNominals

roundTrips :: NominalLedgerEvent -> Bool
roundTrips e = parseNominalLedgerEvent (eventType nominalLedgerCodec e) (encodeNominalLedgerEvent e) == Right e

sampleEventNominalsRecorded :: NominalLedgerEvent
sampleEventNominalsRecorded = (NominalsRecorded (NominalsRecordedData (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.orderIdFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.orderStatusFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.accountNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.riskScoreFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.sequenceNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.featureFlagFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.observedAtFixtures)))))

acceptRecordNominals :: Bool
acceptRecordNominals =
  case step nominalLedgerTransducer (NominalLedgerEmpty, initialNominalLedgerRegs) ((RecordNominals (RecordNominalsData NominalConformance.Bindings.initialOrderId NominalConformance.Bindings.initialOrderStatus (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.accountNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.riskScoreFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.sequenceNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.featureFlagFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.observedAtFixtures)))))) of
    Just (v, _, _) -> v == NominalLedgerRecorded
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayRecordNominals :: [(String, Bool)]
forwardReplayRecordNominals =
  case step nominalLedgerTransducer (NominalLedgerEmpty, initialNominalLedgerRegs) ((RecordNominals (RecordNominalsData NominalConformance.Bindings.initialOrderId NominalConformance.Bindings.initialOrderStatus (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.accountNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.riskScoreFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.sequenceNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.featureFlagFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases NominalConformance.Bindings.observedAtFixtures)))))) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, forwardRegs, emitted) ->
      case mapM (\event -> parseNominalLedgerEvent (eventType nominalLedgerCodec event) (encodeNominalLedgerEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither nominalLedgerTransducer (NominalLedgerEmpty, initialNominalLedgerRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              , (prefix <> "register orderId", (replayRegs ! #orderId) == (forwardRegs ! #orderId))
              , (prefix <> "register status", (replayRegs ! #status) == (forwardRegs ! #status))
              , (prefix <> "register accountNumber", (replayRegs ! #accountNumber) == (forwardRegs ! #accountNumber))
              , (prefix <> "register riskScore", (replayRegs ! #riskScore) == (forwardRegs ! #riskScore))
              , (prefix <> "register sequenceNumber", (replayRegs ! #sequenceNumber) == (forwardRegs ! #sequenceNumber))
              , (prefix <> "register featureFlag", (replayRegs ! #featureFlag) == (forwardRegs ! #featureFlag))
              , (prefix <> "register observedAt", (replayRegs ! #observedAt) == (forwardRegs ! #observedAt))
              ]
  where
    prefix = "forward/replay equality: RecordNominals from NominalLedgerEmpty -- "

nominalConformanceAssertions :: [(String, Bool)]
nominalConformanceAssertions =
  [ ("nominal domain law: AccountNumber", all (\fixture -> nominalDomainRoundTrip NominalConformance.Bindings.accountNumberBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.accountNumberFixtures)))
  , ("nominal representation law: AccountNumber", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip NominalConformance.Bindings.accountNumberBinding (nominalToRepresentation NominalConformance.Bindings.accountNumberBinding domainValue)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.accountNumberFixtures)))
  , ("nominal projection agreement: AccountNumber", all (\fixture -> fieldWitnessAgrees NominalProjections.accountNumberWitness (nominalToRepresentation NominalConformance.Bindings.accountNumberBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.accountNumberFixtures)))
  , ("nominal domain law: FeatureFlag", all (\fixture -> nominalDomainRoundTrip NominalConformance.Bindings.featureFlagBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.featureFlagFixtures)))
  , ("nominal representation law: FeatureFlag", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip NominalConformance.Bindings.featureFlagBinding (nominalToRepresentation NominalConformance.Bindings.featureFlagBinding domainValue)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.featureFlagFixtures)))
  , ("nominal projection agreement: FeatureFlag", all (\fixture -> fieldWitnessAgrees NominalProjections.featureFlagWitness (nominalToRepresentation NominalConformance.Bindings.featureFlagBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.featureFlagFixtures)))
  , ("nominal domain law: ObservedAt", all (\fixture -> nominalDomainRoundTrip NominalConformance.Bindings.observedAtBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.observedAtFixtures)))
  , ("nominal representation law: ObservedAt", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip NominalConformance.Bindings.observedAtBinding (nominalToRepresentation NominalConformance.Bindings.observedAtBinding domainValue)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.observedAtFixtures)))
  , ("nominal projection agreement: ObservedAt", all (\fixture -> fieldWitnessAgrees NominalProjections.observedAtWitness (nominalToRepresentation NominalConformance.Bindings.observedAtBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.observedAtFixtures)))
  , ("nominal domain law: OrderId", all (\fixture -> nominalDomainRoundTrip NominalConformance.Bindings.orderIdBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.orderIdFixtures)))
  , ("nominal representation law: OrderId", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip NominalConformance.Bindings.orderIdBinding (nominalToRepresentation NominalConformance.Bindings.orderIdBinding domainValue)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.orderIdFixtures)))
  , ("nominal domain law: OrderStatus", all (\fixture -> nominalDomainRoundTrip NominalConformance.Bindings.orderStatusBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.orderStatusFixtures)))
  , ("nominal representation law: OrderStatus", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip NominalConformance.Bindings.orderStatusBinding (nominalToRepresentation NominalConformance.Bindings.orderStatusBinding domainValue)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.orderStatusFixtures)))
  , ("nominal domain law: RiskScore", all (\fixture -> nominalDomainRoundTrip NominalConformance.Bindings.riskScoreBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.riskScoreFixtures)))
  , ("nominal representation law: RiskScore", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip NominalConformance.Bindings.riskScoreBinding (nominalToRepresentation NominalConformance.Bindings.riskScoreBinding domainValue)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.riskScoreFixtures)))
  , ("nominal projection agreement: RiskScore", all (\fixture -> fieldWitnessAgrees NominalProjections.riskScoreWitness (nominalToRepresentation NominalConformance.Bindings.riskScoreBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.riskScoreFixtures)))
  , ("nominal domain law: SequenceNumber", all (\fixture -> nominalDomainRoundTrip NominalConformance.Bindings.sequenceNumberBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.sequenceNumberFixtures)))
  , ("nominal representation law: SequenceNumber", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip NominalConformance.Bindings.sequenceNumberBinding (nominalToRepresentation NominalConformance.Bindings.sequenceNumberBinding domainValue)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.sequenceNumberFixtures)))
  , ("nominal projection agreement: SequenceNumber", all (\fixture -> fieldWitnessAgrees NominalProjections.sequenceNumberWitness (nominalToRepresentation NominalConformance.Bindings.sequenceNumberBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases NominalConformance.Bindings.sequenceNumberFixtures)))
  ]