diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,32 @@ ## [Unreleased] +## [0.8.0.0] - 2026-08-19 + +### Added + +- `HandleReferenceRule` can prohibit local handles with `allowLocal` and narrow + external references with an optional whole-value POSIX ERE. The compiled + matcher is reused during validation, while URI syntax and scheme checks still + run first and no external target is resolved. +- `NestedFieldRule.reference` applies the same compiled reference semantics to + members of record lists and object-valued fields. +- `FieldRule.uniqueBy` enforces list-local uniqueness for one unconditionally + required scalar member. `fieldRuleUniqueBy` exposes the effective merged key + without exposing `EffectiveFieldRule` constructors. + +### Changed + +- **Breaking:** the raw profile schema and JSON representation add + `allowLocal`, `externalUriPattern`, nested `reference`, and `uniqueBy`. + Compatibility decoding supplies `True`, `Nothing`, `Nothing`, and `Nothing` + respectively for descriptors written against 0.7.0.0 and earlier. +- **Breaking:** `ProfileDefinitionError` and `ProfileViolation` add structured + cases for invalid/conflicting patterns, invalid uniqueness declarations, + local-handle prohibition, pattern mismatch, and duplicate nested values. +- Generated profile documentation prints effective local/external reference + constraints at both rule depths and a fixed `Unique by` bullet. + ## [0.7.0.0] - 2026-08-18 ### Added diff --git a/dhall/FieldRule.dhall b/dhall/FieldRule.dhall --- a/dhall/FieldRule.dhall +++ b/dhall/FieldRule.dhall @@ -23,6 +23,10 @@ -- mapping. Declaring it alongside `cardinality = Cardinality.Scalar` or -- `Cardinality.List` is a profile definition error, because a mapping is -- neither. +-- +-- `uniqueBy = Some key` applies only to `elementFields`: the named nested key +-- must be unconditionally required and scalar, and its present values must be +-- unique within each one parent list. `None` performs no comparison. let Cardinality = ./Cardinality.dhall let FieldFormat = ./FieldFormat.dhall @@ -45,4 +49,5 @@ , reference : Optional HandleReferenceRule , path : Optional PathReferenceRule , when : Optional FieldCondition + , uniqueBy : Optional Text } diff --git a/dhall/HandleReferenceRule.dhall b/dhall/HandleReferenceRule.dhall --- a/dhall/HandleReferenceRule.dhall +++ b/dhall/HandleReferenceRule.dhall @@ -1,7 +1,12 @@ ---| Policy for a top-level field containing local document handles or explicit --- external URI alternatives. okf resolves only the local handle and never --- performs network or registry lookups for an external URI. +--| Policy for a top-level or nested field containing local document handles or +-- explicit external URI alternatives. `allowLocal` can prohibit the local +-- spelling; `externalUriPattern`, when present, is a whole-value POSIX extended +-- regular expression applied after URI syntax and scheme checks. okf resolves +-- only an allowed local handle and never performs network or registry lookups +-- for an external URI. { localPrefix : Text , externalUriSchemes : List Text , allowSelf : Bool +, allowLocal : Bool +, externalUriPattern : Optional Text } diff --git a/dhall/NestedFieldRule.dhall b/dhall/NestedFieldRule.dhall --- a/dhall/NestedFieldRule.dhall +++ b/dhall/NestedFieldRule.dhall @@ -5,13 +5,11 @@ -- are bounded to one level of flat records rather than recursively nested -- objects. -- --- It does carry `path`, because `sources[].resource` — the motivating --- path-valued field of OKF v0.2 specification §6.2 — lives inside a list element --- record and is unreachable from a top-level rule. It deliberately does not --- carry `reference`: no v0.2 field names a `PREFIX-N` document handle inside a --- nested record, and adding an unused member to a published record is a --- compatibility event bought for nothing. It is a cheap additive change for --- whoever has a motivating case. +-- It carries `path`, because `sources[].resource` — the motivating path-valued +-- field of OKF v0.2 specification §6.2 — lives inside a list element record and +-- is unreachable from a top-level rule. It also carries `reference`, so a +-- member such as `dependencies[].ref` can prohibit local handles and constrain +-- which external artifact URI family its text names. let Cardinality = ./Cardinality.dhall let FieldFormat = ./FieldFormat.dhall @@ -20,6 +18,8 @@ let PathReferenceRule = ./PathReferenceRule.dhall +let HandleReferenceRule = ./HandleReferenceRule.dhall + in { field : Text , description : Optional Text , allowedValues : List Text @@ -27,4 +27,5 @@ , format : Optional FieldFormat , path : Optional PathReferenceRule , when : Optional FieldCondition + , reference : Optional HandleReferenceRule } diff --git a/dhall/defaults/FieldRule.dhall b/dhall/defaults/FieldRule.dhall --- a/dhall/defaults/FieldRule.dhall +++ b/dhall/defaults/FieldRule.dhall @@ -24,5 +24,6 @@ , reference = None HandleReferenceRule , path = None PathReferenceRule , when = None FieldCondition + , uniqueBy = None Text } } diff --git a/dhall/defaults/HandleReferenceRule.dhall b/dhall/defaults/HandleReferenceRule.dhall --- a/dhall/defaults/HandleReferenceRule.dhall +++ b/dhall/defaults/HandleReferenceRule.dhall @@ -5,5 +5,7 @@ , default = { externalUriSchemes = [] : List Text , allowSelf = False + , allowLocal = True + , externalUriPattern = None Text } } diff --git a/dhall/defaults/NestedFieldRule.dhall b/dhall/defaults/NestedFieldRule.dhall --- a/dhall/defaults/NestedFieldRule.dhall +++ b/dhall/defaults/NestedFieldRule.dhall @@ -9,6 +9,8 @@ let PathReferenceRule = ../PathReferenceRule.dhall +let HandleReferenceRule = ../HandleReferenceRule.dhall + in { Type = NestedFieldRuleType , default = { description = None Text @@ -17,5 +19,6 @@ , format = None FieldFormat , path = None PathReferenceRule , when = None FieldCondition + , reference = None HandleReferenceRule } } diff --git a/okf-core.cabal b/okf-core.cabal --- a/okf-core.cabal +++ b/okf-core.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: okf-core -version: 0.7.0.0 +version: 0.8.0.0 synopsis: Read, validate, index, and traverse Open Knowledge Format bundles @@ -84,6 +84,7 @@ , generic-lens >=2.2 && <2.4 , lens ^>=5.3 , network-uri >=2.6.4 && <2.7 + , regex-tdfa >=1.3.2 && <1.4 , text ^>=2.1 , time >=1.12 && <1.15 , vector >=0.13 && <0.14 diff --git a/src/Okf/Profile.hs b/src/Okf/Profile.hs --- a/src/Okf/Profile.hs +++ b/src/Okf/Profile.hs @@ -56,6 +56,7 @@ fieldRuleCardinality, fieldRuleFormat, fieldRuleReference, + fieldRuleUniqueBy, fieldRulePath, fieldRuleElementFields, fieldRuleObjectFields, @@ -92,7 +93,6 @@ import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (catMaybes, mapMaybe) -import Data.Set (Set) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Read qualified as Text.Read @@ -144,6 +144,8 @@ import Okf.Prelude hiding (List, Object, (.=)) import Okf.Validation (ValidationProfile (..)) import System.FilePath qualified as FilePath +import Text.Regex.TDFA (Regex, defaultCompOpt, defaultExecOpt) +import Text.Regex.TDFA.Text qualified as Regex.Text import "generic-lens" Data.Generics.Labels () -- | A complete house profile. @description@ is prose documenting the profile as @@ -197,7 +199,9 @@ data HandleReferenceRule = HandleReferenceRule { localPrefix :: !Text, externalUriSchemes :: ![Text], - allowSelf :: !Bool + allowSelf :: !Bool, + allowLocal :: !Bool, + externalUriPattern :: !(Maybe Text) } deriving stock (Generic, Eq, Ord, Show) deriving anyclass (FromDhall) @@ -243,7 +247,8 @@ objectFields :: !(Maybe NestedRules), reference :: !(Maybe HandleReferenceRule), path :: !(Maybe PathReferenceRule), - when :: !(Maybe FieldCondition) + when :: !(Maybe FieldCondition), + uniqueBy :: !(Maybe Text) } deriving stock (Generic, Eq, Show) deriving anyclass (FromDhall) @@ -271,7 +276,8 @@ cardinality :: !Cardinality, format :: !(Maybe FieldFormat), path :: !(Maybe PathReferenceRule), - when :: !(Maybe FieldCondition) + when :: !(Maybe FieldCondition), + reference :: !(Maybe HandleReferenceRule) } deriving stock (Generic, Eq, Show) deriving anyclass (FromDhall) @@ -385,11 +391,13 @@ ] instance ToJSON HandleReferenceRule where - toJSON HandleReferenceRule {localPrefix, externalUriSchemes, allowSelf} = + toJSON HandleReferenceRule {localPrefix, externalUriSchemes, allowSelf, allowLocal, externalUriPattern} = object [ "localPrefix" .= localPrefix, "externalUriSchemes" .= externalUriSchemes, - "allowSelf" .= allowSelf + "allowSelf" .= allowSelf, + "allowLocal" .= allowLocal, + "externalUriPattern" .= externalUriPattern ] instance ToJSON PathReferenceRule where @@ -400,7 +408,7 @@ ] instance ToJSON FieldRule where - toJSON FieldRule {field = fieldName, description, allowedValues, cardinality, format, elementFields, objectFields, reference, path = pathRule, when = condition} = + toJSON FieldRule {field = fieldName, description, allowedValues, cardinality, format, elementFields, objectFields, reference, path = pathRule, when = condition, uniqueBy} = object [ "field" .= fieldName, "description" .= description, @@ -414,7 +422,8 @@ -- reads as "the keys this instance has always emitted, then the ones -- added since". A consumer keys on names, not position. "objectFields" .= objectFields, - "path" .= pathRule + "path" .= pathRule, + "uniqueBy" .= uniqueBy ] instance ToJSON NestedRules where @@ -426,7 +435,7 @@ ] instance ToJSON NestedFieldRule where - toJSON NestedFieldRule {field = fieldName, description, allowedValues, cardinality, format, path = pathRule, when = condition} = + toJSON NestedFieldRule {field = fieldName, description, allowedValues, cardinality, format, path = pathRule, when = condition, reference} = object [ "field" .= fieldName, "description" .= description, @@ -435,7 +444,8 @@ "format" .= format, "when" .= condition, -- Appended for the same reason 'FieldRule' appends @objectFields@. - "path" .= pathRule + "path" .= pathRule, + "reference" .= reference ] instance ToJSON Cardinality where @@ -569,6 +579,96 @@ LegacyUriWithScheme scheme -> UriWithScheme scheme LegacyDocumentHandle prefix -> DocumentHandle prefix +-- | The complete 0.7.0.0 descriptor generation, frozen before nested +-- document-reference policies and record-list uniqueness were added. Every +-- record that directly or transitively contains one of the grown records is +-- copied so a descriptor pinned to 0.7.0.0 remains decodable as one closed +-- Dhall type. +data PreNestedReferenceHandleReferenceRule = PreNestedReferenceHandleReferenceRule + { localPrefix :: !Text, + externalUriSchemes :: ![Text], + allowSelf :: !Bool + } + deriving stock (Generic, Eq, Ord, Show) + deriving anyclass (FromDhall) + +data PreNestedReferenceFieldRule = PreNestedReferenceFieldRule + { field :: !Text, + description :: !(Maybe Text), + allowedValues :: ![Text], + cardinality :: !Cardinality, + format :: !(Maybe FieldFormat), + elementFields :: !(Maybe PreNestedReferenceNestedRules), + objectFields :: !(Maybe PreNestedReferenceNestedRules), + reference :: !(Maybe PreNestedReferenceHandleReferenceRule), + path :: !(Maybe PathReferenceRule), + when :: !(Maybe FieldCondition) + } + deriving stock (Generic, Eq, Show) + deriving anyclass (FromDhall) + +data PreNestedReferenceNestedRules = PreNestedReferenceNestedRules + { required :: ![PreNestedReferenceNestedFieldRule], + recommended :: ![PreNestedReferenceNestedFieldRule], + optional :: ![PreNestedReferenceNestedFieldRule] + } + deriving stock (Generic, Eq, Show) + deriving anyclass (FromDhall) + +data PreNestedReferenceNestedFieldRule = PreNestedReferenceNestedFieldRule + { field :: !Text, + description :: !(Maybe Text), + allowedValues :: ![Text], + cardinality :: !Cardinality, + format :: !(Maybe FieldFormat), + path :: !(Maybe PathReferenceRule), + when :: !(Maybe FieldCondition) + } + deriving stock (Generic, Eq, Show) + deriving anyclass (FromDhall) + +data PreNestedReferenceFrontmatterRules = PreNestedReferenceFrontmatterRules + { required :: ![PreNestedReferenceFieldRule], + recommended :: ![PreNestedReferenceFieldRule], + optional :: ![PreNestedReferenceFieldRule] + } + deriving stock (Generic, Eq, Show) + deriving anyclass (FromDhall) + +data PreNestedReferenceProfileSpec = PreNestedReferenceProfileSpec + { name :: !Text, + description :: !(Maybe Text), + okfVersion :: !Text, + frontmatter :: !PreNestedReferenceFrontmatterRules, + allowUnknownTypes :: !Bool, + allowUnknownFields :: !Bool, + idField :: !(Maybe Text), + requireBundleVersion :: !(Maybe Text), + types :: ![PreNestedReferenceTypeRule] + } + deriving stock (Generic, Eq, Show) + deriving anyclass (FromDhall) + +data PreNestedReferenceTypeRule = PreNestedReferenceTypeRule + { type_ :: !Text, + description :: !(Maybe Text), + frontmatter :: !PreNestedReferenceFrontmatterRules, + pathPattern :: !(Maybe Text), + resourceScheme :: !(Maybe Text), + requireSchemaSection :: !Bool, + schemaColumns :: ![Text], + idPrefix :: !(Maybe Text) + } + deriving stock (Generic, Eq, Show) + +instance FromDhall PreNestedReferenceTypeRule where + autoWith _normalizer = + genericAutoWith + (Dhall.defaultInterpretOptions {Dhall.fieldModifier = stripTrailingUnderscore}) + where + stripTrailingUnderscore fieldName = + fromMaybe fieldName (Text.stripSuffix "_" fieldName) + -- | The complete descriptor generation frozen before a profile could require its -- bundle to declare an OKF version. This is the immediately preceding public -- descriptor generation: it is today's shape minus the @requireBundleVersion@ @@ -583,11 +683,11 @@ { name :: !Text, description :: !(Maybe Text), okfVersion :: !Text, - frontmatter :: !FrontmatterRules, + frontmatter :: !PreNestedReferenceFrontmatterRules, allowUnknownTypes :: !Bool, allowUnknownFields :: !Bool, idField :: !(Maybe Text), - types :: ![TypeRule] + types :: ![PreNestedReferenceTypeRule] } deriving stock (Generic, Eq, Show) deriving anyclass (FromDhall) @@ -607,7 +707,7 @@ format :: !(Maybe FieldFormat), elementFields :: !(Maybe PrePathProfileNestedRules), objectFields :: !(Maybe PrePathProfileNestedRules), - reference :: !(Maybe HandleReferenceRule), + reference :: !(Maybe PreNestedReferenceHandleReferenceRule), when :: !(Maybe FieldCondition) } deriving stock (Generic, Eq, Show) @@ -687,7 +787,7 @@ format :: !(Maybe PreV02FieldFormat), elementFields :: !(Maybe PreActorProfileNestedRules), objectFields :: !(Maybe PreActorProfileNestedRules), - reference :: !(Maybe HandleReferenceRule), + reference :: !(Maybe PreNestedReferenceHandleReferenceRule), when :: !(Maybe FieldCondition) } deriving stock (Generic, Eq, Show) @@ -767,7 +867,7 @@ cardinality :: !Cardinality, format :: !(Maybe PreV02FieldFormat), elementFields :: !(Maybe PreObjectProfileNestedRules), - reference :: !(Maybe HandleReferenceRule), + reference :: !(Maybe PreNestedReferenceHandleReferenceRule), when :: !(Maybe FieldCondition) } deriving stock (Generic, Eq, Show) @@ -846,7 +946,7 @@ cardinality :: !Cardinality, format :: !(Maybe PreV02FieldFormat), elementFields :: !(Maybe ReferenceProfileNestedRules), - reference :: !(Maybe HandleReferenceRule), + reference :: !(Maybe PreNestedReferenceHandleReferenceRule), when :: !(Maybe FieldCondition) } deriving stock (Generic, Eq, Show) @@ -1293,6 +1393,83 @@ emptyFrontmatterRules :: FrontmatterRules emptyFrontmatterRules = FrontmatterRules {required = [], recommended = [], optional = []} +upgradePreNestedReferenceHandleRule :: PreNestedReferenceHandleReferenceRule -> HandleReferenceRule +upgradePreNestedReferenceHandleRule previous = + HandleReferenceRule + { localPrefix = previous ^. #localPrefix, + externalUriSchemes = previous ^. #externalUriSchemes, + allowSelf = previous ^. #allowSelf, + allowLocal = True, + externalUriPattern = Nothing + } + +upgradePreNestedReferenceFrontmatter :: PreNestedReferenceFrontmatterRules -> FrontmatterRules +upgradePreNestedReferenceFrontmatter previous = + FrontmatterRules + { required = map upgradeField (previous ^. #required), + recommended = map upgradeField (previous ^. #recommended), + optional = map upgradeField (previous ^. #optional) + } + where + upgradeField rule = + FieldRule + { field = rule ^. #field, + description = rule ^. #description, + allowedValues = rule ^. #allowedValues, + cardinality = rule ^. #cardinality, + format = rule ^. #format, + elementFields = upgradeNestedRules <$> rule ^. #elementFields, + objectFields = upgradeNestedRules <$> rule ^. #objectFields, + reference = upgradePreNestedReferenceHandleRule <$> rule ^. #reference, + path = rule ^. #path, + when = rule ^. #when, + uniqueBy = Nothing + } + upgradeNestedRules rules = + NestedRules + { required = map upgradeNestedField (rules ^. #required), + recommended = map upgradeNestedField (rules ^. #recommended), + optional = map upgradeNestedField (rules ^. #optional) + } + upgradeNestedField rule = + NestedFieldRule + { field = rule ^. #field, + description = rule ^. #description, + allowedValues = rule ^. #allowedValues, + cardinality = rule ^. #cardinality, + format = rule ^. #format, + path = rule ^. #path, + when = rule ^. #when, + reference = Nothing + } + +upgradePreNestedReferenceTypeRule :: PreNestedReferenceTypeRule -> TypeRule +upgradePreNestedReferenceTypeRule rule = + TypeRule + { type_ = rule ^. #type_, + description = rule ^. #description, + frontmatter = upgradePreNestedReferenceFrontmatter (rule ^. #frontmatter), + pathPattern = rule ^. #pathPattern, + resourceScheme = rule ^. #resourceScheme, + requireSchemaSection = rule ^. #requireSchemaSection, + schemaColumns = rule ^. #schemaColumns, + idPrefix = rule ^. #idPrefix + } + +upgradePreNestedReferenceProfile :: PreNestedReferenceProfileSpec -> ProfileSpec +upgradePreNestedReferenceProfile previous = + ProfileSpec + { name = previous ^. #name, + description = previous ^. #description, + okfVersion = previous ^. #okfVersion, + frontmatter = upgradePreNestedReferenceFrontmatter (previous ^. #frontmatter), + allowUnknownTypes = previous ^. #allowUnknownTypes, + allowUnknownFields = previous ^. #allowUnknownFields, + idField = previous ^. #idField, + requireBundleVersion = previous ^. #requireBundleVersion, + types = map upgradePreNestedReferenceTypeRule (previous ^. #types) + } + upgradePrePathProfileFrontmatter :: PrePathProfileFrontmatterRules -> FrontmatterRules upgradePrePathProfileFrontmatter previous = FrontmatterRules @@ -1310,9 +1487,10 @@ format = rule ^. #format, elementFields = upgradeNestedRules <$> rule ^. #elementFields, objectFields = upgradeNestedRules <$> rule ^. #objectFields, - reference = rule ^. #reference, + reference = upgradePreNestedReferenceHandleRule <$> rule ^. #reference, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + uniqueBy = Nothing } upgradeNestedRules rules = NestedRules @@ -1328,7 +1506,8 @@ cardinality = rule ^. #cardinality, format = rule ^. #format, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + reference = Nothing } upgradePreActorProfileFrontmatter :: PreActorProfileFrontmatterRules -> FrontmatterRules @@ -1348,9 +1527,10 @@ format = upgradePreV02FieldFormat <$> rule ^. #format, elementFields = upgradeNestedRules <$> rule ^. #elementFields, objectFields = upgradeNestedRules <$> rule ^. #objectFields, - reference = rule ^. #reference, + reference = upgradePreNestedReferenceHandleRule <$> rule ^. #reference, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + uniqueBy = Nothing } upgradeNestedRules rules = NestedRules @@ -1366,7 +1546,8 @@ cardinality = rule ^. #cardinality, format = upgradePreV02FieldFormat <$> rule ^. #format, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + reference = Nothing } upgradePreObjectProfileFrontmatter :: PreObjectProfileFrontmatterRules -> FrontmatterRules @@ -1386,9 +1567,10 @@ format = upgradePreV02FieldFormat <$> rule ^. #format, elementFields = upgradeNestedRules <$> rule ^. #elementFields, objectFields = Nothing, - reference = rule ^. #reference, + reference = upgradePreNestedReferenceHandleRule <$> rule ^. #reference, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + uniqueBy = Nothing } upgradeNestedRules rules = NestedRules @@ -1404,7 +1586,8 @@ cardinality = rule ^. #cardinality, format = upgradePreV02FieldFormat <$> rule ^. #format, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + reference = Nothing } upgradeReferenceProfileFrontmatter :: ReferenceProfileFrontmatterRules -> FrontmatterRules @@ -1424,9 +1607,10 @@ format = upgradePreV02FieldFormat <$> rule ^. #format, elementFields = upgradeNestedRules <$> rule ^. #elementFields, objectFields = Nothing, - reference = rule ^. #reference, + reference = upgradePreNestedReferenceHandleRule <$> rule ^. #reference, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + uniqueBy = Nothing } upgradeNestedRules rules = NestedRules @@ -1442,7 +1626,8 @@ cardinality = rule ^. #cardinality, format = upgradePreV02FieldFormat <$> rule ^. #format, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + reference = Nothing } upgradePreviousFrontmatter :: PreviousFrontmatterRules -> FrontmatterRules @@ -1464,7 +1649,8 @@ objectFields = Nothing, reference = Nothing, path = Nothing, - when = Nothing + when = Nothing, + uniqueBy = Nothing } upgradeConditionalProfileFrontmatter :: ConditionalProfileFrontmatterRules -> FrontmatterRules @@ -1486,7 +1672,8 @@ objectFields = Nothing, reference = Nothing, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + uniqueBy = Nothing } upgradeNestedRules rules = NestedRules @@ -1502,7 +1689,8 @@ cardinality = rule ^. #cardinality, format = upgradePreV02FieldFormat <$> rule ^. #format, path = Nothing, - when = rule ^. #when + when = rule ^. #when, + reference = Nothing } upgradeNestedProfileFrontmatter :: NestedProfileFrontmatterRules -> FrontmatterRules @@ -1524,7 +1712,8 @@ objectFields = Nothing, reference = Nothing, path = Nothing, - when = Nothing + when = Nothing, + uniqueBy = Nothing } upgradeNestedProfileRules rules = NestedRules @@ -1540,7 +1729,8 @@ cardinality = rule ^. #cardinality, format = upgradePreV02FieldFormat <$> rule ^. #format, path = Nothing, - when = Nothing + when = Nothing, + reference = Nothing } upgradeFormatFrontmatter :: FormatFrontmatterRules -> FrontmatterRules @@ -1562,7 +1752,8 @@ objectFields = Nothing, reference = Nothing, path = Nothing, - when = Nothing + when = Nothing, + uniqueBy = Nothing } upgradeCardinalityFrontmatter :: CardinalityFrontmatterRules -> FrontmatterRules @@ -1584,7 +1775,8 @@ objectFields = Nothing, reference = Nothing, path = Nothing, - when = Nothing + when = Nothing, + uniqueBy = Nothing } upgradeVocabularyFrontmatter :: VocabularyFrontmatterRules -> FrontmatterRules @@ -1606,26 +1798,25 @@ objectFields = Nothing, reference = Nothing, path = Nothing, - when = Nothing + when = Nothing, + uniqueBy = Nothing } --- | Lift the generation frozen before @requireBundleVersion@ forward. Every rule --- record is shared with today's schema, so this copies members across and --- supplies the one no-op default: a descriptor that predates the member demands --- nothing of its bundle's version declaration, which is what it meant when it --- was written. +-- | Lift the generation frozen before @requireBundleVersion@ forward. Its +-- contained rule records use the shared 0.7.0.0 frozen types because those +-- records later grew too. upgradePreBundleVersionProfile :: PreBundleVersionProfileSpec -> ProfileSpec upgradePreBundleVersionProfile previous = ProfileSpec { name = previous ^. #name, description = previous ^. #description, okfVersion = previous ^. #okfVersion, - frontmatter = previous ^. #frontmatter, + frontmatter = upgradePreNestedReferenceFrontmatter (previous ^. #frontmatter), allowUnknownTypes = previous ^. #allowUnknownTypes, allowUnknownFields = previous ^. #allowUnknownFields, idField = previous ^. #idField, requireBundleVersion = Nothing, - types = previous ^. #types + types = map upgradePreNestedReferenceTypeRule (previous ^. #types) } upgradePrePathProfile :: PrePathProfileSpec -> ProfileSpec @@ -1935,7 +2126,7 @@ types = map upgradeRule (legacy ^. #types) } where - undocumented key = FieldRule {field = key, description = Nothing, allowedValues = [], cardinality = Any, format = Nothing, elementFields = Nothing, objectFields = Nothing, reference = Nothing, path = Nothing, when = Nothing} + undocumented key = FieldRule {field = key, description = Nothing, allowedValues = [], cardinality = Any, format = Nothing, elementFields = Nothing, objectFields = Nothing, reference = Nothing, path = Nothing, when = Nothing, uniqueBy = Nothing} upgradeRule rule = TypeRule { type_ = rule ^. #type_, @@ -1951,7 +2142,7 @@ -- | Load and decode a Dhall profile descriptor from a file path. Any evaluation -- or decoding failure is captured as a human-readable 'Left'. -- --- The pre-bundle-version shape, pre-path shape, pre-actor shape, pre-object +-- The pre-nested-reference shape, pre-bundle-version shape, pre-path shape, pre-actor shape, pre-object -- shape, reference-aware shape, -- condition-aware shape, bounded-nested shape, EP-4 -- format shape, EP-3 cardinality shape, EP-2 vocabulary shape, type-aware EP-1 @@ -1973,7 +2164,8 @@ -- picks that generation's decoder. Adding a generation is one line here. frozenDecoders :: [IO (Maybe ProfileSpec)] frozenDecoders = - [ attempt upgradePreBundleVersionProfile, + [ attempt upgradePreNestedReferenceProfile, + attempt upgradePreBundleVersionProfile, attempt upgradePrePathProfile, attempt upgradePreActorProfile, attempt upgradePreObjectProfile, @@ -2006,7 +2198,7 @@ `catch` \(exception :: SomeException) -> pure (Left (Text.pack (show exception))) -- | Does an already-evaluated Dhall expression decode as a profile? Tries the --- current schema, then the pre-bundle-version, pre-path, pre-actor, pre-object, +-- current schema, then the pre-nested-reference, pre-bundle-version, pre-path, pre-actor, pre-object, -- reference-aware, -- condition-aware, bounded-nested, EP-4, EP-3, EP-2, EP-1, self-documenting, and -- okf 0.2.x schemas, so the published @okf-profiles@ package still enumerates. @@ -2015,6 +2207,7 @@ decodeProfileExpr :: Expr Src Void -> Maybe ProfileSpec decodeProfileExpr expression = Dhall.rawInput Dhall.auto expression + <|> fmap upgradePreNestedReferenceProfile (Dhall.rawInput Dhall.auto expression) <|> fmap upgradePreBundleVersionProfile (Dhall.rawInput Dhall.auto expression) <|> fmap upgradePrePathProfile (Dhall.rawInput Dhall.auto expression) <|> fmap upgradePreActorProfile (Dhall.rawInput Dhall.auto expression) @@ -2076,6 +2269,13 @@ | -- | one rule declares both a document-handle policy and a path policy; -- a value cannot be resolved as both a handle and a path PathReferenceWithHandleReference (Maybe Text) FieldPath + | InvalidExternalUriPattern (Maybe Text) FieldPath Text Text + | ConflictingExternalUriPatterns Text FieldPath Text Text + | UniqueByRequiresElementFields (Maybe Text) FieldPath Text + | UniqueByFieldNotDeclared (Maybe Text) FieldPath + | UniqueByFieldNotUnconditionallyRequired (Maybe Text) FieldPath + | UniqueByFieldNotScalar (Maybe Text) FieldPath Cardinality + | ConflictingUniqueBy Text FieldPath Text Text | -- | @okfVersion@ is not @\.\@ InvalidProfileOkfVersion Text | -- | @okfVersion@ names a major version okf does not implement, so okf cannot @@ -2121,10 +2321,41 @@ elementFields :: !(Maybe (Map Text EffectiveFieldRule)), objectFields :: !(Maybe (Map Text EffectiveFieldRule)), reference :: !(Maybe HandleReferenceRule), - path :: !(Maybe PathReferenceRule) + path :: !(Maybe PathReferenceRule), + uniqueBy :: !(Maybe Text), + compiledExternalUriPattern :: !(Maybe Regex) } - deriving stock (Generic, Eq, Show) + deriving stock (Generic) +instance Eq EffectiveFieldRule where + left == right = + left ^. #presenceClauses == right ^. #presenceClauses + && left ^. #description == right ^. #description + && left ^. #allowedValues == right ^. #allowedValues + && left ^. #cardinality == right ^. #cardinality + && left ^. #format == right ^. #format + && left ^. #elementFields == right ^. #elementFields + && left ^. #objectFields == right ^. #objectFields + && left ^. #reference == right ^. #reference + && left ^. #path == right ^. #path + && left ^. #uniqueBy == right ^. #uniqueBy + +instance Show EffectiveFieldRule where + show rule = + "EffectiveFieldRule " + <> show + ( rule ^. #presenceClauses, + rule ^. #description, + rule ^. #allowedValues, + rule ^. #cardinality, + rule ^. #format, + rule ^. #elementFields, + rule ^. #objectFields, + rule ^. #reference, + rule ^. #path, + rule ^. #uniqueBy + ) + -- | The stable lowercase display name for a cardinality: @any@, @scalar@, -- @list@, or @object@. These are the names the CLI prints and the names -- generated profile documentation uses, so a reader who has seen one recognizes @@ -2188,6 +2419,11 @@ fieldRuleReference :: EffectiveFieldRule -> Maybe HandleReferenceRule fieldRuleReference rule = rule ^. #reference +-- | The required scalar member whose values must be unique within this one +-- list of records, or 'Nothing' when no list-local key is declared. +fieldRuleUniqueBy :: EffectiveFieldRule -> Maybe Text +fieldRuleUniqueBy rule = rule ^. #uniqueBy + -- | The path-valued policy for this key, if any. Distinct from -- 'fieldRuleReference': a handle resolves against the bundle's document-ID -- index, a path against its concept tree. A rule never carries both — compiling @@ -2306,6 +2542,7 @@ <> conflictingFormatErrors <> conditionDefinitionErrors <> referenceDefinitionErrors + <> uniquenessDefinitionErrors <> versionErrors <> requiredBundleVersionErrors @@ -2354,6 +2591,16 @@ let (scopeRank, typeName) = scopeKey scope in (scopeRank, typeName, 20, renderFieldPathKey fieldPath, fromEnum (cardinality == Scalar)) PathReferenceWithHandleReference scope target -> referenceErrorKey scope target 21 "" + InvalidExternalUriPattern scope target patternText detail -> + referenceErrorKey scope target 22 (patternText <> ":" <> detail) + ConflictingExternalUriPatterns ctype target profilePattern typePattern -> + (1, ctype, 23, renderFieldPathKey target <> ":" <> profilePattern, Text.length typePattern) + UniqueByRequiresElementFields scope target key -> uniqueErrorKey scope target 24 key + UniqueByFieldNotDeclared scope target -> uniqueErrorKey scope target 25 "" + UniqueByFieldNotUnconditionallyRequired scope target -> uniqueErrorKey scope target 26 "" + UniqueByFieldNotScalar scope target cardinality -> uniqueErrorKey scope target 27 (Text.pack (show cardinality)) + ConflictingUniqueBy ctype target profileKey typeKey -> + (1, ctype, 28, renderFieldPathKey target <> ":" <> profileKey, Text.length typeKey) -- The two version-parse errors are profile-wide rather than scoped, and -- rank below every scope rank: if the declared version is unreadable, every -- version-derived error below is downstream noise and the reader should see @@ -2364,10 +2611,10 @@ InvalidRequiredBundleVersion rawVersion -> (-1, rawVersion, 2, "", 0) FieldSupersededInOkfVersion scope path _declared supersededIn -> let (scopeRank, typeName) = scopeKey scope - in (scopeRank, typeName, 23, renderFieldPathKey path <> ":" <> supersededIn, 0) + in (scopeRank, typeName, 30, renderFieldPathKey path <> ":" <> supersededIn, 0) FormatRequiresOkfVersion scope path fieldFormat _declared introducedIn -> let (scopeRank, typeName) = scopeKey scope - in (scopeRank, typeName, 24, renderFieldPathKey path <> ":" <> introducedIn, Text.length (Text.pack (show fieldFormat))) + in (scopeRank, typeName, 31, renderFieldPathKey path <> ":" <> introducedIn, Text.length (Text.pack (show fieldFormat))) scopeKey Nothing = (0, "") scopeKey (Just ctype) = (1, ctype) @@ -2379,6 +2626,7 @@ referenceErrorKey scope target rank detail = let (scopeRank, typeName) = scopeKey scope in (scopeRank, typeName, rank, renderFieldPathKey target <> ":" <> detail, 0) + uniqueErrorKey = referenceErrorKey scopeErrors scope FrontmatterRules {required, recommended, optional} = [DuplicateFieldRule scope "required" key | key <- duplicates (map (^. #field) required)] @@ -2618,49 +2866,36 @@ : [(Just (rule ^. #type_), rule ^. #frontmatter) | rule <- rawSpec ^. #types] rawReferenceErrors (scope, rules) = - concatMap (fieldReferenceErrors scope) topLevelRules - <> concatMap (fieldPathErrors scope) topLevelRules - -- Path rules are declarable at nested and object scope too, which - -- is where @sources[].resource@ lives, so the walk descends. It - -- hangs on 'declaredNestedRuleSets' rather than iterating - -- @elementFields@ and @objectFields@ separately, because - -- @mk.recordOrList@ declares one rule set under both names and a - -- @FieldPath@ such as @sources.resource@ cannot tell them apart. + concatMap topLevelPolicyErrors topLevelRules <> [ nestedError | rule <- topLevelRules, nestedRules <- declaredNestedRuleSets rule, nestedRule <- nestedRules ^. #required <> nestedRules ^. #recommended <> nestedRules ^. #optional, - nestedError <- - pathPolicyErrors - scope - (nestedDefinitionPath (rule ^. #field) (nestedRule ^. #field)) - (nestedRule ^. #format) - Nothing - (nestedRule ^. #path) + nestedError <- policyErrors scope (nestedDefinitionPath (rule ^. #field) (nestedRule ^. #field)) (nestedRule ^. #format) (nestedRule ^. #reference) (nestedRule ^. #path) ] where topLevelRules = rules ^. #required <> rules ^. #recommended <> rules ^. #optional + topLevelPolicyErrors rule = + policyErrors scope (topLevelFieldPath (rule ^. #field)) (rule ^. #format) (rule ^. #reference) (rule ^. #path) - fieldReferenceErrors scope rule = - case rule ^. #reference of - Nothing -> [] - Just policy -> - let path = topLevelFieldPath (rule ^. #field) - prefix = policy ^. #localPrefix - schemes = deduplicateSchemes (policy ^. #externalUriSchemes) - in [InvalidReferencePrefix scope path prefix | not (validDocumentHandlePrefix prefix)] - <> [ReferencePrefixNotDeclared scope path prefix | prefix `notElem` declaredPrefixes] - <> [ReferenceRequiresIdField scope path | isNothing (rawSpec ^. #idField)] - <> [InvalidExternalReferenceScheme scope path scheme | scheme <- schemes, not (validUriScheme scheme)] - <> [ReferenceWithFormat scope path fieldFormat | Just fieldFormat <- [rule ^. #format]] + policyErrors scope path declaredFormat handlePolicy pathPolicy = + referencePolicyErrors scope path declaredFormat handlePolicy + <> pathPolicyErrors scope path declaredFormat handlePolicy pathPolicy - fieldPathErrors scope rule = - pathPolicyErrors - scope - (topLevelFieldPath (rule ^. #field)) - (rule ^. #format) - (rule ^. #reference) - (rule ^. #path) + referencePolicyErrors scope path declaredFormat = \case + Nothing -> [] + Just policy -> + let prefix = policy ^. #localPrefix + schemes = deduplicateSchemes (policy ^. #externalUriSchemes) + in [InvalidReferencePrefix scope path prefix | not (validDocumentHandlePrefix prefix)] + <> [ReferencePrefixNotDeclared scope path prefix | prefix `notElem` declaredPrefixes] + <> [ReferenceRequiresIdField scope path | isNothing (rawSpec ^. #idField)] + <> [InvalidExternalReferenceScheme scope path scheme | scheme <- schemes, not (validUriScheme scheme)] + <> [ReferenceWithFormat scope path fieldFormat | Just fieldFormat <- [declaredFormat]] + <> [ InvalidExternalUriPattern scope path patternText detail + | Just patternText <- [policy ^. #externalUriPattern], + Left detail <- [compileExternalUriPattern patternText] + ] -- The three ways a path policy can be incoherent on its own. Two reuse -- the handle-reference constructors because the claim is identical: a @@ -2680,21 +2915,84 @@ <> [PathReferenceWithHandleReference scope path | isJust handlePolicy] mergedReferenceErrors typeRule = - [ ConflictingReferencePrefix (typeRule ^. #type_) (topLevelFieldPath key) (profilePolicy ^. #localPrefix) (typePolicy ^. #localPrefix) - | let typeFields = compileRules (typeRule ^. #frontmatter), - (key, (profileRule, typeFieldRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeFields), + [ ConflictingReferencePrefix (typeRule ^. #type_) path (profilePolicy ^. #localPrefix) (typePolicy ^. #localPrefix) + | (path, profileRule, typeFieldRule) <- pairedRules typeRule, Just profilePolicy <- [profileRule ^. #reference], Just typePolicy <- [typeFieldRule ^. #reference], profilePolicy ^. #localPrefix /= typePolicy ^. #localPrefix ] - <> [ ReferenceWithFormat (Just (typeRule ^. #type_)) (topLevelFieldPath key) fieldFormat - | let typeFields = compileRules (typeRule ^. #frontmatter), - (key, (profileRule, typeFieldRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeFields), + <> [ ConflictingExternalUriPatterns (typeRule ^. #type_) path profilePattern typePattern + | (path, profileRule, typeFieldRule) <- pairedRules typeRule, + Just profilePattern <- [profileRule ^. #reference >>= (^. #externalUriPattern)], + Just typePattern <- [typeFieldRule ^. #reference >>= (^. #externalUriPattern)], + profilePattern /= typePattern + ] + <> [ ReferenceWithFormat (Just (typeRule ^. #type_)) path fieldFormat + | (path, profileRule, typeFieldRule) <- pairedRules typeRule, (referenceRule, formatRule) <- [(profileRule, typeFieldRule), (typeFieldRule, profileRule)], isJust (referenceRule ^. #reference), Just fieldFormat <- [formatRule ^. #format] ] + <> [ PathReferenceWithHandleReference (Just (typeRule ^. #type_)) path + | (path, profileRule, typeFieldRule) <- pairedRules typeRule, + (referenceRule, pathRule) <- [(profileRule, typeFieldRule), (typeFieldRule, profileRule)], + isJust (referenceRule ^. #reference), + isJust (pathRule ^. #path) + ] + pairedRules typeRule = + [ (topLevelFieldPath key, profileRule, typeFieldRule) + | let typeFields = compileRules (typeRule ^. #frontmatter), + (key, (profileRule, typeFieldRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeFields) + ] + <> [ (nestedDefinitionPath parentKey nestedKey, profileNestedRule, typeNestedRule) + | let typeFields = compileRules (typeRule ^. #frontmatter), + (parentKey, (profileRule, typeFieldRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeFields), + (profileNested, typeNested) <- pairedNestedRuleMaps profileRule typeFieldRule, + (nestedKey, (profileNestedRule, typeNestedRule)) <- Map.toAscList (Map.intersectionWith (,) profileNested typeNested) + ] + + uniquenessDefinitionErrors = + concatMap (validateDeclarations Nothing baseRules) [rawSpec ^. #frontmatter] + <> concat + [ let typeRules = compileRules (typeRule ^. #frontmatter) + in validateDeclarations (Just (typeRule ^. #type_)) (mergeRules baseRules typeRules) (typeRule ^. #frontmatter) + | typeRule <- rawSpec ^. #types + ] + <> [ ConflictingUniqueBy (typeRule ^. #type_) (topLevelFieldPath key) profileKey typeKey + | typeRule <- rawSpec ^. #types, + let typeRules = compileRules (typeRule ^. #frontmatter), + (key, (profileRule, typeFieldRule)) <- Map.toAscList (Map.intersectionWith (,) baseRules typeRules), + Just profileKey <- [profileRule ^. #uniqueBy], + Just typeKey <- [typeFieldRule ^. #uniqueBy], + profileKey /= typeKey + ] + where + validateDeclarations scope effectiveRules rules = + concatMap (validateDeclaration scope effectiveRules) (rules ^. #required <> rules ^. #recommended <> rules ^. #optional) + + validateDeclaration scope effectiveRules rawRule = + case rawRule ^. #uniqueBy of + Nothing -> [] + Just requestedKey -> + let parentPath = topLevelFieldPath (rawRule ^. #field) + memberPath = nestedDefinitionPath (rawRule ^. #field) requestedKey + in case Map.lookup (rawRule ^. #field) effectiveRules >>= (^. #elementFields) of + Nothing -> [UniqueByRequiresElementFields scope parentPath requestedKey] + Just memberRules -> + case Map.lookup requestedKey memberRules of + Nothing -> [UniqueByFieldNotDeclared scope memberPath] + Just memberRule -> + [ UniqueByFieldNotUnconditionallyRequired scope memberPath + | not (any unconditionalRequired (memberRule ^. #presenceClauses)) + ] + <> [ UniqueByFieldNotScalar scope memberPath (memberRule ^. #cardinality) + | memberRule ^. #cardinality /= Scalar + ] + + unconditionalRequired clause = + clause ^. #requirement == RequiredField && isNothing (clause ^. #condition) + -- Only a value okf cannot parse is rejected. An unknown /major/ is -- deliberately accepted, unlike in @okfVersion@: there the profile is asking -- okf to interpret rules it may not understand, while here it is stating a @@ -2843,9 +3141,13 @@ format = rule ^. #format, elementFields = compileNestedRules <$> rule ^. #elementFields, objectFields = compileNestedRules <$> rule ^. #objectFields, - reference = compileReferenceRule <$> rule ^. #reference, - path = compilePathRule <$> rule ^. #path + reference = compiledReference, + path = compilePathRule <$> rule ^. #path, + uniqueBy = rule ^. #uniqueBy, + compiledExternalUriPattern = compileReferenceMatcher compiledReference } + where + compiledReference = compileReferenceRule <$> rule ^. #reference -- | The cardinality a rule with no declared one takes from its format. -- @@ -2903,12 +3205,15 @@ -- Nested rules stay depth-bounded: 'NestedFieldRule' has no object member, -- so a profile cannot constrain @sources[0].usage_window.from@. objectFields = Nothing, - -- Still 'Nothing': 'NestedFieldRule' carries no document-handle policy. - reference = Nothing, + reference = compiledReference, -- But it does carry a path policy, which is the point of the member — -- @sources[].resource@ is only reachable here. - path = compilePathRule <$> rule ^. #path + path = compilePathRule <$> rule ^. #path, + uniqueBy = Nothing, + compiledExternalUriPattern = compileReferenceMatcher compiledReference } + where + compiledReference = compileReferenceRule <$> rule ^. #reference compileNestedFieldRule :: FieldRequirement -> NestedFieldRule -> EffectiveFieldRule compileNestedFieldRule requirement rule = @@ -2929,9 +3234,13 @@ format = fromMaybe (profileRule ^. #format) (mergeFieldFormat (profileRule ^. #format) (typeRule ^. #format)), elementFields = mergeNestedRuleMaps (profileRule ^. #elementFields) (typeRule ^. #elementFields), objectFields = mergeNestedRuleMaps (profileRule ^. #objectFields) (typeRule ^. #objectFields), - reference = fromMaybe (profileRule ^. #reference) (mergeReferenceRule (profileRule ^. #reference) (typeRule ^. #reference)), - path = mergePathRule (profileRule ^. #path) (typeRule ^. #path) + reference = mergedReference, + path = mergePathRule (profileRule ^. #path) (typeRule ^. #path), + uniqueBy = fromMaybe (profileRule ^. #uniqueBy) (mergeUniqueBy (profileRule ^. #uniqueBy) (typeRule ^. #uniqueBy)), + compiledExternalUriPattern = compileReferenceMatcher mergedReference } + where + mergedReference = fromMaybe (profileRule ^. #reference) (mergeReferenceRule (profileRule ^. #reference) (typeRule ^. #reference)) -- | Normalize a declared condition for storage in a 'PresenceClause': the shape -- is unchanged, but the accepted-value list is deduplicated so that a clause @@ -2949,9 +3258,26 @@ HandleReferenceRule { localPrefix = policy ^. #localPrefix, externalUriSchemes = map Text.toCaseFold (deduplicateSchemes (policy ^. #externalUriSchemes)), - allowSelf = policy ^. #allowSelf + allowSelf = policy ^. #allowSelf, + allowLocal = policy ^. #allowLocal, + externalUriPattern = policy ^. #externalUriPattern } +compileExternalUriPattern :: Text -> Either Text Regex +compileExternalUriPattern patternText = + first Text.pack (Regex.Text.compile defaultCompOpt defaultExecOpt patternText) + +compileReferenceMatcher :: Maybe HandleReferenceRule -> Maybe Regex +compileReferenceMatcher policy = do + patternText <- policy >>= (^. #externalUriPattern) + either (const Nothing) Just (compileExternalUriPattern patternText) + +matchesWholeExternalUriPattern :: Regex -> Text -> Bool +matchesWholeExternalUriPattern regex value = + case Regex.Text.regexec regex value of + Right (Just (before, _matched, after, _groups)) -> Text.null before && Text.null after + _ -> False + compilePathRule :: PathReferenceRule -> PathReferenceRule compilePathRule policy = PathReferenceRule @@ -2992,7 +3318,8 @@ mergeReferenceRule Nothing typePolicy = Just typePolicy mergeReferenceRule profilePolicy Nothing = Just profilePolicy mergeReferenceRule (Just profilePolicy) (Just typePolicy) - | profilePolicy ^. #localPrefix == typePolicy ^. #localPrefix = + | profilePolicy ^. #localPrefix == typePolicy ^. #localPrefix, + Just mergedPattern <- mergeOptionalText (profilePolicy ^. #externalUriPattern) (typePolicy ^. #externalUriPattern) = Just . Just $ HandleReferenceRule { localPrefix = profilePolicy ^. #localPrefix, @@ -3000,10 +3327,22 @@ filter (`Set.member` Set.fromList (typePolicy ^. #externalUriSchemes)) (profilePolicy ^. #externalUriSchemes), - allowSelf = profilePolicy ^. #allowSelf && typePolicy ^. #allowSelf + allowSelf = profilePolicy ^. #allowSelf && typePolicy ^. #allowSelf, + allowLocal = profilePolicy ^. #allowLocal && typePolicy ^. #allowLocal, + externalUriPattern = mergedPattern } | otherwise = Nothing +mergeUniqueBy :: Maybe Text -> Maybe Text -> Maybe (Maybe Text) +mergeUniqueBy = mergeOptionalText + +mergeOptionalText :: Maybe Text -> Maybe Text -> Maybe (Maybe Text) +mergeOptionalText Nothing typeValue = Just typeValue +mergeOptionalText profileValue Nothing = Just profileValue +mergeOptionalText profileValue typeValue + | profileValue == typeValue = Just profileValue + | otherwise = Nothing + mergeFieldFormat :: Maybe FieldFormat -> Maybe FieldFormat -> Maybe (Maybe FieldFormat) mergeFieldFormat Nothing typeFormat = Just typeFormat mergeFieldFormat profileFormat Nothing = Just profileFormat @@ -3223,6 +3562,10 @@ MalformedDocumentReference ConceptId FieldPath Value | -- | an absolute external URI uses a scheme the profile did not permit ExternalReferenceSchemeNotAllowed ConceptId FieldPath Text [Text] + | -- | a syntactically valid local handle is prohibited at this field + LocalDocumentReferenceNotAllowed ConceptId FieldPath Text + | -- | an allowed external URI does not match the declared whole-value pattern + ExternalReferencePatternMismatch ConceptId FieldPath Text Text | -- | a local handle, or a bundle path, resolves to the concept carrying it SelfDocumentReference ConceptId FieldPath Text | -- | a path-valued field's value is not one of the three shapes of §6.2 @@ -3235,6 +3578,8 @@ FieldNotInProfile ConceptId Text | -- | a declared list element is not an object record NestedElementNotRecord ConceptId FieldPath Value + | -- | one valid scalar member value occurs in more than one list element + DuplicateNestedFieldValue ConceptId FieldPath Value (NonEmpty Int) | -- | concept's file path does not match the type rule's pattern (concept, type, pattern) PathPatternMismatch ConceptId Text Text | -- | type rule requires a resource scheme but resource is absent (concept, type, scheme) @@ -3386,12 +3731,12 @@ presenceViolations key rule <> maybe [] (vocabularyViolations key rule) actual <> maybe [] (formatViolations key rule) actual - <> maybe [] (referenceViolations key rule) actual + <> maybe [] (referenceViolations (topLevelFieldPath key) rule) actual <> maybe [] (pathViolations (topLevelFieldPath key) rule) actual FieldPresent actual -> vocabularyViolations key rule actual <> formatViolations key rule actual - <> referenceViolations key rule actual + <> referenceViolations (topLevelFieldPath key) rule actual <> pathViolations (topLevelFieldPath key) rule actual <> nestedViolations key rule actual <> objectViolations key rule actual @@ -3415,10 +3760,10 @@ | Just fieldFormat <- [rule ^. #format], not (valueMatchesFormat fieldFormat actual) ] - referenceViolations key rule actual = + referenceViolations fieldPath rule actual = case rule ^. #reference of Nothing -> [] - Just policy -> validateReferenceValue validDocumentIdIndex cid (topLevelFieldPath key) policy actual + Just policy -> validateReferenceValue validDocumentIdIndex cid fieldPath policy (rule ^. #compiledExternalUriPattern) actual -- Takes a 'FieldPath' rather than a key because it is shared by all -- three scopes: a top-level key, a member of a list element, and a @@ -3431,15 +3776,17 @@ nestedViolations parentKey parentRule = \case Array elementValues | Just nestedRules <- parentRule ^. #elementFields -> - concat - [ case elementValue of - Aeson.Object members -> - concatMap - (checkRecordMember (nestedValuePath parentKey elementIndex) members) - (Map.toAscList nestedRules) - _ -> [NestedElementNotRecord cid (nestedElementPath parentKey elementIndex) elementValue] - | (elementIndex, elementValue) <- zip [0 ..] (Vector.toList elementValues) - ] + let indexedElements = zip [0 ..] (Vector.toList elementValues) + in concat + [ case elementValue of + Aeson.Object members -> + concatMap + (checkRecordMember (nestedValuePath parentKey elementIndex) members) + (Map.toAscList nestedRules) + _ -> [NestedElementNotRecord cid (nestedElementPath parentKey elementIndex) elementValue] + | (elementIndex, elementValue) <- indexedElements + ] + <> uniquenessViolations parentKey parentRule nestedRules indexedElements _ -> [] -- The mapping spelling of the same idea. The value /is/ the record, so @@ -3465,10 +3812,12 @@ nestedPresenceViolations members path rule <> maybe [] (nestedVocabularyViolations path rule) actual <> maybe [] (nestedFormatViolations path rule) actual + <> maybe [] (referenceViolations path rule) actual <> maybe [] (pathViolations path rule) actual FieldPresent actual -> nestedVocabularyViolations path rule actual <> nestedFormatViolations path rule actual + <> referenceViolations path rule actual <> pathViolations path rule actual FieldWrongShape actual -> [CardinalityMismatch cid path (rule ^. #cardinality) actual] @@ -3493,6 +3842,32 @@ not (valueMatchesFormat fieldFormat actual) ] + uniquenessViolations parentKey parentRule nestedRules indexedElements = + case parentRule ^. #uniqueBy of + Nothing -> [] + Just key -> + case Map.lookup key nestedRules of + Nothing -> [] + Just keyRule -> + [ DuplicateNestedFieldValue cid (nestedDefinitionPath parentKey key) duplicateValue (firstIndex :| remainingIndices) + | (duplicateValue, firstIndex : remainingIndices) <- groupedValues key keyRule indexedElements, + not (null remainingIndices) + ] + + groupedValues key keyRule = + List.foldl' insertValue [] . mapMaybe participant + where + participant (elementIndex, Aeson.Object members) = + case evaluateFieldValue keyRule (Aeson.KeyMap.lookup (Aeson.Key.fromText key) members) of + FieldPresent scalarValue -> Just (scalarValue, elementIndex) + _ -> Nothing + participant _ = Nothing + + insertValue [] (value, elementIndex) = [(value, [elementIndex])] + insertValue ((groupValue, elementIndices) : remaining) (value, elementIndex) + | groupValue == value = (groupValue, elementIndices <> [elementIndex]) : remaining + | otherwise = (groupValue, elementIndices) : insertValue remaining (value, elementIndex) + checkUnknownFields cid ctype concept | spec ^. #allowUnknownFields = [] | otherwise = @@ -3527,22 +3902,24 @@ documentId ^. #prefix == expectedPrefix ] -validateReferenceValue :: Map DocumentId [ConceptId] -> ConceptId -> FieldPath -> HandleReferenceRule -> Value -> [ProfileViolation] -validateReferenceValue validOwners sourceConcept path policy = \case - String rawReference -> validateReferenceText validOwners sourceConcept path policy rawReference +validateReferenceValue :: Map DocumentId [ConceptId] -> ConceptId -> FieldPath -> HandleReferenceRule -> Maybe Regex -> Value -> [ProfileViolation] +validateReferenceValue validOwners sourceConcept path policy matcher = \case + String rawReference -> validateReferenceText validOwners sourceConcept path policy matcher rawReference Array values -> concat [ case value of - String rawReference -> validateReferenceText validOwners sourceConcept (appendArrayIndex path elementIndex) policy rawReference + String rawReference -> validateReferenceText validOwners sourceConcept (appendArrayIndex path elementIndex) policy matcher rawReference _ -> [MalformedDocumentReference sourceConcept (appendArrayIndex path elementIndex) value] | (elementIndex, value) <- zip [0 ..] (Vector.toList values) ] actual -> [MalformedDocumentReference sourceConcept path actual] -validateReferenceText :: Map DocumentId [ConceptId] -> ConceptId -> FieldPath -> HandleReferenceRule -> Text -> [ProfileViolation] -validateReferenceText validOwners sourceConcept path policy rawReference = +validateReferenceText :: Map DocumentId [ConceptId] -> ConceptId -> FieldPath -> HandleReferenceRule -> Maybe Regex -> Text -> [ProfileViolation] +validateReferenceText validOwners sourceConcept path policy matcher rawReference = case parseDocumentId rawReference of Just documentId + | not (policy ^. #allowLocal) -> + [LocalDocumentReferenceNotAllowed sourceConcept path rawReference] | documentId ^. #prefix /= policy ^. #localPrefix -> [ReferenceHandlePrefixMismatch sourceConcept path rawReference (policy ^. #localPrefix)] | otherwise -> @@ -3556,7 +3933,14 @@ Nothing -> case parseURI (Text.unpack rawReference) of Just parsed - | not (Text.null normalizedScheme), normalizedScheme `elem` policy ^. #externalUriSchemes -> [] + | not (Text.null normalizedScheme), + normalizedScheme `elem` policy ^. #externalUriSchemes -> + case (policy ^. #externalUriPattern, matcher) of + (Nothing, _) -> [] + (Just patternText, Just compiledPattern) + | matchesWholeExternalUriPattern compiledPattern rawReference -> [] + | otherwise -> [ExternalReferencePatternMismatch sourceConcept path rawReference patternText] + (Just patternText, Nothing) -> [ExternalReferencePatternMismatch sourceConcept path rawReference patternText] | not (Text.null normalizedScheme) -> [ ExternalReferenceSchemeNotAllowed sourceConcept diff --git a/src/Okf/Profile/Documentation.hs b/src/Okf/Profile/Documentation.hs --- a/src/Okf/Profile/Documentation.hs +++ b/src/Okf/Profile/Documentation.hs @@ -412,7 +412,8 @@ "- Cardinality: " <> renderCardinalityName (fieldRuleCardinality rule), "- Format: " <> maybe "none" renderFieldFormatName (fieldRuleFormat rule), "- Reference: " <> maybe "none" renderReference (fieldRuleReference rule), - "- Path: " <> maybe "none" renderPathRule (fieldRulePath rule) + "- Path: " <> maybe "none" renderPathRule (fieldRulePath rule), + "- Unique by: " <> maybe "none" code (fieldRuleUniqueBy rule) ] <> conditionBullets <> objectFieldBullets @@ -455,13 +456,13 @@ -- | Nested element rules are depth-bounded at one level, so this is flat by -- construction: 'fieldRuleElementFields' on a nested rule is always 'Nothing'. -- --- The path clause is emitted only when the member declares one, unlike the --- fixed bullet list of 'renderFieldRule'. This line is already a dense --- semicolon-separated run and a member declares no path policy far more often --- than not, so a @path: none@ on every member of every record would cost more --- than it says. A nested path policy is nevertheless the motivating case for --- path rules — @sources[].resource@ lives here — so it must be visible when it --- is there. +-- The reference and path clauses are emitted only when the member declares +-- them, unlike the fixed bullet list of 'renderFieldRule'. This line is already +-- a dense semicolon-separated run and most members declare neither policy, so +-- @reference: none; path: none@ on every member of every record would cost more +-- than it says. Both policies are nevertheless meaningful at nested scope — +-- @dependencies[].ref@ and @sources[].resource@ live here — so each must be +-- visible when it is present. renderElementField :: Text -> EffectiveFieldRule -> Text renderElementField key rule = code key @@ -473,6 +474,7 @@ "cardinality: " <> renderCardinalityName (fieldRuleCardinality rule), "format: " <> maybe "none" renderFieldFormatName (fieldRuleFormat rule) ] + <> foldMap (\policy -> ["reference: " <> renderReference policy]) (fieldRuleReference rule) <> foldMap (\policy -> ["path: " <> renderPathRule policy]) (fieldRulePath rule) ) <> maybe "" (" — " <>) (nonBlank (fieldRuleDescription rule)) @@ -506,11 +508,17 @@ renderReference policy = Text.intercalate "; " - [ "local handles with prefix " <> code (policy ^. #localPrefix), - externalPhrase, - if policy ^. #allowSelf then "self-reference allowed" else "self-reference not allowed" - ] + ( [ "local handles with prefix " <> code (policy ^. #localPrefix), + externalPhrase, + localPermissionPhrase, + if policy ^. #allowSelf then "self-reference allowed" else "self-reference not allowed" + ] + <> foldMap (\patternText -> ["external URI whole-value pattern " <> code patternText]) (policy ^. #externalUriPattern) + ) where + localPermissionPhrase = + if policy ^. #allowLocal then "local handles allowed" else "local handles prohibited" + externalPhrase = case policy ^. #externalUriSchemes of [] -> "external URIs not allowed" diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -7,6 +7,7 @@ import Data.List qualified as List import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map +import Data.Maybe (catMaybes) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.IO qualified as Text.IO @@ -149,6 +150,7 @@ testIO "fixture attested computation bundle reports one missing runtime and no path problem" testFixtureAttestedComputation, testIO "loadProfileFile decodes the postgresql fixture" testLoadProfileFixture, testIO "loadProfileFile decodes record-completed document ID rules" testLoadDocumentIdProfileFixture, + testIO "loadProfileFile exposes nested reference and uniqueness declarations" testLoadNestedReferenceProfileFixture, testIO "loadProfileFile accepts the pre-type-frontmatter described schema" testLoadDescribedProfileFixture, testIO "loadProfileFile accepts the frozen EP-1 type-aware schema" testLoadTypeAwareCompatibilityFixture, testIO "loadProfileFile accepts the frozen EP-2 vocabulary schema" testLoadVocabularyCompatibilityFixture, @@ -159,6 +161,7 @@ testIO "loadProfileFile decodes same-scope conditions" testLoadConditionalFieldsProfileFixture, testIO "loadProfileFile preserves the frozen condition-aware schema" testLoadConditionalCompatibilityFixture, testIO "loadProfileFile preserves the frozen reference-aware schema" testLoadReferenceCompatibilityFixture, + testIO "loadProfileFile preserves the complete 0.7.0.0 descriptor schema" testLoadPreNestedReferenceCompatibilityFixture, testIO "every frozen generation fixture compiles, not merely decodes" testFrozenFixturesCompile, testIO "loadProfileFile preserves the frozen pre-bundle-version schema" testLoadPreBundleVersionCompatibilityFixture, testIO "loadProfileFile preserves the frozen pre-path schema" testLoadPrePathCompatibilityFixture, @@ -207,6 +210,7 @@ test "profile value display names match the documented vocabulary" testProfileValueDisplayNames, testIO "profile documentation renders a root concept" testProfileDocumentationRootConcept, test "profile documentation renders object rules" testProfileDocumentationObjectFields, + testIO "profile documentation renders nested references and list uniqueness" testProfileDocumentationNestedReferenceAndUniqueness, test "profile documentation renders a required bundle version" testProfileDocumentationRequiredBundleVersion, testIO "profile documentation renders one concept per declared type" testProfileDocumentationTypeConcept, testIO "profile documentation renders inherited rules for a bare type" testProfileDocumentationInheritedRules, @@ -261,6 +265,9 @@ test "nested conditions use siblings and avoid cascading diagnostics" testNestedConditionalPresence, test "compileProfile rejects invalid document reference policies" testReferenceDefinitionErrors, test "document references resolve local handles and explicit external URIs" testDocumentReferenceValidation, + testIO "compileProfile exposes nested references and record-list uniqueness" testCompileNestedReferenceAndUniqueness, + testIO "nested references and record-list uniqueness validate in layers" testNestedReferenceAndUniquenessValidation, + testIO "compileProfile rejects invalid nested reference and uniqueness declarations" testNestedReferenceAndUniquenessDefinitionErrors, test "optional fields are never missing but are fully value-checked" testOptionalFieldPresence, test "optional reference fields resolve handles when present" testOptionalReferenceValidation, test "optional nested fields are never missing inside records" testOptionalNestedFieldPresence, @@ -2483,6 +2490,46 @@ [Just "The OKF concept type; must be a type rule below.", Nothing] (map (^. #description) (spec ^. #frontmatter . #required)) +testLoadNestedReferenceProfileFixture :: IO (Either Text ()) +testLoadNestedReferenceProfileFixture = do + path <- fixtureFilePath "profiles/nested-references-and-uniqueness.dhall" + result <- loadProfileFile path + pure $ case result of + Left err -> Left ("failed to load nested reference profile: " <> err) + Right spec -> do + dependencies <- lookupRawRule "dependencies" (spec ^. #frontmatter . #required) + acceptanceCriteria <- lookupRawRule "acceptanceCriteria" (spec ^. #frontmatter . #required) + assertEqual (Just "id") (acceptanceCriteria ^. #uniqueBy) + case dependencies ^. #elementFields of + Just NestedRules {required = [nestedReferenceRule]} -> do + let expectedPolicy = + HandleReferenceRule + "IR" + ["mori"] + False + False + (Just "mori://[^/]+/[^/]+/okf/improvement-requests/concepts/IR-[1-9][0-9]*") + assertEqual (Just expectedPolicy) (nestedReferenceRule ^. #reference) + assertEqual + ( object + [ "field" .= ("ref" :: Text), + "description" .= (Nothing :: Maybe Text), + "allowedValues" .= ([] :: [Text]), + "cardinality" .= ("scalar" :: Text), + "format" .= (Nothing :: Maybe Text), + "when" .= (Nothing :: Maybe FieldCondition), + "path" .= (Nothing :: Maybe PathReferenceRule), + "reference" .= Just expectedPolicy + ] + ) + (toJSON nestedReferenceRule) + _ -> Left "expected dependencies.ref as one required nested rule" + where + lookupRawRule key rules = + case [rule | rule <- rules, rule ^. #field == key] of + [rule] -> Right rule + _ -> Left ("expected one raw rule for " <> key) + testLoadDescribedProfileFixture :: IO (Either Text ()) testLoadDescribedProfileFixture = do path <- fixtureFilePath "profiles/described.dhall" @@ -2622,7 +2669,7 @@ case spec ^. #frontmatter . #recommended of [referenceRule, conditionRule, reviewsRule] -> do assertEqual - (Just (HandleReferenceRule "ADR" ["mori"] False)) + (Just (handleReferenceRule "ADR" ["mori"] False)) (referenceRule ^. #reference) assertEqual (Just (FieldCondition "status" ["superseded"])) (conditionRule ^. #when) case reviewsRule ^. #elementFields of @@ -2690,6 +2737,7 @@ "formats-mp8-ep2.dhall", "path-references-mp8-ep3.dhall", "pre-bundle-version.dhall", + "pre-nested-references-and-uniqueness-0.7.0.0.dhall", -- Not a frozen generation but a *documented* one: this is the descriptor -- @docs\/user\/profiles.md@ shows for the specification §10 contract as a -- house convention. It is listed here so the documented descriptor cannot @@ -2697,6 +2745,30 @@ "attested-computation-house.dhall" ] +testLoadPreNestedReferenceCompatibilityFixture :: IO (Either Text ()) +testLoadPreNestedReferenceCompatibilityFixture = do + path <- fixtureFilePath "profiles/pre-nested-references-and-uniqueness-0.7.0.0.dhall" + result <- loadProfileFile path + pure $ case result of + Left err -> Left ("failed to load frozen 0.7.0.0 profile: " <> err) + Right spec -> do + assertEqual "pre-nested-references-and-uniqueness-0.7.0.0" (spec ^. #name) + assertEqual (Just "0.2") (spec ^. #requireBundleVersion) + let allTopRules = spec ^. #frontmatter . #required <> spec ^. #frontmatter . #recommended <> spec ^. #frontmatter . #optional + assertEqual (replicate (length allTopRules) Nothing) (map (^. #uniqueBy) allTopRules) + case [policy | rule <- allTopRules, Just policy <- [rule ^. #reference]] of + [policy] -> do + assertEqual True (policy ^. #allowLocal) + assertEqual Nothing (policy ^. #externalUriPattern) + _ -> Left "expected exactly one upgraded 0.7.0.0 reference policy" + let nestedRules = + [ nestedRule + | rule <- allTopRules, + rules <- catMaybes [rule ^. #elementFields, rule ^. #objectFields], + nestedRule <- rules ^. #required <> rules ^. #recommended <> rules ^. #optional + ] + assertEqual (replicate (length nestedRules) Nothing) (map (^. #reference) nestedRules) + -- | The generation frozen immediately before @requireBundleVersion@: a descriptor -- with no such member still loads, the member arrives as 'Nothing', and every -- member the frozen descriptor did declare survives the upgrade. The last part is @@ -2720,7 +2792,7 @@ assertEqual (Just "docId") (spec ^. #idField) assertEqual ["type", "generated"] (map (^. #field) (spec ^. #frontmatter . #required)) assertEqual - (Just (HandleReferenceRule "ADR" ["mori"] False)) + (Just (handleReferenceRule "ADR" ["mori"] False)) (case spec ^. #frontmatter . #optional of rule : _ -> rule ^. #reference; [] -> Nothing) assertEqual [Just Profile.HumanActor] @@ -2751,7 +2823,7 @@ (concatMap (map (^. #path) . (^. #frontmatter . #required)) (spec ^. #types)) -- Everything the frozen descriptor did declare survives the upgrade. assertEqual - (Just (HandleReferenceRule "ADR" ["mori"] False)) + (Just (handleReferenceRule "ADR" ["mori"] False)) (case spec ^. #frontmatter . #optional of rule : _ -> rule ^. #reference; [] -> Nothing) assertEqual [Just Profile.NonNegativeInteger] @@ -2836,7 +2908,7 @@ case spec ^. #frontmatter . #recommended of [referenceRule, reviewsRule] -> do assertEqual - (Just (HandleReferenceRule "ADR" ["mori"] False)) + (Just (handleReferenceRule "ADR" ["mori"] False)) (referenceRule ^. #reference) case reviewsRule ^. #elementFields of Just NestedRules {required = [kindRule], recommended = [notesRule], optional = [urlRule]} -> do @@ -2931,7 +3003,8 @@ "objectFields" .= (Nothing :: Maybe Value), "reference" .= (Nothing :: Maybe HandleReferenceRule), "path" .= (Nothing :: Maybe PathReferenceRule), - "when" .= (Nothing :: Maybe FieldCondition) + "when" .= (Nothing :: Maybe FieldCondition), + "uniqueBy" .= (Nothing :: Maybe Text) ], object [ "field" .= ("title" :: Text), @@ -2943,7 +3016,8 @@ "objectFields" .= (Nothing :: Maybe Value), "reference" .= (Nothing :: Maybe HandleReferenceRule), "path" .= (Nothing :: Maybe PathReferenceRule), - "when" .= (Nothing :: Maybe FieldCondition) + "when" .= (Nothing :: Maybe FieldCondition), + "uniqueBy" .= (Nothing :: Maybe Text) ] ], "recommended" @@ -2958,7 +3032,8 @@ "objectFields" .= (Nothing :: Maybe Value), "reference" .= (Nothing :: Maybe HandleReferenceRule), "path" .= (Nothing :: Maybe PathReferenceRule), - "when" .= (Nothing :: Maybe FieldCondition) + "when" .= (Nothing :: Maybe FieldCondition), + "uniqueBy" .= (Nothing :: Maybe Text) ] ], "optional" @@ -2973,7 +3048,8 @@ "objectFields" .= (Nothing :: Maybe Value), "reference" .= (Nothing :: Maybe HandleReferenceRule), "path" .= (Nothing :: Maybe PathReferenceRule), - "when" .= (Nothing :: Maybe FieldCondition) + "when" .= (Nothing :: Maybe FieldCondition), + "uniqueBy" .= (Nothing :: Maybe Text) ] ] ], @@ -3022,10 +3098,12 @@ ( object [ "localPrefix" .= ("ADR" :: Text), "externalUriSchemes" .= (["mori", "https"] :: [Text]), - "allowSelf" .= False + "allowSelf" .= False, + "allowLocal" .= True, + "externalUriPattern" .= (Nothing :: Maybe Text) ] ) - (toJSON (HandleReferenceRule "ADR" ["mori", "https"] False)) + (toJSON (handleReferenceRule "ADR" ["mori", "https"] False)) -- | A registry record enumerates every field that decodes as a profile, one -- level down as well as at the top, sorted by export path. The @Profile@ schema @@ -3434,7 +3512,7 @@ -- | An undocumented frontmatter key: the validation tests care about names, not -- prose, and descriptions never affect validation. requiredField :: Text -> FieldRule -requiredField key = FieldRule {field = key, description = Nothing, allowedValues = [], cardinality = Any, format = Nothing, elementFields = Nothing, objectFields = Nothing, reference = Nothing, path = Nothing, when = Nothing} +requiredField key = FieldRule {field = key, description = Nothing, allowedValues = [], cardinality = Any, format = Nothing, elementFields = Nothing, objectFields = Nothing, reference = Nothing, path = Nothing, when = Nothing, uniqueBy = Nothing} -- | Build a 'FieldRule' positionally in the argument order this file used -- before 'FieldRule' gained @objectFields@, filling that member in as @@ -3463,9 +3541,33 @@ objectFields = Nothing, reference, path = Nothing, - when = condition + when = condition, + uniqueBy = Nothing } +handleReferenceRule :: Text -> [Text] -> Bool -> HandleReferenceRule +handleReferenceRule prefix schemes selfAllowed = + HandleReferenceRule + { localPrefix = prefix, + externalUriSchemes = schemes, + allowSelf = selfAllowed, + allowLocal = True, + externalUriPattern = Nothing + } + +nestedFieldRule :: Text -> Maybe Text -> [Text] -> Cardinality -> Maybe FieldFormat -> Maybe PathReferenceRule -> Maybe FieldCondition -> NestedFieldRule +nestedFieldRule key description allowedValues cardinality format path condition = + NestedFieldRule + { field = key, + description, + allowedValues, + cardinality, + format, + path, + when = condition, + reference = Nothing + } + -- | A standalone profile literal so the validation tests do not depend on the -- Dhall fixture. One rule: PostgreSQL Table, fully constrained. testProfileSpec :: ProfileSpec @@ -4044,15 +4146,15 @@ testCompiledNestedRules = do let profileRules = NestedRules - { required = [NestedFieldRule "kind" Nothing ["decision", "implementation"] Any Nothing Nothing Nothing], - recommended = [NestedFieldRule "notes" Nothing [] Scalar Nothing Nothing Nothing], + { required = [nestedFieldRule "kind" Nothing ["decision", "implementation"] Any Nothing Nothing Nothing], + recommended = [nestedFieldRule "notes" Nothing [] Scalar Nothing Nothing Nothing], optional = [] } typeRules = NestedRules { required = - [ NestedFieldRule "kind" Nothing ["implementation", "operations"] Any Nothing Nothing Nothing, - NestedFieldRule "outcome" Nothing ["approved", "rejected"] Any Nothing Nothing Nothing + [ nestedFieldRule "kind" Nothing ["implementation", "operations"] Any Nothing Nothing Nothing, + nestedFieldRule "outcome" Nothing ["approved", "rejected"] Any Nothing Nothing Nothing ], recommended = [], optional = [] @@ -4181,15 +4283,15 @@ nestedRules = NestedRules { required = - [ NestedFieldRule "kind" Nothing ["human", "model"] Any Nothing Nothing Nothing, - NestedFieldRule "reviewer" Nothing [] Scalar Nothing Nothing Nothing, - NestedFieldRule "reviewed_at" Nothing [] Any (Just Rfc3339Utc) Nothing Nothing, - NestedFieldRule "document_timestamp" Nothing [] Any (Just Rfc3339Utc) Nothing Nothing, - NestedFieldRule "scope" Nothing reviewScopes Any Nothing Nothing Nothing, - NestedFieldRule "outcome" Nothing ["approved", "changes-requested", "commented"] Any Nothing Nothing Nothing, - NestedFieldRule "context" Nothing [] Scalar Nothing Nothing Nothing + [ nestedFieldRule "kind" Nothing ["human", "model"] Any Nothing Nothing Nothing, + nestedFieldRule "reviewer" Nothing [] Scalar Nothing Nothing Nothing, + nestedFieldRule "reviewed_at" Nothing [] Any (Just Rfc3339Utc) Nothing Nothing, + nestedFieldRule "document_timestamp" Nothing [] Any (Just Rfc3339Utc) Nothing Nothing, + nestedFieldRule "scope" Nothing reviewScopes Any Nothing Nothing Nothing, + nestedFieldRule "outcome" Nothing ["approved", "changes-requested", "commented"] Any Nothing Nothing Nothing, + nestedFieldRule "context" Nothing [] Scalar Nothing Nothing Nothing ], - recommended = [NestedFieldRule "notes" Nothing [] Scalar Nothing Nothing Nothing], + recommended = [nestedFieldRule "notes" Nothing [] Scalar Nothing Nothing Nothing], optional = [] } @@ -4221,7 +4323,8 @@ objectFields = objectRules, reference = Nothing, path = Nothing, - when = Nothing + when = Nothing, + uniqueBy = Nothing } ], recommended = [], @@ -4239,8 +4342,8 @@ provenanceMemberRules :: NestedRules provenanceMemberRules = NestedRules - { required = [NestedFieldRule "by" (Just "Who or what produced this content.") [] Any Nothing Nothing Nothing], - recommended = [NestedFieldRule "at" Nothing [] Any (Just Rfc3339Utc) Nothing Nothing], + { required = [nestedFieldRule "by" (Just "Who or what produced this content.") [] Any Nothing Nothing Nothing], + recommended = [nestedFieldRule "at" Nothing [] Any (Just Rfc3339Utc) Nothing Nothing], optional = [] } @@ -4370,7 +4473,7 @@ memberRules = NestedRules { required = - [ (NestedFieldRule "resource" Nothing [] Any Nothing Nothing Nothing) + [ (nestedFieldRule "resource" Nothing [] Any Nothing Nothing Nothing) { path = Just (PathReferenceRule permittedSchemes False) } ], @@ -4435,7 +4538,7 @@ ( pathProfileWith (Just (PathReferenceRule [] False)) Nothing - (Just (HandleReferenceRule "ADR" [] False)) + (Just (handleReferenceRule "ADR" [] False)) Nothing ) ) @@ -4655,7 +4758,7 @@ ( Just NestedRules { required = - [ (NestedFieldRule "resource" Nothing [] Any Nothing Nothing Nothing) + [ (nestedFieldRule "resource" Nothing [] Any Nothing Nothing Nothing) { path = Just (PathReferenceRule [] False) } ], @@ -4891,8 +4994,8 @@ let nestedCrossScope = NestedRules { required = - [ NestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing Nothing, - NestedFieldRule "provider" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "status" ["active"])) + [ nestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing Nothing, + nestedFieldRule "provider" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "status" ["active"])) ], recommended = [], optional = [] @@ -4973,11 +5076,11 @@ let nestedRules = NestedRules { required = - [ NestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing Nothing, - NestedFieldRule "provider" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "kind" ["model"])) + [ nestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing Nothing, + nestedFieldRule "provider" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "kind" ["model"])) ], recommended = - [NestedFieldRule "notes" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "kind" ["human"]))], + [nestedFieldRule "notes" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "kind" ["human"]))], optional = [] } spec = nestedProfileWithRules List nestedRules Nothing @@ -5010,7 +5113,7 @@ Scalar fieldFormat Nothing - (Just (HandleReferenceRule prefix schemes False)) + (Just (handleReferenceRule prefix schemes False)) Nothing baseType = firstTypeRule testDocumentIdProfileSpec specWith profileIdField typeRules profileRules = @@ -5051,10 +5154,215 @@ (Left (ConflictingReferencePrefix "Decision Record" path "ADR" "RFC" :| [])) (compileProfile conflictSpec) +testCompileNestedReferenceAndUniqueness :: IO (Either Text ()) +testCompileNestedReferenceAndUniqueness = do + loaded <- loadNestedReferenceSpec + pure $ do + spec <- loaded + compiled <- firstShow (compileProfile spec) + dependencies <- lookupBaseRule compiled "dependencies" + acceptanceCriteria <- lookupBaseRule compiled "acceptanceCriteria" + assertEqual (Just "id") (fieldRuleUniqueBy acceptanceCriteria) + case fieldRuleElementFields dependencies >>= Map.lookup "ref" of + Nothing -> Left "expected a compiled dependencies.ref rule" + Just referenceRule -> + assertEqual + ( Just + ( HandleReferenceRule + "IR" + ["mori"] + False + False + (Just nestedReferencePattern) + ) + ) + (fieldRuleReference referenceRule) + +testNestedReferenceAndUniquenessValidation :: IO (Either Text ()) +testNestedReferenceAndUniquenessValidation = do + loaded <- loadNestedReferenceSpec + validRoot <- fixturePath "profile-nested-references-and-uniqueness-valid" + invalidRoot <- fixturePath "profile-nested-references-and-uniqueness-invalid" + validConcepts <- readBundle validRoot + invalidConcepts <- readBundle invalidRoot + pure $ do + spec <- loaded + compiled <- firstShow (compileProfile spec) + assertEqual [] (validateProfile PermissiveConformance compiled validConcepts) + duplicateId <- parseTestConceptId "requests/duplicate" + assertEqual + [DuplicateNestedFieldValue duplicateId (objectMemberPath "acceptanceCriteria" "id") (String "AC-1") (0 :| [1])] + (validateProfile PermissiveConformance compiled invalidConcepts) + assertReferenceCase compiled "local" "IR-1" (LocalDocumentReferenceNotAllowed <$> pureCaseId "local" <*> pure (nestedTestPathFor "dependencies" 0 "ref") <*> pure "IR-1") + assertReferenceCase compiled "scheme" "https://example.test/IR-1" (ExternalReferenceSchemeNotAllowed <$> pureCaseId "scheme" <*> pure (nestedTestPathFor "dependencies" 0 "ref") <*> pure "https" <*> pure ["mori"]) + assertPatternCase compiled "artifact-kind" "mori://namespace/project/okf/decisions/concepts/IR-1" + assertPatternCase compiled "leading-zero" "mori://namespace/project/okf/improvement-requests/concepts/IR-01" + assertPatternCase compiled "query" "mori://namespace/project/okf/improvement-requests/concepts/IR-1?x=1" + assertPatternCase compiled "fragment" "mori://namespace/project/okf/improvement-requests/concepts/IR-1#x" + malformed <- referenceConcept "malformed" "not a reference" ["AC-1", "AC-2"] + malformedId <- parseTestConceptId "requests/malformed" + assertEqual + [MalformedDocumentReference malformedId (nestedTestPathFor "dependencies" 0 "ref") (String "not a reference")] + (validateProfile PermissiveConformance compiled [malformed]) + grouped <- referenceConcept "groups" canonicalNestedReference ["AC-1", "AC-2", "AC-1", "AC-2"] + groupedId <- parseTestConceptId "requests/groups" + assertEqual + [ DuplicateNestedFieldValue groupedId (objectMemberPath "acceptanceCriteria" "id") (String "AC-1") (0 :| [2]), + DuplicateNestedFieldValue groupedId (objectMemberPath "acceptanceCriteria" "id") (String "AC-2") (1 :| [3]) + ] + (validateProfile PermissiveConformance compiled [grouped]) + where + pureCaseId name = parseTestConceptId ("requests/" <> name) + + assertReferenceCase compiled name raw expectedAction = do + concept <- referenceConcept name raw ["AC-1", "AC-2"] + expected <- expectedAction + assertEqual [expected] (validateProfile PermissiveConformance compiled [concept]) + + assertPatternCase compiled name raw = do + cid <- parseTestConceptId ("requests/" <> name) + assertReferenceCase + compiled + name + raw + (Right (ExternalReferencePatternMismatch cid (nestedTestPathFor "dependencies" 0 "ref") raw nestedReferencePattern)) + +testNestedReferenceAndUniquenessDefinitionErrors :: IO (Either Text ()) +testNestedReferenceAndUniquenessDefinitionErrors = do + loaded <- loadNestedReferenceSpec + pure $ do + spec <- loaded + dependencies <- lookupRaw "dependencies" spec + acceptance <- lookupRaw "acceptanceCriteria" spec + let invalidPattern = updateNestedRule "ref" (\rule -> rule {reference = setPattern "[" <$> rule ^. #reference}) dependencies + invalidPatternSpec = replaceBaseRule invalidPattern spec + assertSingleDefinitionError + (\case InvalidExternalUriPattern Nothing path "[" _ -> path == objectMemberPath "dependencies" "ref"; _ -> False) + (compileProfile invalidPatternSpec) + + let typePattern = updateNestedRule "ref" (\rule -> rule {reference = setPattern "mori://different" <$> rule ^. #reference}) dependencies + patternConflictSpec = addTypeRule typePattern spec + assertSingleDefinitionError + (== ConflictingExternalUriPatterns "Improvement Request" (objectMemberPath "dependencies" "ref") nestedReferencePattern "mori://different") + (compileProfile patternConflictSpec) + + let noElements = (requiredField "plainRecords") {uniqueBy = Just "id"} + assertSingleDefinitionError + (== UniqueByRequiresElementFields Nothing (fieldPath "plainRecords") "id") + (compileProfile (replaceBaseRule noElements spec)) + + let missingMember = acceptance {uniqueBy = Just "missing"} + assertSingleDefinitionError + (== UniqueByFieldNotDeclared Nothing (objectMemberPath "acceptanceCriteria" "missing")) + (compileProfile (replaceBaseRule missingMember spec)) + + let optionalMember = updateNestedPresence "id" acceptance + assertSingleDefinitionError + (== UniqueByFieldNotUnconditionallyRequired Nothing (objectMemberPath "acceptanceCriteria" "id")) + (compileProfile (replaceBaseRule optionalMember spec)) + + let listMember = updateNestedRule "id" (\rule -> rule {cardinality = List}) acceptance + assertSingleDefinitionError + (== UniqueByFieldNotScalar Nothing (objectMemberPath "acceptanceCriteria" "id") List) + (compileProfile (replaceBaseRule listMember spec)) + + let conflictingUnique = acceptance {uniqueBy = Just "text"} + assertSingleDefinitionError + (== ConflictingUniqueBy "Improvement Request" (fieldPath "acceptanceCriteria") "id" "text") + (compileProfile (addTypeRule conflictingUnique spec)) + where + setPattern :: Text -> HandleReferenceRule -> HandleReferenceRule + setPattern patternText policy = policy {externalUriPattern = Just patternText} + + lookupRaw :: Text -> ProfileSpec -> Either Text FieldRule + lookupRaw key spec = + case [rule | rule <- spec ^. #frontmatter . #required, rule ^. #field == key] of + [rule] -> Right rule + _ -> Left ("expected one raw rule for " <> key) + + replaceBaseRule :: FieldRule -> ProfileSpec -> ProfileSpec + replaceBaseRule replacement spec = + spec + { frontmatter = + (spec ^. #frontmatter) + { required = replacement : filter ((/= replacement ^. #field) . (^. #field)) (spec ^. #frontmatter . #required) + } + } + + addTypeRule :: FieldRule -> ProfileSpec -> ProfileSpec + addTypeRule typeField spec = + spec + { types = + [ typeRule + { frontmatter = FrontmatterRules {required = [typeField], recommended = [], optional = []} + } + | typeRule <- spec ^. #types + ] + } + + updateNestedRule :: Text -> (NestedFieldRule -> NestedFieldRule) -> FieldRule -> FieldRule + updateNestedRule key change parent = + parent {elementFields = updateRules <$> parent ^. #elementFields} + where + updateRules :: NestedRules -> NestedRules + updateRules rules = + rules + { required = map update (rules ^. #required), + recommended = map update (rules ^. #recommended), + optional = map update (rules ^. #optional) + } + update rule | rule ^. #field == key = change rule + update rule = rule + + updateNestedPresence :: Text -> FieldRule -> FieldRule + updateNestedPresence key parent = + parent {elementFields = move <$> parent ^. #elementFields} + where + move :: NestedRules -> NestedRules + move rules = + let (selected, remaining) = List.partition ((== key) . (^. #field)) (rules ^. #required) + in rules {required = remaining, optional = selected <> rules ^. #optional} + + assertSingleDefinitionError matches = \case + Left (definitionError :| []) | matches definitionError -> Right () + Left errors -> Left ("unexpected definition errors: " <> Text.pack (show (toList errors))) + Right _ -> Left "expected profile definition to fail" + +loadNestedReferenceSpec :: IO (Either Text ProfileSpec) +loadNestedReferenceSpec = do + descriptorPath <- fixtureFilePath "profiles/nested-references-and-uniqueness.dhall" + first ("failed to load nested reference profile: " <>) <$> loadProfileFile descriptorPath + +nestedReferencePattern :: Text +nestedReferencePattern = "mori://[^/]+/[^/]+/okf/improvement-requests/concepts/IR-[1-9][0-9]*" + +canonicalNestedReference :: Text +canonicalNestedReference = "mori://namespace/project/okf/improvement-requests/concepts/IR-9" + +referenceConcept :: Text -> Text -> [Text] -> Either Text Concept +referenceConcept name rawReference criterionIds = + profileConcept + ("requests/" <> name) + [ ("type", String "Improvement Request"), + ("requestId", String "IR-1"), + ("dependencies", toJSON [object ["ref" .= rawReference]]), + ( "acceptanceCriteria", + toJSON + [ object ["id" .= criterionId, "text" .= ("Criterion " <> criterionId)] + | criterionId <- criterionIds + ] + ) + ] + "# Request\n" + +nestedTestPathFor :: Text -> Int -> Text -> FieldPath +nestedTestPathFor parent elementIndex child = + FieldPath (FieldName parent :| [ArrayIndex elementIndex, FieldName child]) + testDocumentReferenceValidation :: Either Text () testDocumentReferenceValidation = do - let referencePolicy = HandleReferenceRule "ADR" ["mori", "MORI"] False - selfPolicy = HandleReferenceRule "ADR" [] True + let referencePolicy = handleReferenceRule "ADR" ["mori", "MORI"] False + selfPolicy = handleReferenceRule "ADR" [] True referenceRules = [ fieldRule "references" Nothing [] List Nothing Nothing (Just referencePolicy) Nothing, fieldRule "selfReference" Nothing [] Scalar Nothing Nothing (Just selfPolicy) Nothing @@ -5191,7 +5499,7 @@ .~ FrontmatterRules { required = [requiredField "type", requiredField "title"], recommended = [], - optional = [fieldRule "supersedes" Nothing [] Scalar Nothing Nothing (Just (HandleReferenceRule "ADR" [] False)) Nothing] + optional = [fieldRule "supersedes" Nothing [] Scalar Nothing Nothing (Just (handleReferenceRule "ADR" [] False)) Nothing] } compiled <- firstShow (compileProfile spec) target <- decisionTestConcept "decisions/target" "Target" "ADR-1" [] @@ -5210,9 +5518,9 @@ testOptionalNestedFieldPresence = do let nestedRules = NestedRules - { required = [NestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing Nothing], - recommended = [NestedFieldRule "notes" Nothing [] Scalar Nothing Nothing Nothing], - optional = [NestedFieldRule "model" Nothing ["opus", "sonnet"] Scalar Nothing Nothing Nothing] + { required = [nestedFieldRule "kind" Nothing ["human", "model"] Scalar Nothing Nothing Nothing], + recommended = [nestedFieldRule "notes" Nothing [] Scalar Nothing Nothing Nothing], + optional = [nestedFieldRule "model" Nothing ["opus", "sonnet"] Scalar Nothing Nothing Nothing] } compiled <- firstShow (compileProfile (nestedProfileWithRules Any nestedRules Nothing)) concept <- @@ -5315,9 +5623,9 @@ ) let nestedRules = NestedRules - { required = [NestedFieldRule "kind" Nothing ["model"] Scalar Nothing Nothing Nothing], + { required = [nestedFieldRule "kind" Nothing ["model"] Scalar Nothing Nothing Nothing], recommended = [], - optional = [NestedFieldRule "model" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "kind" ["model"]))] + optional = [nestedFieldRule "model" Nothing [] Scalar Nothing Nothing (Just (FieldCondition "kind" ["model"]))] } assertEqual (Left (OptionalFieldWithCondition Nothing (FieldPath (FieldName "reviews" :| [FieldName "model"])) :| [])) @@ -5956,7 +6264,7 @@ (presenceSummary supersededByRule) supersedesRule <- lookupCompiledRule "supersedes" rules assertEqual - (Just (HandleReferenceRule "ADR" [] False)) + (Just (handleReferenceRule "ADR" [] False)) (fieldRuleReference supersedesRule) reviewsRule <- lookupCompiledRule "reviews" rules nested <- maybe (Left "reviews declares no element fields") Right (fieldRuleElementFields reviewsRule) @@ -6143,6 +6451,23 @@ -- list never shifts between rules. assertHasLine "- Object fields: none" bodyLines +-- | Nested reference and parent uniqueness policies are compiled constraints, +-- so generated documentation must expose both rather than silently dropping +-- the rule kind that lives below the top-level field. +testProfileDocumentationNestedReferenceAndUniqueness :: IO (Either Text ()) +testProfileDocumentationNestedReferenceAndUniqueness = + withRenderedProfileDocumentation + "profiles/nested-references-and-uniqueness.dhall" + defaultDocumentationOptions + ( \_compiled concepts -> do + typeConcept <- conceptAt 1 concepts + let bodyLines = conceptBodyLines typeConcept + assertHasLine + " - `ref` — required; allowed values: any; cardinality: scalar; format: none; reference: local handles with prefix `IR`; external URIs with scheme `mori`; local handles prohibited; self-reference not allowed; external URI whole-value pattern `mori://[^/]+/[^/]+/okf/improvement-requests/concepts/IR-[1-9][0-9]*`" + bodyLines + assertHasLine "- Unique by: `id`" bodyLines + ) + testProfileDocumentationTypeConcept :: IO (Either Text ()) testProfileDocumentationTypeConcept = withRenderedProfileDocumentation @@ -6168,7 +6493,7 @@ " - `kind` — required; allowed values: `human`, `model`; cardinality: scalar; format: none" bodyLines assertHasLine - "- Reference: local handles with prefix `ADR`; external URIs not allowed; self-reference not allowed" + "- Reference: local handles with prefix `ADR`; external URIs not allowed; local handles allowed; self-reference not allowed" bodyLines -- The profile-scope optional key must appear on the type page, under -- Optional: this is the merge being visible, which is the whole point. diff --git a/test/fixtures/profile-nested-references-and-uniqueness-invalid/requests/duplicate.md b/test/fixtures/profile-nested-references-and-uniqueness-invalid/requests/duplicate.md new file mode 100644 --- /dev/null +++ b/test/fixtures/profile-nested-references-and-uniqueness-invalid/requests/duplicate.md @@ -0,0 +1,13 @@ +--- +type: Improvement Request +requestId: IR-1 +dependencies: + - ref: mori://namespace/project/okf/improvement-requests/concepts/IR-9 +acceptanceCriteria: + - id: AC-1 + text: The first occurrence. + - id: AC-1 + text: The duplicate occurrence. +--- + +# Duplicate criterion IDs diff --git a/test/fixtures/profile-nested-references-and-uniqueness-valid/requests/first.md b/test/fixtures/profile-nested-references-and-uniqueness-valid/requests/first.md new file mode 100644 --- /dev/null +++ b/test/fixtures/profile-nested-references-and-uniqueness-valid/requests/first.md @@ -0,0 +1,13 @@ +--- +type: Improvement Request +requestId: IR-1 +dependencies: + - ref: mori://namespace/project/okf/improvement-requests/concepts/IR-9 +acceptanceCriteria: + - id: AC-1 + text: The first criterion. + - id: AC-2 + text: The second criterion. +--- + +# First request diff --git a/test/fixtures/profile-nested-references-and-uniqueness-valid/requests/second.md b/test/fixtures/profile-nested-references-and-uniqueness-valid/requests/second.md new file mode 100644 --- /dev/null +++ b/test/fixtures/profile-nested-references-and-uniqueness-valid/requests/second.md @@ -0,0 +1,11 @@ +--- +type: Improvement Request +requestId: IR-2 +dependencies: + - ref: mori://namespace/project/okf/improvement-requests/concepts/IR-9 +acceptanceCriteria: + - id: AC-1 + text: IDs are list-local and may be reused by another request. +--- + +# Second request diff --git a/test/fixtures/profiles/nested-references-and-uniqueness.dhall b/test/fixtures/profiles/nested-references-and-uniqueness.dhall new file mode 100644 --- /dev/null +++ b/test/fixtures/profiles/nested-references-and-uniqueness.dhall @@ -0,0 +1,69 @@ +let Profile = ../../../dhall/Profile.dhall + +let FieldRule = ../../../dhall/defaults/FieldRule.dhall + +let NestedFieldRule = ../../../dhall/defaults/NestedFieldRule.dhall + +let HandleReferenceRule = ../../../dhall/defaults/HandleReferenceRule.dhall + +let TypeRule = ../../../dhall/defaults/TypeRule.dhall + +let Cardinality = ../../../dhall/Cardinality.dhall + +let FieldFormat = ../../../dhall/FieldFormat.dhall + +let field = ../../../dhall/mk/FieldRule.dhall + +let dependencyRules = + { required = + [ NestedFieldRule::{ + , field = "ref" + , cardinality = Cardinality.Scalar + , reference = Some HandleReferenceRule::{ + , localPrefix = "IR" + , externalUriSchemes = [ "mori" ] + , allowLocal = False + , externalUriPattern = Some + "mori://[^/]+/[^/]+/okf/improvement-requests/concepts/IR-[1-9][0-9]*" + } + } + ] + , recommended = [] : List NestedFieldRule.Type + , optional = [] : List NestedFieldRule.Type + } + +let acceptanceCriteriaRules = + { required = + [ NestedFieldRule::{ + , field = "id" + , cardinality = Cardinality.Scalar + , format = Some (FieldFormat.DocumentHandle "AC") + } + , NestedFieldRule::{ field = "text", cardinality = Cardinality.Scalar } + ] + , recommended = [] : List NestedFieldRule.Type + , optional = [] : List NestedFieldRule.Type + } + +in { name = "nested-references-and-uniqueness" + , description = Some + "Exercises external-only nested Mori references and list-local acceptance criterion IDs." + , okfVersion = "0.2" + , frontmatter = + { required = + [ field.plain "type" + , field.documentHandle "requestId" "IR" + , field.recordList "dependencies" dependencyRules + , field.recordList "acceptanceCriteria" acceptanceCriteriaRules + // { uniqueBy = Some "id" } + ] + , recommended = [] : List FieldRule.Type + , optional = [] : List FieldRule.Type + } + , allowUnknownTypes = False + , allowUnknownFields = True + , idField = Some "requestId" + , requireBundleVersion = None Text + , types = [ TypeRule::{ type = "Improvement Request", idPrefix = Some "IR" } ] + } + : Profile diff --git a/test/fixtures/profiles/pre-nested-references-and-uniqueness-0.7.0.0.dhall b/test/fixtures/profiles/pre-nested-references-and-uniqueness-0.7.0.0.dhall new file mode 100644 --- /dev/null +++ b/test/fixtures/profiles/pre-nested-references-and-uniqueness-0.7.0.0.dhall @@ -0,0 +1,187 @@ +--| Frozen public descriptor generation from okf-core 0.7.0.0. +-- Every record and union is inline so this fixture cannot silently acquire new +-- members from the live schema. FROZEN: do not edit after release. +let Cardinality = < Any | Scalar | List > + +let FieldFormat = + < Rfc3339Utc + | Date + | Uri + | UriWithScheme : Text + | DocumentHandle : Text + | Actor + | HumanActor + | Integer + | NonNegativeInteger + | Boolean + > + +let FieldCondition = { field : Text, hasValue : List Text } + +let HandleReferenceRule = + { localPrefix : Text + , externalUriSchemes : List Text + , allowSelf : Bool + } + +let PathReferenceRule = { externalUriSchemes : List Text, allowSelf : Bool } + +let NestedFieldRule = + { field : Text + , description : Optional Text + , allowedValues : List Text + , cardinality : Cardinality + , format : Optional FieldFormat + , path : Optional PathReferenceRule + , when : Optional FieldCondition + } + +let NestedRules = + { required : List NestedFieldRule + , recommended : List NestedFieldRule + , optional : List NestedFieldRule + } + +let FieldRule = + { field : Text + , description : Optional Text + , allowedValues : List Text + , cardinality : Cardinality + , format : Optional FieldFormat + , elementFields : Optional NestedRules + , objectFields : Optional NestedRules + , reference : Optional HandleReferenceRule + , path : Optional PathReferenceRule + , when : Optional FieldCondition + } + +let FrontmatterRules = + { required : List FieldRule + , recommended : List FieldRule + , optional : List FieldRule + } + +let TypeRule = + { type : Text + , description : Optional Text + , frontmatter : FrontmatterRules + , pathPattern : Optional Text + , resourceScheme : Optional Text + , requireSchemaSection : Bool + , schemaColumns : List Text + , idPrefix : Optional Text + } + +let Profile = + { name : Text + , description : Optional Text + , okfVersion : Text + , frontmatter : FrontmatterRules + , allowUnknownTypes : Bool + , allowUnknownFields : Bool + , idField : Optional Text + , requireBundleVersion : Optional Text + , types : List TypeRule + } + +let plain = + \(field : Text) -> + { field + , description = None Text + , allowedValues = [] : List Text + , cardinality = Cardinality.Any + , format = None FieldFormat + , elementFields = None NestedRules + , objectFields = None NestedRules + , reference = None HandleReferenceRule + , path = None PathReferenceRule + , when = None FieldCondition + } + +let nestedPlain = + \(field : Text) -> + { field + , description = None Text + , allowedValues = [] : List Text + , cardinality = Cardinality.Any + , format = None FieldFormat + , path = None PathReferenceRule + , when = None FieldCondition + } + +in { name = "pre-nested-references-and-uniqueness-0.7.0.0" + , description = Some "The complete public 0.7.0.0 descriptor shape." + , okfVersion = "0.2" + , frontmatter = + { required = + [ plain "type" + , plain "sources" + // { cardinality = Cardinality.List + , elementFields = Some + { required = + [ nestedPlain "resource" + // { cardinality = Cardinality.Scalar + , path = Some + { externalUriSchemes = [ "https" ] + , allowSelf = False + } + } + ] + , recommended = [] : List NestedFieldRule + , optional = [ nestedPlain "note" ] + } + } + , plain "generated" + // { objectFields = Some + { required = + [ nestedPlain "by" + // { cardinality = Cardinality.Scalar + , format = Some FieldFormat.Actor + } + ] + , recommended = [] : List NestedFieldRule + , optional = [] : List NestedFieldRule + } + } + ] + , recommended = + [ plain "usage_count" + // { format = Some FieldFormat.NonNegativeInteger } + ] + , optional = + [ plain "supersededBy" + // { reference = Some + { localPrefix = "ADR" + , externalUriSchemes = [ "mori" ] + , allowSelf = False + } + } + , plain "statusNote" + ] + } + , allowUnknownTypes = False + , allowUnknownFields = True + , idField = Some "docId" + , requireBundleVersion = Some "0.2" + , types = + [ { type = "Metric" + , description = Some "A measured quantity." + , frontmatter = + { required = + [ plain "owner" + // { cardinality = Cardinality.Scalar + , format = Some FieldFormat.HumanActor + } + ] + , recommended = [] : List FieldRule + , optional = [] : List FieldRule + } + , pathPattern = None Text + , resourceScheme = None Text + , requireSchemaSection = False + , schemaColumns = [] : List Text + , idPrefix = Some "ADR" + } + ] + } + : Profile