Validation31Spec.hs

{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

-- | OpenAPI 3.1 / JSON Schema 2020-12 keyword validation (EP-6): type arrays,
-- numeric exclusive bounds, prefixItems, contains/minContains/maxContains,
-- if/then/else, const, and best-effort unevaluatedProperties/unevaluatedItems.
module Data.OpenApi.Schema.Validation31Spec where

import Data.Aeson (Value (..), object, (.=))
import Data.OpenApi
import Data.OpenApi.Internal
import Test.Hspec

spec :: Spec
spec = describe "OpenAPI 3.1 keyword validation" $ do
  -- M1: type arrays (matches-any; OpenApiNull matches JSON null)
  it "type [string,null] accepts a string and null, rejects a number" $ do
    let s = mempty {_schemaType = Just (OpenApiTypeArray [OpenApiString, OpenApiNull])}
    validateJSON mempty s (String "hi") `shouldBe` []
    validateJSON mempty s Null `shouldBe` []
    validateJSON mempty s (Number 3) `shouldNotBe` []

  -- M1: numeric exclusive bounds (independent of maximum/minimum)
  it "exclusiveMinimum 0 / exclusiveMaximum 100 accept 50, reject 0 and 100" $ do
    let s =
          mempty
            { _schemaType = Just (OpenApiTypeSingle OpenApiNumber),
              _schemaExclusiveMinimum = Just 0,
              _schemaExclusiveMaximum = Just 100
            }
    validateJSON mempty s (Number 50) `shouldBe` []
    validateJSON mempty s (Number 0) `shouldNotBe` []
    validateJSON mempty s (Number 100) `shouldNotBe` []

  -- M2: prefixItems + items:false (tuple)
  it "prefixItems [string,number] + items:false validates [a,1], rejects extras/wrong types" $ do
    let s =
          mempty
            { _schemaType = Just (OpenApiTypeSingle OpenApiArray),
              _schemaPrefixItems =
                Just
                  [ Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiString)}),
                    Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiNumber)})
                  ],
              _schemaItems = Just (OpenApiItemsBoolean False)
            }
    validateJSON mempty s (Array [String "a", Number 1]) `shouldBe` []
    validateJSON mempty s (Array [String "a", Number 1, Bool True]) `shouldNotBe` []
    validateJSON mempty s (Array [Number 1, String "a"]) `shouldNotBe` []

  -- M2: contains + minContains
  it "contains integer + minContains 2 accepts two integers, rejects fewer" $ do
    let s =
          mempty
            { _schemaType = Just (OpenApiTypeSingle OpenApiArray),
              _schemaContains =
                Just (Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiInteger)})),
              _schemaMinContains = Just 2
            }
    validateJSON mempty s (Array [Number 1, Number 2, String "x"]) `shouldBe` []
    validateJSON mempty s (Array [String "x"]) `shouldNotBe` []

  -- M2: maxContains
  it "contains integer + maxContains 1 rejects two integers" $ do
    let s =
          mempty
            { _schemaType = Just (OpenApiTypeSingle OpenApiArray),
              _schemaContains =
                Just (Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiInteger)})),
              _schemaMaxContains = Just 1
            }
    validateJSON mempty s (Array [Number 1, String "x"]) `shouldBe` []
    validateJSON mempty s (Array [Number 1, Number 2]) `shouldNotBe` []

  -- M3: if/then (kept scalar to avoid this engine's strict-object behavior and
  -- its no-op pattern checker: "if the value is a string, then it must be \"yes\"").
  it "if (string) then const yes; non-string skips the constraint" $ do
    let s =
          mempty
            { _schemaIf = Just (Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiString)})),
              _schemaThen = Just (Inline (mempty {_schemaConst = Just (String "yes")}))
            }
    validateJSON mempty s (String "yes") `shouldBe` [] -- matches if, then satisfied
    validateJSON mempty s (String "no") `shouldNotBe` [] -- matches if, then violated
    validateJSON mempty s (Number 42) `shouldBe` [] -- if not matched, no else -> ok

  -- M3: const
  it "const 42 accepts 42, rejects 43" $ do
    let s = mempty {_schemaConst = Just (Number 42)}
    validateJSON mempty s (Number 42) `shouldBe` []
    validateJSON mempty s (Number 43) `shouldNotBe` []

  -- M4: best-effort unevaluatedProperties (local-only)
  it "unevaluatedProperties:false rejects a property not in properties" $ do
    let s =
          mempty
            { _schemaType = Just (OpenApiTypeSingle OpenApiObject),
              _schemaProperties =
                [("a", Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiString)}))],
              _schemaUnevaluatedProperties = Just (AdditionalPropertiesAllowed False)
            }
    validateJSON mempty s (object ["a" .= ("x" :: String)]) `shouldBe` []
    validateJSON mempty s (object ["a" .= ("x" :: String), "b" .= ("y" :: String)]) `shouldNotBe` []

  -- M4: best-effort unevaluatedItems (local-only). The unevaluated schema requires
  -- a string; the third element (a bool) is beyond prefixItems and so must satisfy it.
  -- (A `{not:{}}` "always-false" schema would not work: this engine does not validate `not`.)
  it "unevaluatedItems requires string; rejects a non-string beyond prefixItems" $ do
    let s =
          mempty
            { _schemaType = Just (OpenApiTypeSingle OpenApiArray),
              _schemaPrefixItems =
                Just
                  [ Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiString)}),
                    Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiNumber)})
                  ],
              _schemaUnevaluatedItems = Just (Inline (mempty {_schemaType = Just (OpenApiTypeSingle OpenApiString)}))
            }
    validateJSON mempty s (Array [String "a", Number 1]) `shouldBe` []
    validateJSON mempty s (Array [String "a", Number 1, Bool True]) `shouldNotBe` []