keiro-dsl-0.6.0.0: test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Harness.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeApplications #-}
-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.StructuralConformance.ArtifactCatalog.Harness (harnessAssertions) where
import Conformance.Structural.Bindings qualified
import Conformance.Structural.Domain qualified
import Data.Aeson qualified as Aeson
import Data.Aeson.Key qualified as AesonKey
import Data.Aeson.KeyMap qualified as AesonKeyMap
import Data.Either (isLeft, isRight)
import Data.List (nub)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (isJust, isNothing)
import Data.Proxy (Proxy (..))
import Data.Text qualified as T
import Generated.StructuralConformance.ArtifactCatalog.Codec (artifactCatalogCodec, decodeArtifactInfoMapped, decodeArtifactKindMapped, decodeArtifactLocationMapped, decodeArtifactMetadataMapped, encodeArtifactCatalogEvent, encodeArtifactInfoMapped, encodeArtifactKindMapped, encodeArtifactLocationMapped, encodeArtifactMetadataMapped, parseArtifactCatalogEvent)
import Generated.StructuralConformance.ArtifactCatalog.Domain
import Generated.StructuralConformance.Structural.Shape.ArtifactInfo qualified
import Generated.StructuralConformance.Structural.Shape.ArtifactKind qualified
import Generated.StructuralConformance.Structural.Shape.ArtifactLocation qualified
import Generated.StructuralConformance.Structural.Shape.ArtifactMetadata qualified
import Generated.StructuralConformance.StructuralProjections qualified as StructuralProjections
import Keiki.Core (applyEventsEither, defaultValidationOptions, fieldWitnessAgrees, step, validateTransducer, (!))
import Keiki.Shape (CanonicalTypeName (..))
import Keiro.Codec (eventType)
import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape)
import StructuralConformance.ArtifactCatalog.Holes (artifactCatalogTransducer)
{- | (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 artifactCatalogTransducer))
, ("clock-free: spec samples no wall clock", True)
, ("golden round-trip: ArtifactRecorded", roundTrips sampleEventArtifactRecorded)
, ("golden round-trip: ArtifactAccepted", roundTrips sampleEventArtifactAccepted)
, ("accepts ObserveArtifact from ArtifactCatalogEmpty", acceptObserveArtifact)
]
++ mappedConformanceAssertions
++ forwardReplayObserveArtifact
roundTrips :: ArtifactCatalogEvent -> Bool
roundTrips e = parseArtifactCatalogEvent (eventType artifactCatalogCodec e) (encodeArtifactCatalogEvent e) == Right e
sampleEventArtifactRecorded :: ArtifactCatalogEvent
sampleEventArtifactRecorded = (ArtifactRecorded (ArtifactRecordedData (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))) (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.geometryCases))) False))
sampleEventArtifactAccepted :: ArtifactCatalogEvent
sampleEventArtifactAccepted = (ArtifactAccepted (ArtifactAcceptedData False))
acceptObserveArtifact :: Bool
acceptObserveArtifact =
case step artifactCatalogTransducer (ArtifactCatalogEmpty, initialArtifactCatalogRegs) ((ObserveArtifact (ObserveArtifactData (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))) (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.geometryCases))) False))) of
Just (v, _, _) -> v == ArtifactCatalogObserved
Nothing -> False
-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayObserveArtifact :: [(String, Bool)]
forwardReplayObserveArtifact =
case step artifactCatalogTransducer (ArtifactCatalogEmpty, initialArtifactCatalogRegs) ((ObserveArtifact (ObserveArtifactData (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))) (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.geometryCases))) False))) of
Nothing -> [(prefix <> "forward step accepted", False)]
Just (forwardVertex, forwardRegs, emitted) ->
case mapM (\event -> parseArtifactCatalogEvent (eventType artifactCatalogCodec event) (encodeArtifactCatalogEvent event)) emitted of
Left _ -> [(prefix <> "emitted chain decodes", False)]
Right decodedEvents ->
case applyEventsEither artifactCatalogTransducer (ArtifactCatalogEmpty, initialArtifactCatalogRegs) decodedEvents of
Left _ -> [(prefix <> "replay succeeds", False)]
Right (replayVertex, replayRegs) ->
[ (prefix <> "final vertex", replayVertex == forwardVertex)
, (prefix <> "register currentArtifact", (replayRegs ! #currentArtifact) == (forwardRegs ! #currentArtifact))
, (prefix <> "register currentGeometry", (replayRegs ! #currentGeometry) == (forwardRegs ! #currentGeometry))
, (prefix <> "register acceptedCount", (replayRegs ! #acceptedCount) == (forwardRegs ! #acceptedCount))
]
where
prefix = "forward/replay equality: ObserveArtifact from ArtifactCatalogEmpty -- "
mappedConformanceAssertions :: [(String, Bool)]
mappedConformanceAssertions =
concat
[ artifactInfoBindingAssertions
, artifactKindBindingAssertions
, artifactLocationBindingAssertions
, artifactMetadataBindingAssertions
, vendorGeometryOpaqueAssertions
, [("fixture coverage: conformance.structural.ArtifactInfo.v1", coverageArtifactInfo)]
, [("fixture coverage: conformance.structural.ArtifactKind.v1", coverageArtifactKind)]
, [("fixture coverage: conformance.structural.ArtifactLocation.v1", coverageArtifactLocation)]
, [("fixture coverage: conformance.structural.ArtifactMetadata.v1", coverageArtifactMetadata)]
, artifactRecordedArtifactAssertions
, artifactRecordedGeometryAssertions
, structuralWirePolicyAssertions
, structuralProjectionAssertions
]
validFixtureLabels :: NonEmpty.NonEmpty (T.Text, value) -> Bool
validFixtureLabels cases =
all (not . T.null) labels && length labels == length (nub labels)
where
labels = map fst (NonEmpty.toList cases)
artifactInfoBindingAssertions :: [(String, Bool)]
artifactInfoBindingAssertions =
("fixture labels: conformance.structural.ArtifactInfo.v1", validFixtureLabels cases)
: ("canonical identity: conformance.structural.ArtifactInfo.v1", canonicalTypeName (Proxy @Conformance.Structural.Domain.ArtifactInfo) == "conformance.structural.ArtifactInfo.v1")
: concat
[ [ ("binding domain round-trip: conformance.structural.ArtifactInfo.v1/" <> T.unpack label, bindingDomainRoundTrip Conformance.Structural.Bindings.artifactInfoBinding value)
, ("binding shape round-trip: conformance.structural.ArtifactInfo.v1/" <> T.unpack label, bindingShapeRoundTrip Conformance.Structural.Bindings.artifactInfoBinding (bindingToShape Conformance.Structural.Bindings.artifactInfoBinding value))
]
| (label, value) <- NonEmpty.toList cases
]
where
cases = fixtureCases Conformance.Structural.Bindings.artifactInfoCases
artifactKindBindingAssertions :: [(String, Bool)]
artifactKindBindingAssertions =
("fixture labels: conformance.structural.ArtifactKind.v1", validFixtureLabels cases)
: ("canonical identity: conformance.structural.ArtifactKind.v1", canonicalTypeName (Proxy @Conformance.Structural.Domain.ArtifactKind) == "conformance.structural.ArtifactKind.v1")
: concat
[ [ ("binding domain round-trip: conformance.structural.ArtifactKind.v1/" <> T.unpack label, bindingDomainRoundTrip Conformance.Structural.Bindings.artifactKindBinding value)
, ("binding shape round-trip: conformance.structural.ArtifactKind.v1/" <> T.unpack label, bindingShapeRoundTrip Conformance.Structural.Bindings.artifactKindBinding (bindingToShape Conformance.Structural.Bindings.artifactKindBinding value))
]
| (label, value) <- NonEmpty.toList cases
]
where
cases = fixtureCases Conformance.Structural.Bindings.artifactKindCases
artifactLocationBindingAssertions :: [(String, Bool)]
artifactLocationBindingAssertions =
("fixture labels: conformance.structural.ArtifactLocation.v1", validFixtureLabels cases)
: ("canonical identity: conformance.structural.ArtifactLocation.v1", canonicalTypeName (Proxy @Conformance.Structural.Domain.ArtifactLocation) == "conformance.structural.ArtifactLocation.v1")
: concat
[ [ ("binding domain round-trip: conformance.structural.ArtifactLocation.v1/" <> T.unpack label, bindingDomainRoundTrip Conformance.Structural.Bindings.artifactLocationBinding value)
, ("binding shape round-trip: conformance.structural.ArtifactLocation.v1/" <> T.unpack label, bindingShapeRoundTrip Conformance.Structural.Bindings.artifactLocationBinding (bindingToShape Conformance.Structural.Bindings.artifactLocationBinding value))
]
| (label, value) <- NonEmpty.toList cases
]
where
cases = fixtureCases Conformance.Structural.Bindings.artifactLocationCases
artifactMetadataBindingAssertions :: [(String, Bool)]
artifactMetadataBindingAssertions =
("fixture labels: conformance.structural.ArtifactMetadata.v1", validFixtureLabels cases)
: ("canonical identity: conformance.structural.ArtifactMetadata.v1", canonicalTypeName (Proxy @Conformance.Structural.Domain.ArtifactMetadata) == "conformance.structural.ArtifactMetadata.v1")
: concat
[ [ ("binding domain round-trip: conformance.structural.ArtifactMetadata.v1/" <> T.unpack label, bindingDomainRoundTrip Conformance.Structural.Bindings.artifactMetadataBinding value)
, ("binding shape round-trip: conformance.structural.ArtifactMetadata.v1/" <> T.unpack label, bindingShapeRoundTrip Conformance.Structural.Bindings.artifactMetadataBinding (bindingToShape Conformance.Structural.Bindings.artifactMetadataBinding value))
]
| (label, value) <- NonEmpty.toList cases
]
where
cases = fixtureCases Conformance.Structural.Bindings.artifactMetadataCases
vendorGeometryOpaqueAssertions :: [(String, Bool)]
vendorGeometryOpaqueAssertions =
("opaque boundary fixtures: vendor.geometry.json@3", validFixtureLabels cases)
: [ ("opaque codec round-trip: vendor.geometry.json@3/" <> T.unpack caseLabel, case Aeson.fromJSON (Aeson.toJSON value) of Aeson.Success decoded -> decoded == value; Aeson.Error _ -> False)
| (caseLabel, value) <- NonEmpty.toList cases
]
where
cases = fixtureCases Conformance.Structural.Bindings.geometryCases
coverageArtifactInfo :: Bool
coverageArtifactInfo = any (isNothing . Generated.StructuralConformance.Structural.Shape.ArtifactInfo.artifactHash) shapes && any (isJust . Generated.StructuralConformance.Structural.Shape.ArtifactInfo.artifactHash) shapes
where
shapes = map (bindingToShape Conformance.Structural.Bindings.artifactInfoBinding . snd) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))
coverageArtifactKind :: Bool
coverageArtifactKind = any (\case Generated.StructuralConformance.Structural.Shape.ArtifactKind.Guide -> True; _ -> False) shapes && any (\case Generated.StructuralConformance.Structural.Shape.ArtifactKind.Reference -> True; _ -> False) shapes
where
shapes = map (bindingToShape Conformance.Structural.Bindings.artifactKindBinding . snd) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactKindCases))
coverageArtifactLocation :: Bool
coverageArtifactLocation = any (\case Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalFile{} -> True; _ -> False) shapes && any (\case Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalDir{} -> True; _ -> False) shapes && any (\case Generated.StructuralConformance.Structural.Shape.ArtifactLocation.RepoPath{} -> True; _ -> False) shapes && any (\case Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocUrl{} -> True; _ -> False) shapes && any (\case Generated.StructuralConformance.Structural.Shape.ArtifactLocation.Canonical -> True; _ -> False) shapes
where
shapes = map (bindingToShape Conformance.Structural.Bindings.artifactLocationBinding . snd) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactLocationCases))
coverageArtifactMetadata :: Bool
coverageArtifactMetadata = any (isNothing . Generated.StructuralConformance.Structural.Shape.ArtifactMetadata.note) shapes && any (isJust . Generated.StructuralConformance.Structural.Shape.ArtifactMetadata.note) shapes
where
shapes = map (bindingToShape Conformance.Structural.Bindings.artifactMetadataBinding . snd) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactMetadataCases))
artifactRecordedArtifactAssertions :: [(String, Bool)]
artifactRecordedArtifactAssertions =
[ ("mapped codec round-trip: ArtifactRecorded/artifact/" <> T.unpack label, roundTrips (ArtifactRecorded (ArtifactRecordedData mappedValue (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.geometryCases))) False)))
| (label, mappedValue) <- NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)
]
artifactRecordedGeometryAssertions :: [(String, Bool)]
artifactRecordedGeometryAssertions =
[ ("mapped codec round-trip: ArtifactRecorded/geometry/" <> T.unpack label, roundTrips (ArtifactRecorded (ArtifactRecordedData (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))) mappedValue False)))
| (label, mappedValue) <- NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.geometryCases)
]
structuralWirePolicyAssertions :: [(String, Bool)]
structuralWirePolicyAssertions =
[ ("wire policy missing default: conformance.structural.ArtifactInfo.v1/artifact_hash", case decodeArtifactInfoMapped (deleteObjectField "artifact_hash" (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))))) of Left _ -> False; Right decoded -> objectField "artifact_hash" (encodeArtifactInfoMapped decoded) == Just (Aeson.Null))
, ("wire policy explicit null: conformance.structural.ArtifactInfo.v1/artifact_hash", isRight (decodeArtifactInfoMapped (insertObjectField "artifact_hash" Aeson.Null (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)))))))
, ("wire policy missing default: conformance.structural.ArtifactInfo.v1/artifact_kind", case decodeArtifactInfoMapped (deleteObjectField "artifact_kind" (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))))) of Left _ -> False; Right decoded -> objectField "artifact_kind" (encodeArtifactInfoMapped decoded) == Just (Aeson.String "guide"))
, ("wire policy explicit null: conformance.structural.ArtifactInfo.v1/artifact_kind", isLeft (decodeArtifactInfoMapped (insertObjectField "artifact_kind" Aeson.Null (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)))))))
, ("wire policy missing default: conformance.structural.ArtifactInfo.v1/active", case decodeArtifactInfoMapped (deleteObjectField "active" (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))))) of Left _ -> False; Right decoded -> objectField "active" (encodeArtifactInfoMapped decoded) == Just (Aeson.Bool False))
, ("wire policy explicit null: conformance.structural.ArtifactInfo.v1/active", isLeft (decodeArtifactInfoMapped (insertObjectField "active" Aeson.Null (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)))))))
, ("wire policy missing default: conformance.structural.ArtifactInfo.v1/tags", case decodeArtifactInfoMapped (deleteObjectField "tags" (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases))))) of Left _ -> False; Right decoded -> objectField "tags" (encodeArtifactInfoMapped decoded) == Just (Aeson.toJSON ([] :: [Aeson.Value])))
, ("wire policy explicit null: conformance.structural.ArtifactInfo.v1/tags", isLeft (decodeArtifactInfoMapped (insertObjectField "tags" Aeson.Null (encodeArtifactInfoMapped (snd (NonEmpty.head (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)))))))
, ("wire policy unknown fields: conformance.structural.ArtifactInfo.v1", all (\(_, value) -> isLeft (decodeArtifactInfoMapped (insertObjectField "__keiro_unknown" (Aeson.Bool True) (encodeArtifactInfoMapped value)))) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)))
, ("wire enum arm: conformance.structural.ArtifactKind.v1/guide", any (\(_, value) -> encodeArtifactKindMapped value == Aeson.String "guide" && decodeArtifactKindMapped (Aeson.String "guide") == Right value) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactKindCases)))
, ("wire enum arm: conformance.structural.ArtifactKind.v1/reference", any (\(_, value) -> encodeArtifactKindMapped value == Aeson.String "reference" && decodeArtifactKindMapped (Aeson.String "reference") == Right value) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactKindCases)))
, ("wire enum unknown tag: conformance.structural.ArtifactKind.v1", isLeft (decodeArtifactKindMapped (Aeson.String "__keiro_unknown")))
, ("wire union arm: conformance.structural.ArtifactLocation.v1/local_file", any (\(_, value) -> objectField "tag" (encodeArtifactLocationMapped value) == Just (Aeson.String "local_file") && decodeArtifactLocationMapped (encodeArtifactLocationMapped value) == Right value) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactLocationCases)))
, ("wire union arm: conformance.structural.ArtifactLocation.v1/local_dir", any (\(_, value) -> objectField "tag" (encodeArtifactLocationMapped value) == Just (Aeson.String "local_dir") && decodeArtifactLocationMapped (encodeArtifactLocationMapped value) == Right value) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactLocationCases)))
, ("wire union arm: conformance.structural.ArtifactLocation.v1/repo_path", any (\(_, value) -> objectField "tag" (encodeArtifactLocationMapped value) == Just (Aeson.String "repo_path") && decodeArtifactLocationMapped (encodeArtifactLocationMapped value) == Right value) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactLocationCases)))
, ("wire union arm: conformance.structural.ArtifactLocation.v1/url", any (\(_, value) -> objectField "tag" (encodeArtifactLocationMapped value) == Just (Aeson.String "url") && decodeArtifactLocationMapped (encodeArtifactLocationMapped value) == Right value) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactLocationCases)))
, ("wire union arm: conformance.structural.ArtifactLocation.v1/canonical", any (\(_, value) -> objectField "tag" (encodeArtifactLocationMapped value) == Just (Aeson.String "canonical") && decodeArtifactLocationMapped (encodeArtifactLocationMapped value) == Right value) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactLocationCases)))
, ("wire policy unknown fields: conformance.structural.ArtifactLocation.v1", all (\(_, value) -> isLeft (decodeArtifactLocationMapped (insertObjectField "__keiro_unknown" (Aeson.Bool True) (encodeArtifactLocationMapped value)))) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactLocationCases)))
, ("wire policy unknown fields: conformance.structural.ArtifactMetadata.v1", all (\(_, value) -> isRight (decodeArtifactMetadataMapped (insertObjectField "__keiro_unknown" (Aeson.Bool True) (encodeArtifactMetadataMapped value)))) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactMetadataCases)))
]
structuralProjectionAssertions :: [(String, Bool)]
structuralProjectionAssertions =
[ ("projection witness agreement: conformance.structural.ArtifactInfo.v1/artifact_key", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.structuralProjectionC41ZC72ZC74ZC69ZC66ZC61ZC63ZC74ZC49ZC6eZC66ZC6fZC2fZC61ZC72ZC74ZC69ZC66ZC61ZC63ZC74ZC5fZC6bZC65ZC79ZWitness (\referenceOwner -> Generated.StructuralConformance.Structural.Shape.ArtifactInfo.artifactKey (bindingToShape Conformance.Structural.Bindings.artifactInfoBinding referenceOwner)) owner) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)))
, ("projection witness agreement: conformance.structural.ArtifactInfo.v1/display_name", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.structuralProjectionC41ZC72ZC74ZC69ZC66ZC61ZC63ZC74ZC49ZC6eZC66ZC6fZC2fZC64ZC69ZC73ZC70ZC6cZC61ZC79ZC5fZC6eZC61ZC6dZC65ZWitness (\referenceOwner -> Generated.StructuralConformance.Structural.Shape.ArtifactInfo.displayName (bindingToShape Conformance.Structural.Bindings.artifactInfoBinding referenceOwner)) owner) (NonEmpty.toList (fixtureCases Conformance.Structural.Bindings.artifactInfoCases)))
]
deleteObjectField :: T.Text -> Aeson.Value -> Aeson.Value
deleteObjectField key (Aeson.Object objectValue) = Aeson.Object (AesonKeyMap.delete (AesonKey.fromText key) objectValue)
deleteObjectField _ value = value
insertObjectField :: T.Text -> Aeson.Value -> Aeson.Value -> Aeson.Value
insertObjectField key inserted (Aeson.Object objectValue) = Aeson.Object (AesonKeyMap.insert (AesonKey.fromText key) inserted objectValue)
insertObjectField _ _ value = value
objectField :: T.Text -> Aeson.Value -> Maybe Aeson.Value
objectField key (Aeson.Object objectValue) = AesonKeyMap.lookup (AesonKey.fromText key) objectValue
objectField _ _ = Nothing