keiro-dsl-0.10.0.0: test/conformance-nominal-scalars/Generated/NominalScalars/NominalLedger/Harness.hs
{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.
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 Data.KindID qualified as KindID
import Data.Text qualified as T
import Keiro.Codec.IdDomain (typeIdV7Domain, validateIdDomainText)
import Generated.NominalScalars.NominalProjections qualified as NominalProjections
import NominalConformance.Bindings qualified as Bindings
import NominalConformance.Domain (AccountNumber, FeatureFlag, ObservedAt, OrderId, OrderStatus, RiskScore, SequenceNumber)
-- | (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 Bindings.orderIdFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.orderStatusFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.accountNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.riskScoreFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.sequenceNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.featureFlagFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.observedAtFixtures)))))
acceptRecordNominals :: Bool
acceptRecordNominals =
case step nominalLedgerTransducer (NominalLedgerEmpty, initialNominalLedgerRegs) ((RecordNominals (RecordNominalsData Bindings.initialOrderId Bindings.initialOrderStatus (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.accountNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.riskScoreFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.sequenceNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.featureFlagFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases 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 Bindings.initialOrderId Bindings.initialOrderStatus (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.accountNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.riskScoreFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.sequenceNumberFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases Bindings.featureFlagFixtures))) (nominalFixtureDomain (NonEmpty.head (nominalFixtureCases 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 Bindings.accountNumberBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.accountNumberFixtures)))
, ("nominal representation law: AccountNumber", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.accountNumberBinding (nominalToRepresentation Bindings.accountNumberBinding domainValue)) (NonEmpty.toList (nominalFixtureCases Bindings.accountNumberFixtures)))
, ("nominal projection agreement: AccountNumber", all (\fixture -> fieldWitnessAgrees NominalProjections.accountNumberWitness (nominalToRepresentation Bindings.accountNumberBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.accountNumberFixtures)))
, ("nominal domain law: FeatureFlag", all (\fixture -> nominalDomainRoundTrip Bindings.featureFlagBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.featureFlagFixtures)))
, ("nominal representation law: FeatureFlag", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.featureFlagBinding (nominalToRepresentation Bindings.featureFlagBinding domainValue)) (NonEmpty.toList (nominalFixtureCases Bindings.featureFlagFixtures)))
, ("nominal projection agreement: FeatureFlag", all (\fixture -> fieldWitnessAgrees NominalProjections.featureFlagWitness (nominalToRepresentation Bindings.featureFlagBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.featureFlagFixtures)))
, ("nominal domain law: ObservedAt", all (\fixture -> nominalDomainRoundTrip Bindings.observedAtBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.observedAtFixtures)))
, ("nominal representation law: ObservedAt", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.observedAtBinding (nominalToRepresentation Bindings.observedAtBinding domainValue)) (NonEmpty.toList (nominalFixtureCases Bindings.observedAtFixtures)))
, ("nominal projection agreement: ObservedAt", all (\fixture -> fieldWitnessAgrees NominalProjections.observedAtWitness (nominalToRepresentation Bindings.observedAtBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.observedAtFixtures)))
, ("nominal domain law: OrderId", all (\fixture -> nominalDomainRoundTrip Bindings.orderIdBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.orderIdFixtures)))
, ("nominal representation law: OrderId", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.orderIdBinding (nominalToRepresentation Bindings.orderIdBinding domainValue)) (NonEmpty.toList (nominalFixtureCases Bindings.orderIdFixtures)))
, ("nominal ID projection agreement: OrderId", all (\fixture -> fieldWitnessAgrees NominalProjections.orderIdEqualityWitness (KindID.toText . nominalToRepresentation Bindings.orderIdBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.orderIdFixtures)))
, ("nominal ID fixture domain agreement: OrderId", all (\fixture -> case validateIdDomainText (typeIdV7Domain "ord") (KindID.toText (nominalToRepresentation Bindings.orderIdBinding (nominalFixtureDomain fixture))) of Right () -> True; Left _ -> False) (NonEmpty.toList (nominalFixtureCases Bindings.orderIdFixtures)))
, ("nominal ID binding preserves canonical representations: OrderId", all (nominalRepresentationRoundTrip Bindings.orderIdBinding) [(case KindID.parseText @"ord" "ord_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated canonical ID conformance probe failed to parse"), (case KindID.parseText @"ord" "ord_01h455vb4pex5vsknk084sn02r" of Right parsed -> parsed; Left _ -> error "generated canonical ID conformance probe failed to parse")])
, ("nominal ID boundary rejects wrong-prefix and normalized text: OrderId", case (validateIdDomainText (typeIdV7Domain "ord") "wrong_01h455vb4pex5vsknk084sn02q", validateIdDomainText (typeIdV7Domain "ord") (T.toUpper "ord_01h455vb4pex5vsknk084sn02q")) of (Left _, Left _) -> True; _ -> False)
, ("nominal domain law: OrderStatus", all (\fixture -> nominalDomainRoundTrip Bindings.orderStatusBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.orderStatusFixtures)))
, ("nominal representation law: OrderStatus", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.orderStatusBinding (nominalToRepresentation Bindings.orderStatusBinding domainValue)) (NonEmpty.toList (nominalFixtureCases Bindings.orderStatusFixtures)))
, ("nominal domain law: RiskScore", all (\fixture -> nominalDomainRoundTrip Bindings.riskScoreBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.riskScoreFixtures)))
, ("nominal representation law: RiskScore", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.riskScoreBinding (nominalToRepresentation Bindings.riskScoreBinding domainValue)) (NonEmpty.toList (nominalFixtureCases Bindings.riskScoreFixtures)))
, ("nominal projection agreement: RiskScore", all (\fixture -> fieldWitnessAgrees NominalProjections.riskScoreWitness (nominalToRepresentation Bindings.riskScoreBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.riskScoreFixtures)))
, ("nominal domain law: SequenceNumber", all (\fixture -> nominalDomainRoundTrip Bindings.sequenceNumberBinding (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.sequenceNumberFixtures)))
, ("nominal representation law: SequenceNumber", all (\fixture -> let domainValue = nominalFixtureDomain fixture in nominalRepresentationRoundTrip Bindings.sequenceNumberBinding (nominalToRepresentation Bindings.sequenceNumberBinding domainValue)) (NonEmpty.toList (nominalFixtureCases Bindings.sequenceNumberFixtures)))
, ("nominal projection agreement: SequenceNumber", all (\fixture -> fieldWitnessAgrees NominalProjections.sequenceNumberWitness (nominalToRepresentation Bindings.sequenceNumberBinding) (nominalFixtureDomain fixture)) (NonEmpty.toList (nominalFixtureCases Bindings.sequenceNumberFixtures)))
]