mirror of
https://github.com/ilyakooo0/compaREST.git
synced 2024-09-11 06:25:40 +03:00
Turn Traced into a comonad (#41)
* Turn Traced into a comonad * tracedDePathFragment -> tracedPathFragmentParam * Fixed tracedOp Co-authored-by: iko <ilyakooo0@gmail.com>
This commit is contained in:
parent
1d27fd17f3
commit
c2968fee75
@ -34,6 +34,7 @@ common common-options
|
|||||||
, attoparsec
|
, attoparsec
|
||||||
, bytestring
|
, bytestring
|
||||||
, containers
|
, containers
|
||||||
|
, comonad
|
||||||
, deriving-aeson
|
, deriving-aeson
|
||||||
, generic-data
|
, generic-data
|
||||||
, generic-monoid
|
, generic-monoid
|
||||||
|
@ -2,6 +2,7 @@
|
|||||||
|
|
||||||
module OpenAPI.Checker.Orphans (Step (..)) where
|
module OpenAPI.Checker.Orphans (Step (..)) where
|
||||||
|
|
||||||
|
import Control.Comonad.Env
|
||||||
import Data.OpenApi
|
import Data.OpenApi
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import qualified Data.HashMap.Strict.InsOrd as IOHM
|
import qualified Data.HashMap.Strict.InsOrd as IOHM
|
||||||
@ -28,3 +29,7 @@ deriving stock instance Ord ParamLocation
|
|||||||
|
|
||||||
instance (Ord k, Ord v) => Ord (IOHM.InsOrdHashMap k v) where
|
instance (Ord k, Ord v) => Ord (IOHM.InsOrdHashMap k v) where
|
||||||
compare xs ys = compare (IOHM.toList xs) (IOHM.toList ys)
|
compare xs ys = compare (IOHM.toList xs) (IOHM.toList ys)
|
||||||
|
|
||||||
|
deriving stock instance (Eq e, Eq (w a)) => Eq (EnvT e w a)
|
||||||
|
deriving stock instance (Ord e, Ord (w a)) => Ord (EnvT e w a)
|
||||||
|
deriving stock instance (Show e, Show (w a)) => Show (EnvT e w a)
|
||||||
|
@ -1,7 +1,6 @@
|
|||||||
module OpenAPI.Checker.References
|
module OpenAPI.Checker.References
|
||||||
( TracedReferences
|
( TracedReferences
|
||||||
, dereference
|
, dereference
|
||||||
, dereferenceTraced
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -16,17 +15,12 @@ import OpenAPI.Checker.Trace
|
|||||||
type TracedReferences root a = Map Reference (Traced root a)
|
type TracedReferences root a = Map Reference (Traced root a)
|
||||||
|
|
||||||
dereference
|
dereference
|
||||||
:: Typeable a
|
|
||||||
=> Definitions a
|
|
||||||
-> Referenced a
|
|
||||||
-> Traced (Referenced a) a
|
|
||||||
dereference _ (Inline a) = Traced (step InlineStep) a
|
|
||||||
dereference defs (Ref r@(Reference ref)) =
|
|
||||||
Traced (step $ ReferencedStep r) (fromJust $ IOHM.lookup ref defs)
|
|
||||||
|
|
||||||
dereferenceTraced
|
|
||||||
:: Typeable a
|
:: Typeable a
|
||||||
=> Definitions a
|
=> Definitions a
|
||||||
-> Traced r (Referenced a)
|
-> Traced r (Referenced a)
|
||||||
-> Traced r a
|
-> Traced r a
|
||||||
dereferenceTraced defs (Traced t x) = retrace t $ dereference defs x
|
dereference defs x = case extract x of
|
||||||
|
Inline a
|
||||||
|
-> traced (ask x >>> step InlineStep) a
|
||||||
|
Ref r@(Reference ref)
|
||||||
|
-> traced (ask x >>> step (ReferencedStep r)) (fromJust $ IOHM.lookup ref defs)
|
||||||
|
@ -1,12 +1,12 @@
|
|||||||
module OpenAPI.Checker.Run (runChecker) where
|
module OpenAPI.Checker.Run (runChecker) where
|
||||||
|
|
||||||
import Control.Category
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.ByteString.Char8 as BSC
|
import qualified Data.ByteString.Char8 as BSC
|
||||||
import Data.HList
|
import Data.HList
|
||||||
import qualified Data.Yaml as Yaml
|
import qualified Data.Yaml as Yaml
|
||||||
import OpenAPI.Checker.Options
|
import OpenAPI.Checker.Options
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
|
import OpenAPI.Checker.Trace
|
||||||
import OpenAPI.Checker.Validate.OpenApi ()
|
import OpenAPI.Checker.Validate.OpenApi ()
|
||||||
import Prelude hiding (id, (.))
|
import Prelude hiding (id, (.))
|
||||||
|
|
||||||
@ -24,7 +24,7 @@ runChecker = do
|
|||||||
fail "Exiting"
|
fail "Exiting"
|
||||||
Right s -> pure s
|
Right s -> pure s
|
||||||
Right s -> pure s
|
Right s -> pure s
|
||||||
a <- parseSchema (clientFile opts)
|
a <- traced Root <$> parseSchema (clientFile opts)
|
||||||
b <- parseSchema (serverFile opts)
|
b <- traced Root <$> parseSchema (serverFile opts)
|
||||||
let report = runCompatFormula (pure id) $ checkCompatibility HNil (ProdCons a b)
|
let report = runCompatFormula $ checkCompatibility HNil (ProdCons a b)
|
||||||
BSC.putStrLn $ Yaml.encode report
|
BSC.putStrLn $ Yaml.encode report
|
||||||
|
@ -2,19 +2,13 @@ module OpenAPI.Checker.Subtree
|
|||||||
( APIStep (..)
|
( APIStep (..)
|
||||||
, Subtree (..)
|
, Subtree (..)
|
||||||
, CompatM (..)
|
, CompatM (..)
|
||||||
|
, CompatFormula'
|
||||||
, CompatFormula
|
, CompatFormula
|
||||||
, ProdCons (..)
|
, ProdCons (..)
|
||||||
, HasUnsupportedFeature (..)
|
, HasUnsupportedFeature (..)
|
||||||
, swapRoles
|
|
||||||
, swapProdCons
|
, swapProdCons
|
||||||
, checkProdCons
|
|
||||||
, SubtreeCheckIssue (..)
|
, SubtreeCheckIssue (..)
|
||||||
, runCompatFormula
|
, runCompatFormula
|
||||||
, withTrace
|
|
||||||
, localM
|
|
||||||
, localTrace
|
|
||||||
, localStep
|
|
||||||
, localTrace'
|
|
||||||
, anyOfM
|
, anyOfM
|
||||||
, anyOfAt
|
, anyOfAt
|
||||||
, issueAtTrace
|
, issueAtTrace
|
||||||
@ -23,8 +17,8 @@ module OpenAPI.Checker.Subtree
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Control.Comonad.Env
|
||||||
import Control.Monad.Identity
|
import Control.Monad.Identity
|
||||||
import Control.Monad.Reader
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Functor.Compose
|
import Data.Functor.Compose
|
||||||
@ -58,29 +52,19 @@ instance Applicative ProdCons where
|
|||||||
pure x = ProdCons x x
|
pure x = ProdCons x x
|
||||||
ProdCons fp fc <*> ProdCons xp xc = ProdCons (fp xp) (fc xc)
|
ProdCons fp fc <*> ProdCons xp xc = ProdCons (fp xp) (fc xc)
|
||||||
|
|
||||||
newtype CompatM t a = CompatM
|
newtype CompatM a = CompatM
|
||||||
{ unCompatM
|
{ unCompatM
|
||||||
:: ReaderT
|
:: (StateT (MemoState VarRef) Identity) a
|
||||||
(ProdCons (Trace OpenApi t))
|
|
||||||
(StateT (MemoState VarRef) Identity)
|
|
||||||
a
|
|
||||||
}
|
}
|
||||||
deriving newtype
|
deriving newtype
|
||||||
( Functor
|
( Functor
|
||||||
, Applicative
|
, Applicative
|
||||||
, Monad
|
, Monad
|
||||||
, MonadReader (ProdCons (Trace OpenApi t))
|
|
||||||
, MonadState (MemoState VarRef)
|
, MonadState (MemoState VarRef)
|
||||||
)
|
)
|
||||||
|
|
||||||
type CompatFormula t = Compose (CompatM t) (FormulaF SubtreeCheckIssue OpenApi)
|
type CompatFormula' f r = Compose CompatM (FormulaF f r)
|
||||||
|
type CompatFormula = CompatFormula' SubtreeCheckIssue OpenApi
|
||||||
-- | Swaps roles of producer and consumer. Used when we check the @Response@ at
|
|
||||||
-- least. In response producer and consumer swap their places because response
|
|
||||||
-- is generated by consumer and parsed by producer.
|
|
||||||
swapRoles :: CompatFormula t a -> CompatFormula t a
|
|
||||||
swapRoles (Compose r) = Compose $ do
|
|
||||||
local swapProdCons r
|
|
||||||
|
|
||||||
class (Typeable t, Ord (CheckIssue t), Show (CheckIssue t)) => Subtree (t :: Type) where
|
class (Typeable t, Ord (CheckIssue t), Show (CheckIssue t)) => Subtree (t :: Type) where
|
||||||
type CheckEnv t :: [Type]
|
type CheckEnv t :: [Type]
|
||||||
@ -93,14 +77,14 @@ class (Typeable t, Ord (CheckIssue t), Show (CheckIssue t)) => Subtree (t :: Typ
|
|||||||
normalizeTrace :: Trace OpenApi t -> Trace OpenApi t
|
normalizeTrace :: Trace OpenApi t -> Trace OpenApi t
|
||||||
normalizeTrace = id
|
normalizeTrace = id
|
||||||
|
|
||||||
checkCompatibility :: HasAll (CheckEnv t) xs => HList xs -> ProdCons t -> CompatFormula t ()
|
checkCompatibility
|
||||||
|
:: HasAll (CheckEnv t) xs
|
||||||
|
=> HList xs
|
||||||
|
-> ProdCons (Traced OpenApi t)
|
||||||
|
-> CompatFormula ()
|
||||||
|
|
||||||
{-# WARNING normalizeTrace "It must be refactored. Does nothing for now" #-}
|
{-# WARNING normalizeTrace "It must be refactored. Does nothing for now" #-}
|
||||||
|
|
||||||
checkProdCons :: (Subtree t, HasAll (CheckEnv t) env) => HList env -> ProdCons (Traced r t) -> CompatFormula r ()
|
|
||||||
checkProdCons env (ProdCons (Traced p x) (Traced c y)) =
|
|
||||||
localTrace (ProdCons p c) $ checkCompatibility env $ ProdCons x y
|
|
||||||
|
|
||||||
class HasUnsupportedFeature x where
|
class HasUnsupportedFeature x where
|
||||||
hasUnsupportedFeature :: x -> Bool
|
hasUnsupportedFeature :: x -> Bool
|
||||||
|
|
||||||
@ -141,76 +125,41 @@ instance ToJSON (SubtreeCheckIssue t) where
|
|||||||
toJSON (SubtreeCheckIssue i) = toJSON i
|
toJSON (SubtreeCheckIssue i) = toJSON i
|
||||||
|
|
||||||
runCompatFormula
|
runCompatFormula
|
||||||
:: ProdCons (Trace OpenApi t)
|
:: CompatFormula' f r a
|
||||||
-> Compose (CompatM t) (FormulaF f r) a
|
|
||||||
-> Either (T.TracePrefixTree f r) a
|
-> Either (T.TracePrefixTree f r) a
|
||||||
runCompatFormula env (Compose f) =
|
runCompatFormula (Compose f) =
|
||||||
calculate . runIdentity . runMemo 0 . (`runReaderT` env) . unCompatM $ f
|
calculate . runIdentity . runMemo 0 . unCompatM $ f
|
||||||
|
|
||||||
withTrace
|
|
||||||
:: (ProdCons (Trace OpenApi a) -> Compose (CompatM a) (FormulaF f r) x)
|
|
||||||
-> Compose (CompatM a) (FormulaF f r) x
|
|
||||||
withTrace k = Compose $ do
|
|
||||||
xs <- ask
|
|
||||||
getCompose $ k xs
|
|
||||||
|
|
||||||
localM
|
|
||||||
:: ProdCons (Trace a b)
|
|
||||||
-> CompatM b x
|
|
||||||
-> CompatM a x
|
|
||||||
localM xs (CompatM k) =
|
|
||||||
CompatM $ ReaderT $ \env -> runReaderT k ((>>>) <$> env <*> xs)
|
|
||||||
|
|
||||||
localTrace
|
|
||||||
:: ProdCons (Trace a b)
|
|
||||||
-> Compose (CompatM b) (FormulaF f r) x
|
|
||||||
-> Compose (CompatM a) (FormulaF f r) x
|
|
||||||
localTrace xs (Compose h) = Compose (localM xs h)
|
|
||||||
|
|
||||||
localStep
|
|
||||||
:: Steppable a b
|
|
||||||
=> Step a b
|
|
||||||
-> Compose (CompatM b) (FormulaF f r) x
|
|
||||||
-> Compose (CompatM a) (FormulaF f r) x
|
|
||||||
localStep xs (Compose h) = Compose (localM (pure $ step xs) h)
|
|
||||||
|
|
||||||
localTrace'
|
|
||||||
:: ProdCons (Trace OpenApi b)
|
|
||||||
-> Compose (CompatM b) (FormulaF f r) x
|
|
||||||
-> Compose (CompatM a) (FormulaF f r) x
|
|
||||||
localTrace' xs (Compose (CompatM k)) = Compose $ CompatM$ ReaderT $ \_ -> runReaderT k xs
|
|
||||||
|
|
||||||
issueAtTrace
|
issueAtTrace
|
||||||
:: Subtree t => Trace OpenApi t -> CheckIssue t -> CompatFormula s a
|
:: Subtree t
|
||||||
|
=> Trace r t
|
||||||
|
-> CheckIssue t
|
||||||
|
-> CompatFormula' SubtreeCheckIssue r a
|
||||||
issueAtTrace xs issue = Compose $ pure $ anError $ AnItem xs $ SubtreeCheckIssue issue
|
issueAtTrace xs issue = Compose $ pure $ anError $ AnItem xs $ SubtreeCheckIssue issue
|
||||||
|
|
||||||
issueAt
|
issueAt
|
||||||
:: Subtree t
|
:: (Subtree t, ComonadEnv (Trace r t) w)
|
||||||
=> (forall x. ProdCons x -> x)
|
=> w x
|
||||||
-> CheckIssue t
|
-> CheckIssue t
|
||||||
-> CompatFormula t a
|
-> CompatFormula' SubtreeCheckIssue r a
|
||||||
issueAt f issue = Compose $ do
|
issueAt x = issueAtTrace (ask x)
|
||||||
xs <- asks f
|
|
||||||
pure $ anError $ AnItem xs $ SubtreeCheckIssue issue
|
|
||||||
|
|
||||||
anyOfM
|
anyOfM
|
||||||
:: Ord (f t)
|
:: Subtree t
|
||||||
=> Trace r t
|
=> Trace r t
|
||||||
-> f t
|
-> CheckIssue t
|
||||||
-> [Compose (CompatM t) (FormulaF f r) a]
|
-> [CompatFormula' SubtreeCheckIssue r a]
|
||||||
-> Compose (CompatM t) (FormulaF f r) a
|
-> CompatFormula' SubtreeCheckIssue r a
|
||||||
anyOfM xs issue fs =
|
anyOfM xs issue fs =
|
||||||
Compose $ (`eitherOf` AnItem xs issue) <$> sequenceA (getCompose <$> fs)
|
Compose $ (`eitherOf` AnItem xs (SubtreeCheckIssue issue)) <$> sequenceA (getCompose <$> fs)
|
||||||
|
|
||||||
anyOfAt
|
anyOfAt
|
||||||
:: Subtree t
|
:: (Subtree t, ComonadEnv (Trace r t) w)
|
||||||
=> (forall x. ProdCons x -> x)
|
=> w x
|
||||||
-> CheckIssue t
|
-> CheckIssue t
|
||||||
-> [CompatFormula t a]
|
-> [CompatFormula' SubtreeCheckIssue r a]
|
||||||
-> CompatFormula t a
|
-> CompatFormula' SubtreeCheckIssue r a
|
||||||
anyOfAt f issue fs = Compose $ do
|
anyOfAt x = anyOfM (ask x)
|
||||||
xs <- asks f
|
|
||||||
(`eitherOf` AnItem xs (SubtreeCheckIssue issue)) <$> sequenceA (getCompose <$> fs)
|
|
||||||
|
|
||||||
fixpointKnot
|
fixpointKnot
|
||||||
:: MonadState (MemoState VarRef) m
|
:: MonadState (MemoState VarRef) m
|
||||||
@ -222,7 +171,9 @@ fixpointKnot =
|
|||||||
, tieKnot = \i x -> pure $ maxFixpoint i x
|
, tieKnot = \i x -> pure $ maxFixpoint i x
|
||||||
}
|
}
|
||||||
|
|
||||||
memo :: Subtree t => CompatFormula t () -> CompatFormula t ()
|
memo
|
||||||
memo (Compose f) = Compose $ do
|
:: (Typeable r, Subtree t)
|
||||||
pxs <- asks (fmap normalizeTrace)
|
=> (ProdCons (Traced r t) -> CompatFormula ())
|
||||||
memoWithKnot fixpointKnot f pxs
|
-> (ProdCons (Traced r t) -> CompatFormula ())
|
||||||
|
memo f pc = Compose $ do
|
||||||
|
memoWithKnot fixpointKnot (getCompose $ f pc) (ask <$> pc)
|
||||||
|
@ -9,18 +9,21 @@ module OpenAPI.Checker.Trace
|
|||||||
, _DiffTrace
|
, _DiffTrace
|
||||||
, AnItem (..)
|
, AnItem (..)
|
||||||
, step
|
, step
|
||||||
, Traced (..)
|
, Traced
|
||||||
, mapTraced
|
, traced
|
||||||
, retrace
|
|
||||||
, deTraced
|
|
||||||
|
|
||||||
-- * Reexports
|
-- * Reexports
|
||||||
, (>>>)
|
, (>>>)
|
||||||
, (<<<)
|
, (<<<)
|
||||||
|
, extract
|
||||||
|
, ask
|
||||||
|
, asks
|
||||||
|
, local
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Category
|
import Control.Category
|
||||||
|
import Control.Comonad.Env
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Kind
|
import Data.Kind
|
||||||
import Data.Type.Equality
|
import Data.Type.Equality
|
||||||
@ -117,20 +120,7 @@ instance Typeable r => Ord (AnItem f r) where
|
|||||||
Root -> compare (someTypeRep xs) (someTypeRep ys)
|
Root -> compare (someTypeRep xs) (someTypeRep ys)
|
||||||
Snoc _ _ -> compare (someTypeRep xs) (someTypeRep ys)
|
Snoc _ _ -> compare (someTypeRep xs) (someTypeRep ys)
|
||||||
|
|
||||||
data Traced r a = Traced {getTrace :: Trace r a, getTraced :: a}
|
type Traced r a = Env (Trace r a) a
|
||||||
deriving (Eq, Show)
|
|
||||||
|
|
||||||
-- | Reverse lexicographical order, so that getTraced is a monotonous function
|
traced :: Trace r a -> a -> Traced r a
|
||||||
instance Ord a => Ord (Traced r a) where
|
traced = env
|
||||||
compare (Traced t1 a1) (Traced t2 a2) = compare a1 a2 <> compare t1 t2
|
|
||||||
|
|
||||||
mapTraced :: (Trace r a -> Trace r b) -> (a -> b) -> Traced r a -> Traced r b
|
|
||||||
mapTraced f g (Traced t a) = Traced (f t) (g a)
|
|
||||||
|
|
||||||
retrace :: Trace s r -> Traced r a -> Traced s a
|
|
||||||
retrace xs (Traced t a) = Traced (xs >>> t) a
|
|
||||||
|
|
||||||
deTraced :: Traced r a -> (Trace r a, a)
|
|
||||||
deTraced (Traced a b) = (a, b)
|
|
||||||
|
|
||||||
-- type APath = AnItem Proxy
|
|
||||||
|
@ -1,9 +1,11 @@
|
|||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
|
|
||||||
module OpenAPI.Checker.Validate.MediaTypeObject () where
|
module OpenAPI.Checker.Validate.MediaTypeObject
|
||||||
|
( CheckIssue(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
import Data.Foldable as F
|
import Data.Foldable as F
|
||||||
import Data.Functor
|
|
||||||
import Data.HList
|
import Data.HList
|
||||||
import Data.HashMap.Strict.InsOrd as IOHM
|
import Data.HashMap.Strict.InsOrd as IOHM
|
||||||
import Data.Map.Strict as M
|
import Data.Map.Strict as M
|
||||||
@ -15,13 +17,21 @@ import OpenAPI.Checker.Trace
|
|||||||
import OpenAPI.Checker.Validate.Products
|
import OpenAPI.Checker.Validate.Products
|
||||||
import OpenAPI.Checker.Validate.Schema ()
|
import OpenAPI.Checker.Validate.Schema ()
|
||||||
|
|
||||||
|
tracedSchema :: Traced r MediaTypeObject -> Maybe (Traced r (Referenced Schema))
|
||||||
|
tracedSchema mto = _mediaTypeObjectSchema (extract mto) <&> traced (ask mto >>> step MediaTypeSchema)
|
||||||
|
|
||||||
|
tracedEncoding :: Traced r MediaTypeObject -> InsOrdHashMap Text (Traced r Encoding)
|
||||||
|
tracedEncoding mto = IOHM.mapWithKey (\k -> traced (ask mto >>> step (MediaTypeParamEncoding k)))
|
||||||
|
$ _mediaTypeObjectEncoding $ extract mto
|
||||||
|
|
||||||
instance Subtree MediaTypeObject where
|
instance Subtree MediaTypeObject where
|
||||||
type CheckEnv MediaTypeObject =
|
type CheckEnv MediaTypeObject =
|
||||||
'[ MediaType
|
'[ MediaType
|
||||||
, ProdCons (Definitions Schema)
|
, ProdCons (Definitions Schema)
|
||||||
]
|
]
|
||||||
data CheckIssue MediaTypeObject
|
data CheckIssue MediaTypeObject
|
||||||
= MediaEncodingMissing Text
|
= RequestMediaTypeNotFound
|
||||||
|
| ResponseMediaTypeMissing
|
||||||
| MediaEncodingIncompat
|
| MediaEncodingIncompat
|
||||||
| MediaTypeSchemaRequired
|
| MediaTypeSchemaRequired
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
@ -32,11 +42,10 @@ instance Subtree MediaTypeObject where
|
|||||||
| otherwise -> pure ()
|
| otherwise -> pure ()
|
||||||
-- If consumer requires schema then producer must produce compatible
|
-- If consumer requires schema then producer must produce compatible
|
||||||
-- request
|
-- request
|
||||||
for_ (_mediaTypeObjectSchema c) $ \consRef ->
|
for_ (tracedSchema c) $ \consRef ->
|
||||||
case _mediaTypeObjectSchema p of
|
case tracedSchema p of
|
||||||
Nothing -> issueAt producer MediaTypeSchemaRequired
|
Nothing -> issueAt p MediaTypeSchemaRequired
|
||||||
Just prodRef -> localStep MediaTypeSchema
|
Just prodRef -> checkCompatibility env $ ProdCons prodRef consRef
|
||||||
$ checkCompatibility env $ ProdCons prodRef consRef
|
|
||||||
pure ()
|
pure ()
|
||||||
where
|
where
|
||||||
mediaType = getH @MediaType env
|
mediaType = getH @MediaType env
|
||||||
@ -44,23 +53,25 @@ instance Subtree MediaTypeObject where
|
|||||||
let
|
let
|
||||||
-- Parameters of the media type are product-like entities
|
-- Parameters of the media type are product-like entities
|
||||||
getEncoding mt = M.fromList
|
getEncoding mt = M.fromList
|
||||||
$ (IOHM.toList $ _mediaTypeObjectEncoding mt) <&> \(k, enc) ->
|
$ (IOHM.toList $ tracedEncoding mt) <&> \(k, enc) ->
|
||||||
( k
|
( k
|
||||||
, ProductLike
|
, ProductLike
|
||||||
{ traced = Traced (step $ MediaTypeParamEncoding k) enc
|
{ tracedValue = enc
|
||||||
, required = True } )
|
, required = True } )
|
||||||
encProdCons = getEncoding <$> prodCons
|
encProdCons = getEncoding <$> prodCons
|
||||||
in checkProducts MediaEncodingMissing
|
in checkProducts (const MediaEncodingMissing)
|
||||||
(const $ checkCompatibility HNil) encProdCons
|
(const $ checkCompatibility HNil) encProdCons
|
||||||
|
|
||||||
instance Subtree Encoding where
|
instance Subtree Encoding where
|
||||||
type CheckEnv Encoding = '[]
|
type CheckEnv Encoding = '[]
|
||||||
data CheckIssue Encoding = EncodingNotSupported
|
data CheckIssue Encoding
|
||||||
|
= MediaEncodingMissing
|
||||||
|
| EncodingNotSupported
|
||||||
-- FIXME: Support only JSON body for now. Then Encoding is checked only for
|
-- FIXME: Support only JSON body for now. Then Encoding is checked only for
|
||||||
-- multipart/form-url-encoded
|
-- multipart/form-url-encoded
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility _env _prodCons =
|
checkCompatibility _env pc =
|
||||||
issueAt producer EncodingNotSupported
|
issueAt (producer pc) EncodingNotSupported
|
||||||
|
|
||||||
instance Steppable MediaTypeObject (Referenced Schema) where
|
instance Steppable MediaTypeObject (Referenced Schema) where
|
||||||
data Step MediaTypeObject (Referenced Schema) = MediaTypeSchema
|
data Step MediaTypeObject (Referenced Schema) = MediaTypeSchema
|
||||||
|
@ -13,22 +13,25 @@ import OpenAPI.Checker.Subtree
|
|||||||
import OpenAPI.Checker.Trace
|
import OpenAPI.Checker.Trace
|
||||||
import OpenAPI.Checker.Validate.ProcessedPathItem
|
import OpenAPI.Checker.Validate.ProcessedPathItem
|
||||||
|
|
||||||
|
tracedPaths :: Traced r OpenApi -> Traced r ProcessedPathItems
|
||||||
|
tracedPaths oa = traced (ask oa >>> step OpenApiPathsStep)
|
||||||
|
(processPathItems . IOHM.toList . _openApiPaths . extract $ oa)
|
||||||
|
|
||||||
instance Subtree OpenApi where
|
instance Subtree OpenApi where
|
||||||
type CheckEnv OpenApi = '[]
|
type CheckEnv OpenApi = '[]
|
||||||
data CheckIssue OpenApi
|
data CheckIssue OpenApi
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility _ prodCons = do
|
checkCompatibility _ prodCons = do
|
||||||
let cs = _openApiComponents <$> prodCons
|
let cs = _openApiComponents . extract <$> prodCons
|
||||||
localStep OpenApiPathsStep $
|
checkCompatibility @ProcessedPathItems
|
||||||
checkCompatibility
|
((_componentsRequestBodies <$> cs)
|
||||||
((_componentsRequestBodies <$> cs)
|
`HCons` (_componentsParameters <$> cs)
|
||||||
`HCons` (_componentsParameters <$> cs)
|
`HCons` (_componentsSecuritySchemes <$> cs)
|
||||||
`HCons` (_componentsSecuritySchemes <$> cs)
|
`HCons` (_componentsResponses <$> cs)
|
||||||
`HCons` (_componentsResponses <$> cs)
|
`HCons` (_componentsHeaders <$> cs)
|
||||||
`HCons` (_componentsHeaders <$> cs)
|
`HCons` (_componentsSchemas <$> cs)
|
||||||
`HCons` (_componentsSchemas <$> cs)
|
`HCons` HNil)
|
||||||
`HCons` HNil)
|
(tracedPaths <$> prodCons)
|
||||||
(processPathItems . IOHM.toList . _openApiPaths <$> prodCons)
|
|
||||||
|
|
||||||
instance Steppable OpenApi ProcessedPathItems where
|
instance Steppable OpenApi ProcessedPathItems where
|
||||||
data Step OpenApi ProcessedPathItems = OpenApiPathsStep
|
data Step OpenApi ProcessedPathItems = OpenApiPathsStep
|
||||||
|
@ -2,7 +2,10 @@
|
|||||||
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
||||||
|
|
||||||
module OpenAPI.Checker.Validate.Operation
|
module OpenAPI.Checker.Validate.Operation
|
||||||
( MatchedOperation(..)
|
( MatchedOperation (..)
|
||||||
|
, CheckIssue (..)
|
||||||
|
, OperationMethod(..)
|
||||||
|
, pathItemMethod
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
||||||
@ -17,15 +20,11 @@ import Data.Text (Text)
|
|||||||
import OpenAPI.Checker.References
|
import OpenAPI.Checker.References
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
import OpenAPI.Checker.Trace
|
import OpenAPI.Checker.Trace
|
||||||
import OpenAPI.Checker.Validate.Param ()
|
import OpenAPI.Checker.Validate.Param
|
||||||
import OpenAPI.Checker.Validate.PathFragment
|
import OpenAPI.Checker.Validate.PathFragment
|
||||||
import OpenAPI.Checker.Validate.Products
|
import OpenAPI.Checker.Validate.Products
|
||||||
import OpenAPI.Checker.Validate.RequestBody ()
|
import OpenAPI.Checker.Validate.RequestBody
|
||||||
import OpenAPI.Checker.Validate.Responses ()
|
import OpenAPI.Checker.Validate.Responses ()
|
||||||
import OpenAPI.Checker.Validate.SecurityRequirement ()
|
|
||||||
import OpenAPI.Checker.Validate.Server ()
|
|
||||||
|
|
||||||
-- data ParamKey
|
|
||||||
|
|
||||||
data MatchedOperation = MatchedOperation
|
data MatchedOperation = MatchedOperation
|
||||||
{ operation :: !Operation
|
{ operation :: !Operation
|
||||||
@ -41,6 +40,31 @@ type ParamKey = (ParamLocation, Text)
|
|||||||
paramKey :: Param -> ParamKey
|
paramKey :: Param -> ParamKey
|
||||||
paramKey param = (_paramIn param, _paramName param)
|
paramKey param = (_paramIn param, _paramName param)
|
||||||
|
|
||||||
|
tracedParameters :: Traced r MatchedOperation -> [Traced r (Referenced Param)]
|
||||||
|
tracedParameters oper =
|
||||||
|
[ traced (ask oper >>> step (OperationParamsStep i)) x
|
||||||
|
| (i, x) <- zip [0..] $ _operationParameters . operation $ extract oper
|
||||||
|
]
|
||||||
|
|
||||||
|
tracedRequestBody :: Traced r MatchedOperation -> Maybe (Traced r (Referenced RequestBody))
|
||||||
|
tracedRequestBody oper = _operationRequestBody (operation $ extract oper) <&> traced (ask oper >>> step OperationRequestBodyStep)
|
||||||
|
|
||||||
|
tracedResponses :: Traced r MatchedOperation -> Traced r Responses
|
||||||
|
tracedResponses oper = traced (ask oper >>> step OperationResponsesStep)
|
||||||
|
$ _operationResponses . operation $ extract oper
|
||||||
|
|
||||||
|
tracedSecurity :: Traced r MatchedOperation -> [Traced r SecurityRequirement]
|
||||||
|
tracedSecurity oper =
|
||||||
|
[ traced (ask oper >>> step (OperationSecurityRequirementStep i)) x
|
||||||
|
| (i, x) <- zip [0..] $ _operationSecurity . operation $ extract oper
|
||||||
|
]
|
||||||
|
|
||||||
|
tracedServers :: Traced r MatchedOperation -> [Traced r Server]
|
||||||
|
tracedServers oper =
|
||||||
|
[ traced (ask oper >>> step (OperationServerStep i)) x
|
||||||
|
| (i, x) <- zip [0..] $ _operationServers . operation $ extract oper
|
||||||
|
]
|
||||||
|
|
||||||
instance Subtree MatchedOperation where
|
instance Subtree MatchedOperation where
|
||||||
type CheckEnv MatchedOperation =
|
type CheckEnv MatchedOperation =
|
||||||
'[ ProdCons (Definitions Param)
|
'[ ProdCons (Definitions Param)
|
||||||
@ -51,17 +75,11 @@ instance Subtree MatchedOperation where
|
|||||||
, ProdCons (Definitions Schema)
|
, ProdCons (Definitions Schema)
|
||||||
]
|
]
|
||||||
data CheckIssue MatchedOperation
|
data CheckIssue MatchedOperation
|
||||||
= ParamNotMatched ParamLocation Text
|
= OperationMissing OperationMethod
|
||||||
-- ^ Non-path param has no pair
|
|
||||||
| PathFragmentNotMatched Int
|
|
||||||
-- ^ Path fragment with given position has no match
|
|
||||||
| NoRequestBody
|
|
||||||
| CallbacksNotSupported
|
| CallbacksNotSupported
|
||||||
| SecurityRequirementNotMet Int -- security indexs
|
|
||||||
| ServerNotConsumed Int -- server index
|
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility env prodCons = withTrace $ \myTrace -> do
|
checkCompatibility env prodCons = do
|
||||||
checkParameters myTrace
|
checkParameters
|
||||||
checkRequestBodies
|
checkRequestBodies
|
||||||
checkResponses
|
checkResponses
|
||||||
checkCallbacks
|
checkCallbacks
|
||||||
@ -69,88 +87,84 @@ instance Subtree MatchedOperation where
|
|||||||
checkServers
|
checkServers
|
||||||
pure ()
|
pure ()
|
||||||
where
|
where
|
||||||
checkParameters myTrace = do
|
checkParameters = do
|
||||||
let
|
let
|
||||||
-- Merged parameters got from Operation and PathItem in one
|
-- Merged parameters got from Operation and PathItem in one
|
||||||
-- place. First element is path params, second is non-path params
|
-- place. First element is path params, second is non-path params
|
||||||
tracedParams :: ProdCons ([Traced OpenApi Param], [Traced OpenApi Param])
|
tracedParams :: ProdCons ([Traced OpenApi Param], [Traced OpenApi Param])
|
||||||
tracedParams = getParams <$> myTrace <*> paramDefs <*> prodCons
|
tracedParams = getParams <$> paramDefs <*> prodCons
|
||||||
getParams root defs mp =
|
getParams defs mp =
|
||||||
let
|
let
|
||||||
operationParamsMap :: Map ParamKey (Traced OpenApi Param)
|
operationParamsMap :: Map ParamKey (Traced OpenApi Param)
|
||||||
operationParamsMap = M.fromList $ do
|
operationParamsMap = M.fromList $ do
|
||||||
paramRef <- _operationParameters $ operation mp
|
paramRef <- tracedParameters mp
|
||||||
let
|
let
|
||||||
tracedParam = retrace root
|
param = dereference defs paramRef
|
||||||
$ dereferenceTraced defs
|
key = paramKey . extract $ param
|
||||||
$ Traced (step $ OperationParamsStep) paramRef
|
pure (key, param)
|
||||||
key = paramKey $ getTraced tracedParam
|
|
||||||
pure (key, tracedParam)
|
|
||||||
pathParamsMap :: Map ParamKey (Traced OpenApi Param)
|
pathParamsMap :: Map ParamKey (Traced OpenApi Param)
|
||||||
pathParamsMap = M.fromList $ do
|
pathParamsMap = M.fromList $ do
|
||||||
param <- pathParams mp
|
param <- pathParams . extract $ mp
|
||||||
pure (paramKey $ getTraced param, param)
|
pure (paramKey . extract $ param, param)
|
||||||
params = M.elems $ M.union operationParamsMap pathParamsMap
|
params = M.elems $ M.union operationParamsMap pathParamsMap
|
||||||
-- We prefer params from Operation
|
-- We prefer params from Operation
|
||||||
splitted = L.partition
|
splitted = L.partition
|
||||||
(\p -> (_paramIn $ getTraced p) == ParamPath) params
|
(\p -> (_paramIn . extract $ p) == ParamPath) params
|
||||||
in splitted
|
in splitted
|
||||||
checkNonPathParams $ snd <$> tracedParams
|
checkNonPathParams $ snd <$> tracedParams
|
||||||
checkPathParams $ fst <$> tracedParams
|
checkPathParams $ fst <$> tracedParams
|
||||||
pure ()
|
pure ()
|
||||||
checkNonPathParams :: ProdCons [Traced OpenApi Param] -> CompatFormula MatchedOperation ()
|
checkNonPathParams :: ProdCons [Traced OpenApi Param] -> CompatFormula ()
|
||||||
checkNonPathParams params = do
|
checkNonPathParams params = do
|
||||||
let
|
let
|
||||||
elements = getEls <$> params
|
elements = getEls <$> params
|
||||||
getEls traced = M.fromList $ do
|
getEls params = M.fromList $ do
|
||||||
p <- traced
|
p <- params
|
||||||
let
|
let
|
||||||
param = getTraced p
|
k = (_paramIn . extract $ p, _paramName . extract $ p)
|
||||||
k = (_paramIn param, _paramName param)
|
|
||||||
v = ProductLike
|
v = ProductLike
|
||||||
{ traced = p
|
{ tracedValue = p
|
||||||
, required = fromMaybe False $ _paramRequired param
|
, required = fromMaybe False . _paramRequired . extract $ p
|
||||||
}
|
}
|
||||||
pure (k, v)
|
pure (k, v)
|
||||||
check _ param = do
|
check param = do
|
||||||
checkCompatibility @Param (singletonH schemaDefs) param
|
checkCompatibility @Param (singletonH schemaDefs) param
|
||||||
checkProducts' (uncurry ParamNotMatched) check elements
|
checkProducts (ParamNotMatched . snd) (const check) elements
|
||||||
|
checkPathParams :: ProdCons [Traced OpenApi Param] -> CompatFormula ()
|
||||||
checkPathParams pathParams = do
|
checkPathParams pathParams = do
|
||||||
let
|
let
|
||||||
fragments :: ProdCons [Traced OpenApi PathFragmentParam]
|
fragments :: ProdCons [Traced OpenApi PathFragmentParam]
|
||||||
fragments = getFragments <$> pathParams <*> prodCons
|
fragments = getFragments <$> pathParams <*> prodCons
|
||||||
getFragments params mop = (getPathFragments mop) params
|
getFragments params mop = getPathFragments (extract mop) params
|
||||||
-- Feed path parameters to the fragments getter
|
-- Feed path parameters to the fragments getter
|
||||||
check _ frags = checkCompatibility @PathFragmentParam env frags
|
check frags = checkCompatibility @PathFragmentParam env frags
|
||||||
elements = fragments <&> \frags -> M.fromList $ zip [0..] $ do
|
elements = fragments <&> \frags -> M.fromList $ zip [0 :: Int ..] $ do
|
||||||
frag <- frags
|
frag <- frags
|
||||||
pure $ ProductLike
|
pure $ ProductLike
|
||||||
{ traced = frag
|
{ tracedValue = frag
|
||||||
, required = True }
|
, required = True }
|
||||||
checkProducts' PathFragmentNotMatched check elements
|
checkProducts (const PathFragmentNotMatched) (const check) elements
|
||||||
checkRequestBodies = do
|
checkRequestBodies = do
|
||||||
let
|
let
|
||||||
check _ reqBody = checkCompatibility @RequestBody env reqBody
|
check reqBody = checkCompatibility @RequestBody env reqBody
|
||||||
elements = getReqBody <$> bodyDefs <*> prodCons
|
elements = getReqBody <$> bodyDefs <*> prodCons
|
||||||
getReqBody bodyDef mop = M.fromList $ do
|
getReqBody bodyDef mop = M.fromList $ do
|
||||||
bodyRef <- F.toList $ _operationRequestBody $ operation mop
|
bodyRef <- F.toList . tracedRequestBody $ mop
|
||||||
let
|
let
|
||||||
traced = dereferenceTraced bodyDef
|
body = dereference bodyDef bodyRef
|
||||||
$ Traced (step $ OperationRequestBodyStep) bodyRef
|
|
||||||
required = fromMaybe False
|
|
||||||
$ _requestBodyRequired $ getTraced traced
|
|
||||||
elt = ProductLike { traced, required }
|
|
||||||
-- Single element map
|
-- Single element map
|
||||||
pure ((), elt)
|
pure ((), ProductLike
|
||||||
checkProducts (const NoRequestBody) check elements
|
{ tracedValue = body
|
||||||
|
, required = fromMaybe False . _requestBodyRequired . extract $ body
|
||||||
|
})
|
||||||
|
checkProducts (const NoRequestBody) (const check) elements
|
||||||
checkResponses = do
|
checkResponses = do
|
||||||
let
|
let
|
||||||
resps = (_operationResponses . operation) <$> prodCons
|
|
||||||
respEnv = HCons (swapProdCons respDefs)
|
respEnv = HCons (swapProdCons respDefs)
|
||||||
$ HCons (swapProdCons headerDefs)
|
$ HCons (swapProdCons headerDefs)
|
||||||
$ HCons (swapProdCons schemaDefs) HNil
|
$ HCons (swapProdCons schemaDefs) HNil
|
||||||
localStep OperationResponsesStep
|
resps = tracedResponses <$> prodCons
|
||||||
$ swapRoles $ checkCompatibility respEnv $ swapProdCons resps
|
checkCompatibility respEnv $ swapProdCons resps
|
||||||
checkCallbacks = pure () -- (error "FIXME: not implemented")
|
checkCallbacks = pure () -- (error "FIXME: not implemented")
|
||||||
checkOperationSecurity = pure () -- (error "FIXME: not implemented")
|
checkOperationSecurity = pure () -- (error "FIXME: not implemented")
|
||||||
checkServers = pure () -- (error "FIXME: not implemented")
|
checkServers = pure () -- (error "FIXME: not implemented")
|
||||||
@ -160,8 +174,30 @@ instance Subtree MatchedOperation where
|
|||||||
schemaDefs = getH @(ProdCons (Definitions Schema)) env
|
schemaDefs = getH @(ProdCons (Definitions Schema)) env
|
||||||
paramDefs = getH @(ProdCons (Definitions Param)) env
|
paramDefs = getH @(ProdCons (Definitions Param)) env
|
||||||
|
|
||||||
|
data OperationMethod =
|
||||||
|
GetMethod
|
||||||
|
| PutMethod
|
||||||
|
| PostMethod
|
||||||
|
| DeleteMethod
|
||||||
|
| OptionsMethod
|
||||||
|
| HeadMethod
|
||||||
|
| PatchMethod
|
||||||
|
| TraceMethod
|
||||||
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
pathItemMethod :: OperationMethod -> PathItem -> Maybe Operation
|
||||||
|
pathItemMethod = \case
|
||||||
|
GetMethod -> _pathItemGet
|
||||||
|
PutMethod -> _pathItemPut
|
||||||
|
PostMethod -> _pathItemPost
|
||||||
|
DeleteMethod -> _pathItemDelete
|
||||||
|
OptionsMethod -> _pathItemOptions
|
||||||
|
HeadMethod -> _pathItemHead
|
||||||
|
PatchMethod -> _pathItemPatch
|
||||||
|
TraceMethod -> _pathItemTrace
|
||||||
|
|
||||||
instance Steppable MatchedOperation (Referenced Param) where
|
instance Steppable MatchedOperation (Referenced Param) where
|
||||||
data Step MatchedOperation (Referenced Param) = OperationParamsStep
|
data Step MatchedOperation (Referenced Param) = OperationParamsStep Int
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Steppable MatchedOperation (Referenced RequestBody) where
|
instance Steppable MatchedOperation (Referenced RequestBody) where
|
||||||
@ -173,9 +209,9 @@ instance Steppable MatchedOperation Responses where
|
|||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Steppable MatchedOperation SecurityRequirement where
|
instance Steppable MatchedOperation SecurityRequirement where
|
||||||
data Step MatchedOperation SecurityRequirement = OperationSecurityRequirementStep
|
data Step MatchedOperation SecurityRequirement = OperationSecurityRequirementStep Int
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Steppable MatchedOperation Server where
|
instance Steppable MatchedOperation Server where
|
||||||
data Step MatchedOperation Server = OperationServerStep
|
data Step MatchedOperation Server = OperationServerStep Int
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
@ -1,11 +1,15 @@
|
|||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
||||||
|
|
||||||
module OpenAPI.Checker.Validate.Param () where
|
module OpenAPI.Checker.Validate.Param
|
||||||
|
( CheckIssue (..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.OpenApi
|
import Data.OpenApi
|
||||||
|
import Data.Text
|
||||||
import OpenAPI.Checker.Orphans
|
import OpenAPI.Checker.Orphans
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
import OpenAPI.Checker.Trace
|
import OpenAPI.Checker.Trace
|
||||||
@ -38,10 +42,14 @@ paramEncoding p = EncodingStyle
|
|||||||
ParamQuery -> Just $ fromMaybe False $ _paramAllowReserved p
|
ParamQuery -> Just $ fromMaybe False $ _paramAllowReserved p
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
|
tracedSchema :: Traced r Param -> Maybe (Traced r (Referenced Schema))
|
||||||
|
tracedSchema par = _paramSchema (extract par) <&> traced (ask par >>> step ParamSchema)
|
||||||
|
|
||||||
instance Subtree Param where
|
instance Subtree Param where
|
||||||
type CheckEnv Param = '[ProdCons (Definitions Schema)]
|
type CheckEnv Param = '[ProdCons (Definitions Schema)]
|
||||||
data CheckIssue Param
|
data CheckIssue Param
|
||||||
= ParamNameMismatch
|
= ParamNotMatched Text
|
||||||
|
| ParamNameMismatch
|
||||||
-- ^ Params have different names
|
-- ^ Params have different names
|
||||||
| ParamEmptinessIncompatible
|
| ParamEmptinessIncompatible
|
||||||
-- ^ Consumer requires non-empty param, but producer gives emptyable
|
-- ^ Consumer requires non-empty param, but producer gives emptyable
|
||||||
@ -53,28 +61,28 @@ instance Subtree Param where
|
|||||||
| ParamSchemaMismatch
|
| ParamSchemaMismatch
|
||||||
-- ^ One of schemas not presented
|
-- ^ One of schemas not presented
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility env (ProdCons p c) = do
|
checkCompatibility env pc@(ProdCons p c) = do
|
||||||
when (_paramName p /= _paramName c)
|
when (_paramName (extract p) /= _paramName (extract c))
|
||||||
$ issueAt producer ParamNameMismatch
|
$ issueAt p ParamNameMismatch
|
||||||
when ((fromMaybe False $ _paramRequired c) &&
|
when ((fromMaybe False . _paramRequired . extract $ c) &&
|
||||||
not (fromMaybe False $ _paramRequired p))
|
not (fromMaybe False . _paramRequired . extract $ p))
|
||||||
$ issueAt producer ParamRequired
|
$ issueAt p ParamRequired
|
||||||
case (_paramIn p, _paramIn c) of
|
case (_paramIn . extract $ p, _paramIn . extract $ c) of
|
||||||
(ParamQuery, ParamQuery) -> do
|
(ParamQuery, ParamQuery) -> do
|
||||||
-- Emptiness is only for query params
|
-- Emptiness is only for query params
|
||||||
when ((fromMaybe False $ _paramAllowEmptyValue p)
|
when ((fromMaybe False . _paramAllowEmptyValue . extract $ p)
|
||||||
&& not (fromMaybe False $ _paramAllowEmptyValue c))
|
&& not (fromMaybe False . _paramAllowEmptyValue . extract $ c))
|
||||||
$ issueAt producer ParamEmptinessIncompatible
|
$ issueAt p ParamEmptinessIncompatible
|
||||||
(a, b) | a == b -> pure ()
|
(a, b) | a == b -> pure ()
|
||||||
_ -> issueAt producer ParamPlaceIncompatible
|
_ -> issueAt p ParamPlaceIncompatible
|
||||||
unless (paramEncoding p == paramEncoding c)
|
unless (paramEncoding (extract p) == paramEncoding (extract c))
|
||||||
$ issueAt producer ParamStyleMismatch
|
$ issueAt p ParamStyleMismatch
|
||||||
case (_paramSchema p, _paramSchema c) of
|
case tracedSchema <$> pc of
|
||||||
(Just prodSchema, Just consSchema) -> localStep ParamSchema
|
ProdCons (Just prodSchema) (Just consSchema) -> do
|
||||||
$ checkCompatibility env (ProdCons prodSchema consSchema)
|
checkCompatibility env $ ProdCons prodSchema consSchema
|
||||||
(Nothing, Nothing) -> pure ()
|
ProdCons Nothing Nothing -> pure ()
|
||||||
(Nothing, Just _consSchema) -> issueAt producer ParamSchemaMismatch
|
ProdCons Nothing (Just _consSchema) -> issueAt p ParamSchemaMismatch
|
||||||
(Just _prodSchema, Nothing) -> pure ()
|
ProdCons (Just _prodSchema) Nothing -> pure ()
|
||||||
-- If consumer doesn't care then why we should?
|
-- If consumer doesn't care then why we should?
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
|
@ -2,6 +2,7 @@ module OpenAPI.Checker.Validate.PathFragment
|
|||||||
( parsePath
|
( parsePath
|
||||||
, PathFragment (..)
|
, PathFragment (..)
|
||||||
, PathFragmentParam
|
, PathFragmentParam
|
||||||
|
, CheckIssue (..)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -40,32 +41,16 @@ instance (Typeable param) => Steppable (PathFragment param) Param where
|
|||||||
data Step (PathFragment param) Param = StaticPathParam Text
|
data Step (PathFragment param) Param = StaticPathParam Text
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Subtree PathFragmentParam where
|
tracedPathFragmentParam :: Traced OpenApi PathFragmentParam -> Traced OpenApi Param
|
||||||
type CheckEnv PathFragmentParam =
|
tracedPathFragmentParam pfp = case extract pfp of
|
||||||
'[ ProdCons (Definitions Schema) ]
|
StaticPath s -> traced (ask pfp >>> step (StaticPathParam s))
|
||||||
data CheckIssue PathFragmentParam =
|
$ mempty
|
||||||
PathFragmentsDontMatch Text Text
|
{ _paramRequired = Just True
|
||||||
deriving (Eq, Ord, Show)
|
, _paramIn = ParamPath
|
||||||
-- This case isn't strictly needed. It is here for optimization.
|
, _paramAllowEmptyValue = Just False
|
||||||
checkCompatibility _ ProdCons {producer = (StaticPath x), consumer = (StaticPath y)} =
|
, _paramAllowReserved = Just False
|
||||||
if x == y
|
, _paramSchema = Just $ Inline $ staticStringSchema s }
|
||||||
then pure ()
|
DynamicPath p -> p
|
||||||
else issueAt consumer (PathFragmentsDontMatch x y)
|
|
||||||
checkCompatibility env prodCons = withTrace $ \myTrace -> do
|
|
||||||
let
|
|
||||||
tracedParams = dePathFragment <$> myTrace <*> prodCons
|
|
||||||
dePathFragment root = \case
|
|
||||||
StaticPath s -> retrace root $ Traced (step $ StaticPathParam s)
|
|
||||||
$ mempty
|
|
||||||
{ _paramRequired = Just True
|
|
||||||
, _paramIn = ParamPath
|
|
||||||
, _paramAllowEmptyValue = Just False
|
|
||||||
, _paramAllowReserved = Just False
|
|
||||||
, _paramSchema = Just $ Inline $ staticStringSchema s }
|
|
||||||
DynamicPath p -> p
|
|
||||||
params = getTraced <$> tracedParams
|
|
||||||
paramTrace = getTrace <$> tracedParams
|
|
||||||
localTrace' paramTrace $ checkCompatibility env params
|
|
||||||
|
|
||||||
staticStringSchema :: Text -> Schema
|
staticStringSchema :: Text -> Schema
|
||||||
staticStringSchema t =
|
staticStringSchema t =
|
||||||
@ -74,3 +59,18 @@ staticStringSchema t =
|
|||||||
, _schemaType = Just OpenApiString
|
, _schemaType = Just OpenApiString
|
||||||
, _schemaEnum = Just [A.String t]
|
, _schemaEnum = Just [A.String t]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
instance Subtree PathFragmentParam where
|
||||||
|
type CheckEnv PathFragmentParam =
|
||||||
|
'[ ProdCons (Definitions Schema) ]
|
||||||
|
data CheckIssue PathFragmentParam
|
||||||
|
= PathFragmentNotMatched
|
||||||
|
| PathFragmentsDontMatch Text Text
|
||||||
|
deriving (Eq, Ord, Show)
|
||||||
|
-- This case isn't strictly needed. It is here for optimization.
|
||||||
|
checkCompatibility _ (ProdCons (extract -> StaticPath x) c@(extract -> StaticPath y))
|
||||||
|
= if x == y
|
||||||
|
then pure ()
|
||||||
|
else issueAt c (PathFragmentsDontMatch x y)
|
||||||
|
checkCompatibility env prodCons = do
|
||||||
|
checkCompatibility env (tracedPathFragmentParam <$> prodCons)
|
||||||
|
@ -9,6 +9,7 @@ module OpenAPI.Checker.Validate.ProcessedPathItem
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Control.Comonad.Env
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Foldable as F
|
import Data.Foldable as F
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
@ -52,29 +53,24 @@ instance Subtree ProcessedPathItems where
|
|||||||
| AllPathsFailed FilePath
|
| AllPathsFailed FilePath
|
||||||
-- When several paths match given but all checks failed
|
-- When several paths match given but all checks failed
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility env (ProdCons p c) = do
|
checkCompatibility env pc@(ProdCons p c) = do
|
||||||
-- Each path generated by producer must be handled by consumer with exactly
|
-- Each path generated by producer must be handled by consumer with exactly
|
||||||
-- one way
|
-- one way
|
||||||
for_ (unProcessedPathItems p) $ \ prodItem -> do
|
for_ (unProcessedPathItems . extract $ p) $ \ prodItem -> do
|
||||||
let
|
let
|
||||||
prodPath = path prodItem
|
prodPath = path prodItem
|
||||||
matchedItems = do
|
matchedItems = do
|
||||||
consItem <- unProcessedPathItems c
|
consItem <- unProcessedPathItems . extract $ c
|
||||||
matched <- F.toList $ matchingPathItems $ ProdCons prodItem consItem
|
matched <- F.toList $ matchingPathItems $ ProdCons prodItem consItem
|
||||||
return matched
|
return matched
|
||||||
case matchedItems of
|
case matchedItems of
|
||||||
[] -> issueAt producer $ NoPathsMatched prodPath
|
[] -> issueAt p $ NoPathsMatched prodPath
|
||||||
[matched] -> do
|
[match] -> checkCompatibility env (retraced <$> pc <*> match)
|
||||||
-- Checking exact match with no wrapper
|
matches -> anyOfAt c (AllPathsFailed prodPath) $ do
|
||||||
let trace = matchedTrace <$> matched
|
|
||||||
localTrace trace $ checkCompatibility env matched
|
|
||||||
matches -> anyOfAt consumer (AllPathsFailed prodPath) $ do
|
|
||||||
match <- matches
|
match <- matches
|
||||||
let trace = matchedTrace <$> match
|
pure $ checkCompatibility env (retraced <$> pc <*> match)
|
||||||
pure $ localTrace trace $ checkCompatibility env match
|
|
||||||
where
|
where
|
||||||
matchedTrace :: MatchedPathItem -> Trace ProcessedPathItems MatchedPathItem
|
retraced pc mpi = traced (ask pc >>> step (MatchedPathStep $ matchedPath mpi)) mpi
|
||||||
matchedTrace mpi = step $ MatchedPathStep $ matchedPath mpi
|
|
||||||
|
|
||||||
-- | Preliminary checks two paths for compatibility. Returns Nothing if two
|
-- | Preliminary checks two paths for compatibility. Returns Nothing if two
|
||||||
-- paths obviously do not match: static parts differ or count of path elements
|
-- paths obviously do not match: static parts differ or count of path elements
|
||||||
@ -109,6 +105,25 @@ data MatchedPathItem = MatchedPathItem
|
|||||||
-- ^ Pre-parsed path from PathItem
|
-- ^ Pre-parsed path from PathItem
|
||||||
}
|
}
|
||||||
|
|
||||||
|
tracedParameters :: Traced r MatchedPathItem -> [Traced r (Referenced Param)]
|
||||||
|
tracedParameters mpi =
|
||||||
|
[ traced (ask mpi >>> step (PathItemParam i)) x
|
||||||
|
| (i, x) <- L.zip [0..] $ _pathItemParameters . pathItem $ extract mpi
|
||||||
|
]
|
||||||
|
|
||||||
|
-- TODO: simplify?
|
||||||
|
tracedFragments :: Traced r MatchedPathItem -> [Env (Trace r PathFragmentParam) (PathFragment Text)]
|
||||||
|
tracedFragments mpi =
|
||||||
|
[ env (ask mpi >>> step (PathFragmentStep i)) x
|
||||||
|
| (i, x) <- L.zip [0..] $ pathFragments $ extract mpi
|
||||||
|
]
|
||||||
|
|
||||||
|
tracedMethod
|
||||||
|
:: OperationMethod
|
||||||
|
-> Traced r MatchedPathItem
|
||||||
|
-> Maybe (Env (Trace r MatchedOperation) Operation)
|
||||||
|
tracedMethod s mpi = env (ask mpi >>> step (OperationMethodStep s)) <$> (pathItemMethod s . pathItem . extract $ mpi)
|
||||||
|
|
||||||
instance Subtree MatchedPathItem where
|
instance Subtree MatchedPathItem where
|
||||||
type CheckEnv MatchedPathItem =
|
type CheckEnv MatchedPathItem =
|
||||||
'[ ProdCons (Definitions Param)
|
'[ ProdCons (Definitions Param)
|
||||||
@ -119,63 +134,46 @@ instance Subtree MatchedPathItem where
|
|||||||
, ProdCons (Definitions Schema)
|
, ProdCons (Definitions Schema)
|
||||||
]
|
]
|
||||||
data CheckIssue MatchedPathItem
|
data CheckIssue MatchedPathItem
|
||||||
= OperationMissing (Step MatchedPathItem MatchedOperation)
|
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility env prodCons = withTrace $ \rootTrace -> do
|
checkCompatibility env prodCons = do
|
||||||
let
|
let
|
||||||
paramDefs = getH @(ProdCons (Definitions Param)) env
|
paramDefs = getH @(ProdCons (Definitions Param)) env
|
||||||
pathTracedParams = getPathParams <$> rootTrace <*> paramDefs <*> prodCons
|
pathTracedParams = getPathParams <$> paramDefs <*> prodCons
|
||||||
getPathParams
|
getPathParams
|
||||||
:: Trace OpenApi MatchedPathItem
|
:: Definitions Param
|
||||||
-> Definitions Param
|
-> Traced r MatchedPathItem
|
||||||
-> MatchedPathItem
|
-> [Traced r Param]
|
||||||
-> [Traced OpenApi Param]
|
getPathParams defs mpi = do
|
||||||
getPathParams root defs mpi = do
|
paramRef <- tracedParameters mpi
|
||||||
paramRef <- _pathItemParameters $ pathItem mpi
|
pure $ dereference defs paramRef
|
||||||
let
|
pathTracedFragments = mkPathFragments <$> prodCons
|
||||||
traced = dereferenceTraced defs
|
mkPathFragments mpi operationParams =
|
||||||
$ Traced (step PathItemParam) paramRef
|
|
||||||
res = retrace root traced
|
|
||||||
pure res
|
|
||||||
pathTracedFragments = mkPathFragments <$> rootTrace <*> prodCons
|
|
||||||
mkPathFragments myRoot mpi operationParams =
|
|
||||||
-- operationParams will be known on Operation check stage, so we give a
|
-- operationParams will be known on Operation check stage, so we give a
|
||||||
-- function, returning fragments
|
-- function, returning fragments
|
||||||
let
|
let
|
||||||
paramsMap :: Map Text (Traced OpenApi Param)
|
paramsMap :: Map Text (Traced OpenApi Param)
|
||||||
paramsMap = M.fromList $ do
|
paramsMap = M.fromList $ do
|
||||||
tracedParam <- operationParams
|
tracedParam <- operationParams
|
||||||
let pname = _paramName $ getTraced tracedParam
|
let pname = _paramName . extract $ tracedParam
|
||||||
pure (pname, tracedParam)
|
pure (pname, tracedParam)
|
||||||
fragments :: [PathFragmentParam]
|
convertFragment = \case
|
||||||
fragments = (pathFragments mpi) <&> \case
|
|
||||||
StaticPath t -> StaticPath t
|
StaticPath t -> StaticPath t
|
||||||
DynamicPath pname -> DynamicPath
|
DynamicPath pname -> DynamicPath
|
||||||
$ fromMaybe (error $ "Param not found " <> T.unpack pname)
|
$ fromMaybe (error $ "Param not found " <> T.unpack pname)
|
||||||
$ M.lookup pname paramsMap
|
$ M.lookup pname paramsMap
|
||||||
tracedFragments :: [Traced OpenApi PathFragmentParam]
|
in tracedFragments mpi <&> fmap convertFragment
|
||||||
tracedFragments = L.zip [0..] fragments <&> \(pos, frag) ->
|
|
||||||
retrace myRoot $ Traced (step $ PathFragmentStep pos) frag
|
|
||||||
in tracedFragments
|
|
||||||
operations = getOperations <$> pathTracedParams <*> pathTracedFragments <*> prodCons
|
operations = getOperations <$> pathTracedParams <*> pathTracedFragments <*> prodCons
|
||||||
getOperations pathParams getPathFragments mpi = M.fromList $ do
|
getOperations pathParams getPathFragments mpi = M.fromList $ do
|
||||||
(getOp, s) <-
|
(i, getOp) <- (\m -> (m, tracedMethod m)) <$>
|
||||||
[ (_pathItemGet, GetStep)
|
[GetMethod, PutMethod, PostMethod, DeleteMethod, OptionsMethod, HeadMethod, PatchMethod, DeleteMethod]
|
||||||
, (_pathItemPut, PutStep)
|
operation <- F.toList $ getOp mpi
|
||||||
, (_pathItemPost, PostStep)
|
|
||||||
, (_pathItemDelete, DeleteStep)
|
|
||||||
, (_pathItemOptions, OptionsStep)
|
|
||||||
, (_pathItemHead, HeadStep)
|
|
||||||
, (_pathItemPatch, PatchStep)
|
|
||||||
, (_pathItemTrace, TraceStep) ]
|
|
||||||
operation <- F.toList $ getOp $ pathItem mpi
|
|
||||||
-- Got only Justs here
|
-- Got only Justs here
|
||||||
let mop = MatchedOperation { operation , pathParams, getPathFragments }
|
let retraced = \op -> MatchedOperation { operation = op, pathParams, getPathFragments }
|
||||||
pure (s, Traced (step s) mop)
|
pure (i, retraced <$> operation)
|
||||||
check _ pc = checkCompatibility @MatchedOperation env pc
|
check pc = checkCompatibility @MatchedOperation env pc
|
||||||
-- Operations are sum-like entities. Use step to operation as key because
|
-- Operations are sum-like entities. Use step to operation as key because
|
||||||
-- why not
|
-- why not
|
||||||
checkSums OperationMissing check operations
|
checkSums OperationMissing (const check) operations
|
||||||
|
|
||||||
|
|
||||||
instance Steppable ProcessedPathItems MatchedPathItem where
|
instance Steppable ProcessedPathItems MatchedPathItem where
|
||||||
@ -183,19 +181,11 @@ instance Steppable ProcessedPathItems MatchedPathItem where
|
|||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Steppable MatchedPathItem MatchedOperation where
|
instance Steppable MatchedPathItem MatchedOperation where
|
||||||
data Step MatchedPathItem MatchedOperation
|
data Step MatchedPathItem MatchedOperation = OperationMethodStep OperationMethod
|
||||||
= GetStep
|
|
||||||
| PutStep
|
|
||||||
| PostStep
|
|
||||||
| DeleteStep
|
|
||||||
| OptionsStep
|
|
||||||
| HeadStep
|
|
||||||
| PatchStep
|
|
||||||
| TraceStep
|
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Steppable MatchedPathItem (Referenced Param) where
|
instance Steppable MatchedPathItem (Referenced Param) where
|
||||||
data Step MatchedPathItem (Referenced Param) = PathItemParam
|
data Step MatchedPathItem (Referenced Param) = PathItemParam Int
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Steppable MatchedPathItem PathFragmentParam where
|
instance Steppable MatchedPathItem PathFragmentParam where
|
||||||
|
@ -14,58 +14,36 @@ This module abstracts this logic for arbitrary elements -}
|
|||||||
|
|
||||||
module OpenAPI.Checker.Validate.Products
|
module OpenAPI.Checker.Validate.Products
|
||||||
( checkProducts
|
( checkProducts
|
||||||
, checkProducts'
|
|
||||||
, ProductLike(..)
|
, ProductLike(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.Functor
|
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.OpenApi.Internal
|
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
import OpenAPI.Checker.Trace
|
import OpenAPI.Checker.Trace
|
||||||
|
|
||||||
-- | Some entity which is product-like
|
-- | Some entity which is product-like
|
||||||
data ProductLike root a = ProductLike
|
data ProductLike root a = ProductLike
|
||||||
{ traced :: Traced root a
|
{ tracedValue :: Traced root a
|
||||||
, required :: Bool
|
, required :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
checkProducts'
|
checkProducts
|
||||||
:: forall k root t
|
:: forall k r t
|
||||||
. (Subtree root, Ord k)
|
. (Subtree t, Ord k)
|
||||||
=> (k -> CheckIssue root)
|
=> (k -> CheckIssue t)
|
||||||
-- ^ No required element found
|
-- ^ No required element found
|
||||||
-> (k -> ProdCons t -> CompatFormula t ())
|
-> (k -> ProdCons (Traced r t) -> CompatFormula' SubtreeCheckIssue r ())
|
||||||
-> ProdCons (Map k (ProductLike OpenApi t))
|
-> ProdCons (Map k (ProductLike r t))
|
||||||
-> CompatFormula root ()
|
-> CompatFormula' SubtreeCheckIssue r ()
|
||||||
checkProducts' noElt check (ProdCons p c) = for_ (M.toList c) $ \(key, consElt) ->
|
checkProducts noElt check (ProdCons p c) = for_ (M.toList c) $ \(key, consElt) ->
|
||||||
case M.lookup key p of
|
case M.lookup key p of
|
||||||
Nothing -> case required consElt of
|
Nothing -> case required consElt of
|
||||||
True -> issueAt producer $ noElt key
|
True -> issueAt (tracedValue consElt) $ noElt key
|
||||||
False -> pure ()
|
False -> pure ()
|
||||||
Just prodElt -> do
|
Just prodElt -> do
|
||||||
let
|
let
|
||||||
elts :: ProdCons (ProductLike OpenApi t)
|
elts :: ProdCons (ProductLike r t)
|
||||||
elts = ProdCons prodElt consElt
|
elts = ProdCons prodElt consElt
|
||||||
trace = getTrace . traced <$> elts
|
check key (tracedValue <$> elts)
|
||||||
elements = getTraced . traced <$> elts
|
|
||||||
localTrace' trace $ check key elements
|
|
||||||
|
|
||||||
checkProducts
|
|
||||||
:: forall k root t
|
|
||||||
. (Subtree root, Ord k)
|
|
||||||
=> (k -> CheckIssue root)
|
|
||||||
-- ^ No required element found
|
|
||||||
-> (k -> ProdCons t -> CompatFormula t ())
|
|
||||||
-> ProdCons (Map k (ProductLike root t))
|
|
||||||
-> CompatFormula root ()
|
|
||||||
checkProducts noElt check prodCons = withTrace $ \myTrace ->
|
|
||||||
let
|
|
||||||
retracedPC = retracePC <$> myTrace <*> prodCons
|
|
||||||
retracePC rootTrace els = els <&> \productLike ->
|
|
||||||
ProductLike
|
|
||||||
{ traced = retrace rootTrace $ traced productLike
|
|
||||||
, required = required productLike }
|
|
||||||
in checkProducts' noElt check retracedPC
|
|
||||||
|
@ -1,11 +1,10 @@
|
|||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
|
|
||||||
module OpenAPI.Checker.Validate.RequestBody
|
module OpenAPI.Checker.Validate.RequestBody
|
||||||
(
|
( CheckIssue (..)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Functor
|
|
||||||
import Data.HList
|
import Data.HList
|
||||||
import Data.HashMap.Strict.InsOrd as IOHM
|
import Data.HashMap.Strict.InsOrd as IOHM
|
||||||
import Data.Map.Strict as M
|
import Data.Map.Strict as M
|
||||||
@ -14,32 +13,31 @@ import Data.OpenApi
|
|||||||
import Network.HTTP.Media (MediaType)
|
import Network.HTTP.Media (MediaType)
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
import OpenAPI.Checker.Trace
|
import OpenAPI.Checker.Trace
|
||||||
import OpenAPI.Checker.Validate.MediaTypeObject ()
|
import OpenAPI.Checker.Validate.MediaTypeObject
|
||||||
import OpenAPI.Checker.Validate.Sums
|
import OpenAPI.Checker.Validate.Sums
|
||||||
|
|
||||||
|
tracedContent :: Traced r RequestBody -> IOHM.InsOrdHashMap MediaType (Traced r MediaTypeObject)
|
||||||
|
tracedContent resp = IOHM.mapWithKey (\k -> traced (ask resp >>> step (RequestMediaTypeObject k)))
|
||||||
|
$ _requestBodyContent $ extract resp
|
||||||
|
|
||||||
instance Subtree RequestBody where
|
instance Subtree RequestBody where
|
||||||
type CheckEnv RequestBody =
|
type CheckEnv RequestBody =
|
||||||
'[ ProdCons (Definitions Schema) ]
|
'[ ProdCons (Definitions Schema) ]
|
||||||
data CheckIssue RequestBody
|
data CheckIssue RequestBody
|
||||||
= RequestBodyRequired
|
= NoRequestBody
|
||||||
| RequestMediaTypeNotFound MediaType
|
| RequestBodyRequired
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility env prodCons@(ProdCons p c) =
|
checkCompatibility env prodCons@(ProdCons p c) =
|
||||||
if not (fromMaybe False $ _requestBodyRequired p)
|
if not (fromMaybe False . _requestBodyRequired . extract $ p)
|
||||||
&& (fromMaybe False $ _requestBodyRequired c)
|
&& (fromMaybe False . _requestBodyRequired . extract $ c)
|
||||||
then issueAt producer RequestBodyRequired
|
then issueAt p RequestBodyRequired
|
||||||
else
|
else
|
||||||
-- Media type object are sums-like entities.
|
-- Media type object are sums-like entities.
|
||||||
let
|
let
|
||||||
check mediaType pc = checkCompatibility @MediaTypeObject (HCons mediaType env) pc
|
check mediaType pc = checkCompatibility @MediaTypeObject (HCons mediaType env) pc
|
||||||
sumElts = getSum <$> prodCons
|
sumElts = getSum <$> prodCons
|
||||||
getSum rb = M.fromList
|
getSum rb = M.fromList . IOHM.toList $ tracedContent rb
|
||||||
$ (IOHM.toList $ _requestBodyContent rb) <&> \(mt, mto) ->
|
in checkSums (const RequestMediaTypeNotFound) check sumElts
|
||||||
( mt
|
|
||||||
, Traced
|
|
||||||
{ getTraced = mto
|
|
||||||
, getTrace = step $ RequestMediaTypeObject mt })
|
|
||||||
in checkSums RequestMediaTypeNotFound check sumElts
|
|
||||||
|
|
||||||
instance Steppable RequestBody MediaTypeObject where
|
instance Steppable RequestBody MediaTypeObject where
|
||||||
data Step RequestBody MediaTypeObject = RequestMediaTypeObject MediaType
|
data Step RequestBody MediaTypeObject = RequestMediaTypeObject MediaType
|
||||||
|
@ -6,6 +6,7 @@ module OpenAPI.Checker.Validate.Responses
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import Data.HList
|
import Data.HList
|
||||||
import Data.HashMap.Strict.InsOrd as IOHM
|
import Data.HashMap.Strict.InsOrd as IOHM
|
||||||
@ -16,18 +17,22 @@ import Network.HTTP.Media (MediaType)
|
|||||||
import OpenAPI.Checker.References
|
import OpenAPI.Checker.References
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
import OpenAPI.Checker.Trace
|
import OpenAPI.Checker.Trace
|
||||||
import OpenAPI.Checker.Validate.MediaTypeObject ()
|
import OpenAPI.Checker.Validate.MediaTypeObject
|
||||||
import OpenAPI.Checker.Validate.Products
|
import OpenAPI.Checker.Validate.Products
|
||||||
import OpenAPI.Checker.Validate.Schema ()
|
import OpenAPI.Checker.Validate.Schema ()
|
||||||
import OpenAPI.Checker.Validate.Sums
|
import OpenAPI.Checker.Validate.Sums
|
||||||
|
|
||||||
|
tracedResponses :: Traced r Responses -> IOHM.InsOrdHashMap HttpStatusCode (Traced r (Referenced Response))
|
||||||
|
tracedResponses resp = IOHM.mapWithKey (\k -> traced (ask resp >>> step (ResponseCodeStep k)))
|
||||||
|
$ _responsesResponses $ extract resp
|
||||||
|
|
||||||
instance Subtree Responses where
|
instance Subtree Responses where
|
||||||
type CheckEnv Responses =
|
type CheckEnv Responses =
|
||||||
'[ ProdCons (Definitions Response)
|
'[ ProdCons (Definitions Response)
|
||||||
, ProdCons (Definitions Header)
|
, ProdCons (Definitions Header)
|
||||||
, ProdCons (Definitions Schema)
|
, ProdCons (Definitions Schema)
|
||||||
]
|
]
|
||||||
data CheckIssue Responses = ResponseCodeNotFound HttpStatusCode
|
data CheckIssue Responses
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
-- Roles are already swapped. Producer is a server and consumer is a
|
-- Roles are already swapped. Producer is a server and consumer is a
|
||||||
-- client. Response codes are sum-like entity because we can answer with only
|
-- client. Response codes are sum-like entity because we can answer with only
|
||||||
@ -35,15 +40,20 @@ instance Subtree Responses where
|
|||||||
checkCompatibility env prodCons = do
|
checkCompatibility env prodCons = do
|
||||||
let
|
let
|
||||||
defs = getH @(ProdCons (Definitions Response)) env
|
defs = getH @(ProdCons (Definitions Response)) env
|
||||||
check _ resps = checkCompatibility @Response env resps
|
check resps = checkCompatibility @Response env resps
|
||||||
elements = getEls <$> defs <*> prodCons
|
elements = getEls <$> defs <*> prodCons
|
||||||
getEls respDef resps = M.fromList $ do
|
getEls respDef resps = M.fromList $ do
|
||||||
(code, respRef) <- IOHM.toList $ _responsesResponses resps
|
(code, respRef) <- IOHM.toList $ tracedResponses resps
|
||||||
let
|
pure (code, dereference respDef respRef)
|
||||||
traced = dereferenceTraced respDef
|
checkSums (const ResponseCodeNotFound) (const check) elements
|
||||||
$ Traced (step $ ResponseCodeStep code) respRef
|
|
||||||
pure (code, traced)
|
tracedContent :: Traced r Response -> IOHM.InsOrdHashMap MediaType (Traced r MediaTypeObject)
|
||||||
checkSums ResponseCodeNotFound check elements
|
tracedContent resp = IOHM.mapWithKey (\k -> traced (ask resp >>> step (ResponseMediaObject k)))
|
||||||
|
$ _responseContent $ extract resp
|
||||||
|
|
||||||
|
tracedHeaders :: Traced r Response -> IOHM.InsOrdHashMap HeaderName (Traced r (Referenced Header))
|
||||||
|
tracedHeaders resp = IOHM.mapWithKey (\k -> traced (ask resp >>> step (ResponseHeader k)))
|
||||||
|
$ _responseHeaders $ extract resp
|
||||||
|
|
||||||
instance Subtree Response where
|
instance Subtree Response where
|
||||||
type CheckEnv Response =
|
type CheckEnv Response =
|
||||||
@ -51,8 +61,7 @@ instance Subtree Response where
|
|||||||
, ProdCons (Definitions Schema)
|
, ProdCons (Definitions Schema)
|
||||||
]
|
]
|
||||||
data CheckIssue Response
|
data CheckIssue Response
|
||||||
= ResponseMediaTypeMissing MediaType
|
= ResponseCodeNotFound
|
||||||
| ResponseHeaderMissing HeaderName
|
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility env prodCons = do
|
checkCompatibility env prodCons = do
|
||||||
-- Roles are already swapped. Producer is a server and consumer is a client
|
-- Roles are already swapped. Producer is a server and consumer is a client
|
||||||
@ -67,46 +76,44 @@ instance Subtree Response where
|
|||||||
let mtEnv = HCons mediaType $ env
|
let mtEnv = HCons mediaType $ env
|
||||||
in checkCompatibility @MediaTypeObject mtEnv mtObj
|
in checkCompatibility @MediaTypeObject mtEnv mtObj
|
||||||
elements = getEls <$> prodCons
|
elements = getEls <$> prodCons
|
||||||
getEls resp = M.fromList $ do
|
getEls resp = M.fromList . IOHM.toList $ tracedContent resp
|
||||||
(mediaType, mtObj) <- IOHM.toList $ _responseContent resp
|
checkSums (const ResponseMediaTypeMissing) check elements
|
||||||
let traced = Traced (step $ ResponseMediaObject mediaType) mtObj
|
|
||||||
pure (mediaType, traced)
|
|
||||||
checkSums ResponseMediaTypeMissing check elements
|
|
||||||
|
|
||||||
checkHeaders = do
|
checkHeaders = do
|
||||||
-- Headers are product-like entities
|
-- Headers are product-like entities
|
||||||
let
|
let
|
||||||
check _hname hdrs = checkCompatibility @Header env hdrs
|
check hdrs = checkCompatibility @Header env hdrs
|
||||||
elements = getEls <$> headerDefs <*> prodCons
|
elements = getEls <$> headerDefs <*> prodCons
|
||||||
getEls headerDef resp = M.fromList $ do
|
getEls headerDef resp = M.fromList $ do
|
||||||
(hname, headerRef) <- IOHM.toList $ _responseHeaders resp
|
(hname, headerRef) <- IOHM.toList $ tracedHeaders resp
|
||||||
let
|
let header = dereference headerDef headerRef
|
||||||
traced = dereferenceTraced headerDef
|
pure (hname, ProductLike
|
||||||
$ Traced (step $ ResponseHeader hname) headerRef
|
{ tracedValue = header
|
||||||
required = fromMaybe False $ _headerRequired $ getTraced traced
|
, required = fromMaybe False . _headerRequired . extract $ header
|
||||||
elt = ProductLike { traced, required }
|
})
|
||||||
pure (hname, elt)
|
checkProducts (const ResponseHeaderMissing) (const check) elements
|
||||||
checkProducts ResponseHeaderMissing check elements
|
|
||||||
headerDefs = getH @(ProdCons (Definitions Header)) env
|
headerDefs = getH @(ProdCons (Definitions Header)) env
|
||||||
|
|
||||||
|
tracedSchema :: Traced r Header -> Maybe (Traced r (Referenced Schema))
|
||||||
|
tracedSchema hdr = _headerSchema (extract hdr) <&> traced (ask hdr >>> step HeaderSchema)
|
||||||
|
|
||||||
instance Subtree Header where
|
instance Subtree Header where
|
||||||
type CheckEnv Header = '[ProdCons (Definitions Schema)]
|
type CheckEnv Header = '[ProdCons (Definitions Schema)]
|
||||||
data CheckIssue Header
|
data CheckIssue Header
|
||||||
= RequiredHeaderMissing
|
= ResponseHeaderMissing
|
||||||
|
| RequiredHeaderMissing
|
||||||
| NonEmptyHeaderRequired
|
| NonEmptyHeaderRequired
|
||||||
| HeaderSchemaRequired
|
| HeaderSchemaRequired
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility env (ProdCons p c) = do
|
checkCompatibility env (ProdCons p c) = do
|
||||||
if (fromMaybe False $ _headerRequired c) && not (fromMaybe False $ _headerRequired p)
|
if (fromMaybe False $ _headerRequired $ extract c) && not (fromMaybe False $ _headerRequired $ extract p)
|
||||||
then issueAt producer RequiredHeaderMissing else pure ()
|
then issueAt p RequiredHeaderMissing else pure ()
|
||||||
if not (fromMaybe False $ _headerAllowEmptyValue c) && (fromMaybe False $ _headerAllowEmptyValue p)
|
if not (fromMaybe False $ _headerAllowEmptyValue $ extract c) && (fromMaybe False $ _headerAllowEmptyValue $ extract p)
|
||||||
then issueAt producer NonEmptyHeaderRequired else pure ()
|
then issueAt p NonEmptyHeaderRequired else pure ()
|
||||||
for_ (_headerSchema c) $ \consRef ->
|
for_ (tracedSchema c) $ \consRef ->
|
||||||
case (_headerSchema p) of
|
case tracedSchema p of
|
||||||
Nothing -> issueAt producer HeaderSchemaRequired
|
Nothing -> issueAt p HeaderSchemaRequired
|
||||||
Just prodRef -> do
|
Just prodRef -> checkCompatibility env (ProdCons prodRef consRef)
|
||||||
localStep HeaderSchema
|
|
||||||
$ checkCompatibility env $ ProdCons prodRef consRef
|
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
instance Steppable Responses (Referenced Response) where
|
instance Steppable Responses (Referenced Response) where
|
||||||
|
@ -14,7 +14,11 @@ module OpenAPI.Checker.Validate.Schema
|
|||||||
|
|
||||||
import Algebra.Lattice
|
import Algebra.Lattice
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad.Reader
|
import Control.Arrow
|
||||||
|
import Control.Comonad.Env hiding (env)
|
||||||
|
import Control.Lens hiding (cons)
|
||||||
|
import Control.Monad.Reader hiding (ask)
|
||||||
|
import qualified Control.Monad.Reader as R
|
||||||
import Control.Monad.Writer
|
import Control.Monad.Writer
|
||||||
import qualified Data.Aeson as A
|
import qualified Data.Aeson as A
|
||||||
import Data.Coerce
|
import Data.Coerce
|
||||||
@ -154,7 +158,7 @@ deriving stock instance Ord (Condition t)
|
|||||||
deriving stock instance Show (Condition t)
|
deriving stock instance Show (Condition t)
|
||||||
|
|
||||||
data SomeCondition where
|
data SomeCondition where
|
||||||
SomeCondition :: Typeable t => Condition t -> SomeCondition
|
SomeCondition :: Typeable t => Traced OpenApi (Condition t) -> SomeCondition
|
||||||
|
|
||||||
instance Eq SomeCondition where
|
instance Eq SomeCondition where
|
||||||
SomeCondition x == SomeCondition y = case cast x of
|
SomeCondition x == SomeCondition y = case cast x of
|
||||||
@ -200,8 +204,8 @@ isSingleton s
|
|||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
|
|
||||||
pattern Conjunct :: [Traced r (Condition t)] -> M.Map (Condition t) (Trace r (Condition t))
|
pattern Conjunct :: [Traced r (Condition t)] -> M.Map (Condition t) (Trace r (Condition t))
|
||||||
pattern Conjunct xs <- (map (uncurry $ flip Traced) . M.toList -> xs)
|
pattern Conjunct xs <- (map (uncurry $ flip traced) . M.toList -> xs)
|
||||||
where Conjunct xs = M.fromList [(x, t) | Traced t x <- xs]
|
where Conjunct xs = M.fromList $ (extract &&& ask) <$> xs
|
||||||
{-# COMPLETE Conjunct #-}
|
{-# COMPLETE Conjunct #-}
|
||||||
|
|
||||||
pattern SingleConjunct :: [Traced r (Condition t)] -> JsonFormula r t
|
pattern SingleConjunct :: [Traced r (Condition t)] -> JsonFormula r t
|
||||||
@ -218,19 +222,16 @@ instance BoundedJoinSemiLattice (JsonFormula r t) where
|
|||||||
instance BoundedMeetSemiLattice (JsonFormula r t) where
|
instance BoundedMeetSemiLattice (JsonFormula r t) where
|
||||||
top = TopFormula
|
top = TopFormula
|
||||||
|
|
||||||
singletonFormula :: Trace r (Condition t) -> Condition t -> JsonFormula r t
|
|
||||||
singletonFormula t x = SingleConjunct [Traced t x]
|
|
||||||
|
|
||||||
foldLattice
|
foldLattice
|
||||||
:: BoundedLattice l
|
:: BoundedLattice l
|
||||||
=> (Traced r (Condition t) -> l)
|
=> (Traced r (Condition t) -> l)
|
||||||
-> JsonFormula r t
|
-> JsonFormula r t
|
||||||
-> l
|
-> l
|
||||||
foldLattice f (DNF xss) = S.foldl' (\z w ->
|
foldLattice f (DNF xss) = S.foldl' (\z w ->
|
||||||
z \/ M.foldlWithKey' (\x y t -> x /\ f (Traced t y)) top w) bottom xss
|
z \/ M.foldlWithKey' (\x y t -> x /\ f (traced t y)) top w) bottom xss
|
||||||
|
|
||||||
satisfiesFormula :: TypedValue t -> JsonFormula r t -> Bool
|
satisfiesFormula :: TypedValue t -> JsonFormula r t -> Bool
|
||||||
satisfiesFormula val = foldLattice (satisfiesTyped val . getTraced)
|
satisfiesFormula val = foldLattice (satisfiesTyped val . extract)
|
||||||
|
|
||||||
data ForeachType (f :: JsonType -> Type) = ForeachType
|
data ForeachType (f :: JsonType -> Type) = ForeachType
|
||||||
{ forNull :: f 'Null
|
{ forNull :: f 'Null
|
||||||
@ -345,22 +346,52 @@ instance Steppable Schema (Referenced Schema) where
|
|||||||
= AllOfStep Int
|
= AllOfStep Int
|
||||||
| OneOfStep Int
|
| OneOfStep Int
|
||||||
| AnyOfStep Int
|
| AnyOfStep Int
|
||||||
| ItemsStep
|
| ItemsObjectStep
|
||||||
|
| ItemsArrayStep Int
|
||||||
| AdditionalPropertiesStep
|
| AdditionalPropertiesStep
|
||||||
| PropertiesStep Text
|
| PropertiesStep Text
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
type ProcessM = ReaderT (Definitions Schema) (Writer (T.TracePrefixTree SubtreeCheckIssue OpenApi))
|
type ProcessM = ReaderT (Definitions Schema) (Writer (T.TracePrefixTree SubtreeCheckIssue OpenApi))
|
||||||
|
|
||||||
warn :: Subtree t => Trace OpenApi t -> CheckIssue t -> ProcessM ()
|
warn
|
||||||
warn t x = tell $ T.singleton $ AnItem t $ SubtreeCheckIssue x
|
:: (Subtree t, ComonadEnv (Trace OpenApi t) w)
|
||||||
|
=> w x -> CheckIssue t -> ProcessM ()
|
||||||
|
warn t issue = tell $ T.singleton $ AnItem (ask t) $ SubtreeCheckIssue issue
|
||||||
|
|
||||||
processRefSchema
|
processRefSchema
|
||||||
:: Traced OpenApi (Referenced Schema)
|
:: Traced OpenApi (Referenced Schema)
|
||||||
-> ProcessM (ForeachType (JsonFormula OpenApi))
|
-> ProcessM (ForeachType (JsonFormula OpenApi))
|
||||||
processRefSchema x = do
|
processRefSchema x = do
|
||||||
defs <- ask
|
defs <- R.ask
|
||||||
processSchema $ dereferenceTraced defs x
|
processSchema $ dereference defs x
|
||||||
|
|
||||||
|
tracedAllOf :: Traced r Schema -> Maybe [Traced r (Referenced Schema)]
|
||||||
|
tracedAllOf sch = _schemaAllOf (extract sch) <&> \xs ->
|
||||||
|
[ traced (ask sch >>> step (AllOfStep i)) x | (i, x) <- zip [0..] xs ]
|
||||||
|
|
||||||
|
tracedAnyOf :: Traced r Schema -> Maybe [Traced r (Referenced Schema)]
|
||||||
|
tracedAnyOf sch = _schemaAnyOf (extract sch) <&> \xs ->
|
||||||
|
[ traced (ask sch >>> step (AnyOfStep i)) x | (i, x) <- zip [0..] xs ]
|
||||||
|
|
||||||
|
tracedOneOf :: Traced r Schema -> Maybe [Traced r (Referenced Schema)]
|
||||||
|
tracedOneOf sch = _schemaOneOf (extract sch) <&> \xs ->
|
||||||
|
[ traced (ask sch >>> step (OneOfStep i)) x | (i, x) <- zip [0..] xs ]
|
||||||
|
|
||||||
|
tracedItems :: Traced r Schema -> Maybe (Either (Traced r (Referenced Schema)) [Traced r (Referenced Schema)])
|
||||||
|
tracedItems sch = _schemaItems (extract sch) <&> \case
|
||||||
|
OpenApiItemsObject x -> Left $ traced (ask sch >>> step ItemsObjectStep) x
|
||||||
|
OpenApiItemsArray xs -> Right
|
||||||
|
[ traced (ask sch >>> step (ItemsArrayStep i)) x | (i, x) <- zip [0..] xs ]
|
||||||
|
|
||||||
|
tracedAdditionalProperties :: Traced r Schema -> Maybe (Either Bool (Traced r (Referenced Schema)))
|
||||||
|
tracedAdditionalProperties sch = _schemaAdditionalProperties (extract sch) <&> \case
|
||||||
|
AdditionalPropertiesAllowed b -> Left b
|
||||||
|
AdditionalPropertiesSchema x -> Right $ traced (ask sch >>> step AdditionalPropertiesStep) x
|
||||||
|
|
||||||
|
tracedProperties :: Traced r Schema -> IOHM.InsOrdHashMap Text (Traced r (Referenced Schema))
|
||||||
|
tracedProperties sch = IOHM.mapWithKey (\k -> traced (ask sch >>> step (PropertiesStep k)))
|
||||||
|
$ _schemaProperties $ extract sch
|
||||||
|
|
||||||
-- | Turn a schema into a tuple of 'JsonFormula's that describes the condition
|
-- | Turn a schema into a tuple of 'JsonFormula's that describes the condition
|
||||||
-- for every possible type of a JSON value. The conditions are independent, and
|
-- for every possible type of a JSON value. The conditions are independent, and
|
||||||
@ -368,36 +399,33 @@ processRefSchema x = do
|
|||||||
processSchema
|
processSchema
|
||||||
:: Traced OpenApi Schema
|
:: Traced OpenApi Schema
|
||||||
-> ProcessM (ForeachType (JsonFormula OpenApi))
|
-> ProcessM (ForeachType (JsonFormula OpenApi))
|
||||||
processSchema (Traced t Schema{..}) = do
|
processSchema sch@(extract -> Schema{..}) = do
|
||||||
|
let
|
||||||
|
singletonFormula :: Typeable t => Step Schema (Condition t) -> Condition t -> JsonFormula OpenApi t
|
||||||
|
singletonFormula t f = SingleConjunct [traced (ask sch >>> step t) f]
|
||||||
|
|
||||||
allClauses <- case _schemaAllOf of
|
allClauses <- case tracedAllOf sch of
|
||||||
Nothing -> pure []
|
Nothing -> pure []
|
||||||
Just [] -> [] <$ warn t (InvalidSchema "no items in allOf")
|
Just [] -> [] <$ warn sch (InvalidSchema "no items in allOf")
|
||||||
Just xs -> sequence
|
Just xs -> mapM processRefSchema xs
|
||||||
[ processRefSchema (Traced (t `Snoc` AllOfStep i) rs)
|
|
||||||
| (i, rs) <- zip [0..] xs ]
|
|
||||||
|
|
||||||
anyClause <- case _schemaAnyOf of
|
anyClause <- case tracedAnyOf sch of
|
||||||
Nothing -> pure top
|
Nothing -> pure top
|
||||||
Just [] -> bottom <$ warn t (InvalidSchema "no items in anyOf")
|
Just [] -> bottom <$ warn sch (InvalidSchema "no items in anyOf")
|
||||||
Just xs -> joins <$> sequence
|
Just xs -> joins <$> mapM processRefSchema xs
|
||||||
[ processRefSchema (Traced (t `Snoc` AnyOfStep i) rs)
|
|
||||||
| (i, rs) <- zip [0..] xs ]
|
|
||||||
|
|
||||||
oneClause <- case _schemaOneOf of
|
oneClause <- case tracedOneOf sch of
|
||||||
Nothing -> pure top
|
Nothing -> pure top
|
||||||
Just [] -> bottom <$ warn t (InvalidSchema "no items in oneOf")
|
Just [] -> bottom <$ warn sch (InvalidSchema "no items in oneOf")
|
||||||
Just xs -> do
|
Just xs -> do
|
||||||
checkOneOfDisjoint xs >>= \case
|
checkOneOfDisjoint xs >>= \case
|
||||||
True -> pure ()
|
True -> pure ()
|
||||||
False -> warn t (NotSupported "Could not determine that oneOf branches are disjoint")
|
False -> warn sch (NotSupported "Could not determine that oneOf branches are disjoint")
|
||||||
joins <$> sequence
|
joins <$> mapM processRefSchema xs
|
||||||
[ processRefSchema (Traced (t `Snoc` OneOfStep i) rs)
|
|
||||||
| (i, rs) <- zip [0..] xs ]
|
|
||||||
|
|
||||||
case _schemaNot of
|
case _schemaNot of
|
||||||
Nothing -> pure ()
|
Nothing -> pure ()
|
||||||
Just _ -> warn t (NotSupported "not clause is unsupported")
|
Just _ -> warn sch (NotSupported "not clause is unsupported")
|
||||||
|
|
||||||
let
|
let
|
||||||
typeClause = case _schemaType of
|
typeClause = case _schemaType of
|
||||||
@ -409,7 +437,7 @@ processSchema (Traced t Schema{..}) = do
|
|||||||
Just OpenApiNumber -> bottom
|
Just OpenApiNumber -> bottom
|
||||||
{ forBoolean = top }
|
{ forBoolean = top }
|
||||||
Just OpenApiInteger -> bottom
|
Just OpenApiInteger -> bottom
|
||||||
{ forNumber = singletonFormula (t `Snoc` IntegerType) $ MultipleOf 1 }
|
{ forNumber = singletonFormula IntegerType $ MultipleOf 1 }
|
||||||
Just OpenApiString -> bottom
|
Just OpenApiString -> bottom
|
||||||
{ forString = top }
|
{ forString = top }
|
||||||
Just OpenApiArray -> bottom
|
Just OpenApiArray -> bottom
|
||||||
@ -419,27 +447,27 @@ processSchema (Traced t Schema{..}) = do
|
|||||||
|
|
||||||
let
|
let
|
||||||
valueEnum A.Null = bottom
|
valueEnum A.Null = bottom
|
||||||
{ forNull = singletonFormula (t `Snoc` EnumField) $ Exactly TNull }
|
{ forNull = singletonFormula EnumField $ Exactly TNull }
|
||||||
valueEnum (A.Bool b) = bottom
|
valueEnum (A.Bool b) = bottom
|
||||||
{ forBoolean = singletonFormula (t `Snoc` EnumField) $ Exactly $ TBool b }
|
{ forBoolean = singletonFormula EnumField $ Exactly $ TBool b }
|
||||||
valueEnum (A.Number n) = bottom
|
valueEnum (A.Number n) = bottom
|
||||||
{ forNumber = singletonFormula (t `Snoc` EnumField) $ Exactly $ TNumber n }
|
{ forNumber = singletonFormula EnumField $ Exactly $ TNumber n }
|
||||||
valueEnum (A.String s) = bottom
|
valueEnum (A.String s) = bottom
|
||||||
{ forString = singletonFormula (t `Snoc` EnumField) $ Exactly $ TString s }
|
{ forString = singletonFormula EnumField $ Exactly $ TString s }
|
||||||
valueEnum (A.Array a) = bottom
|
valueEnum (A.Array a) = bottom
|
||||||
{ forArray = singletonFormula (t `Snoc` EnumField) $ Exactly $ TArray a }
|
{ forArray = singletonFormula EnumField $ Exactly $ TArray a }
|
||||||
valueEnum (A.Object o) = bottom
|
valueEnum (A.Object o) = bottom
|
||||||
{ forObject = singletonFormula (t `Snoc` EnumField) $ Exactly $ TObject o }
|
{ forObject = singletonFormula EnumField $ Exactly $ TObject o }
|
||||||
enumClause <- case _schemaEnum of
|
enumClause <- case _schemaEnum of
|
||||||
Nothing -> pure top
|
Nothing -> pure top
|
||||||
Just [] -> bottom <$ warn t (InvalidSchema "no items in enum")
|
Just [] -> bottom <$ warn sch (InvalidSchema "no items in enum")
|
||||||
Just xs -> pure $ joins (valueEnum <$> xs)
|
Just xs -> pure $ joins (valueEnum <$> xs)
|
||||||
|
|
||||||
let
|
let
|
||||||
maximumClause = case _schemaMaximum of
|
maximumClause = case _schemaMaximum of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forNumber = singletonFormula (t `Snoc` MaximumFields) $ Maximum $
|
{ forNumber = singletonFormula MaximumFields $ Maximum $
|
||||||
case _schemaExclusiveMaximum of
|
case _schemaExclusiveMaximum of
|
||||||
Just True -> Exclusive n
|
Just True -> Exclusive n
|
||||||
_ -> Inclusive n }
|
_ -> Inclusive n }
|
||||||
@ -447,7 +475,7 @@ processSchema (Traced t Schema{..}) = do
|
|||||||
minimumClause = case _schemaMinimum of
|
minimumClause = case _schemaMinimum of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forNumber = singletonFormula (t `Snoc` MinimumFields) $ Minimum $ Down $
|
{ forNumber = singletonFormula MinimumFields $ Minimum $ Down $
|
||||||
case _schemaExclusiveMinimum of
|
case _schemaExclusiveMinimum of
|
||||||
Just True -> Exclusive $ Down n
|
Just True -> Exclusive $ Down n
|
||||||
_ -> Inclusive $ Down n }
|
_ -> Inclusive $ Down n }
|
||||||
@ -455,72 +483,68 @@ processSchema (Traced t Schema{..}) = do
|
|||||||
multipleOfClause = case _schemaMultipleOf of
|
multipleOfClause = case _schemaMultipleOf of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forNumber = singletonFormula (t `Snoc` MultipleOfField) $ MultipleOf n }
|
{ forNumber = singletonFormula MultipleOfField $ MultipleOf n }
|
||||||
|
|
||||||
formatClause <- case _schemaFormat of
|
formatClause <- case _schemaFormat of
|
||||||
Nothing -> pure top
|
Nothing -> pure top
|
||||||
Just f | f `elem` ["int32", "int64", "float", "double"] -> pure top
|
Just f | f `elem` ["int32", "int64", "float", "double"] -> pure top
|
||||||
{ forNumber = singletonFormula (t `Snoc` FormatField) $ NumberFormat f }
|
{ forNumber = singletonFormula FormatField $ NumberFormat f }
|
||||||
Just f | f `elem` ["byte", "binary", "date", "date-time", "password"] -> pure top
|
Just f | f `elem` ["byte", "binary", "date", "date-time", "password"] -> pure top
|
||||||
{ forString = singletonFormula (t `Snoc` FormatField) $ StringFormat f }
|
{ forString = singletonFormula FormatField $ StringFormat f }
|
||||||
Just f -> top <$ warn t (NotSupported $ "Unknown format: " <> f)
|
Just f -> top <$ warn sch (NotSupported $ "Unknown format: " <> f)
|
||||||
|
|
||||||
let
|
let
|
||||||
maxLengthClause = case _schemaMaxLength of
|
maxLengthClause = case _schemaMaxLength of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forString = singletonFormula (t `Snoc` MaxLengthField) $ MaxLength n }
|
{ forString = singletonFormula MaxLengthField $ MaxLength n }
|
||||||
|
|
||||||
minLengthClause = case _schemaMinLength of
|
minLengthClause = case _schemaMinLength of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forString = singletonFormula (t `Snoc` MinLengthField) $ MinLength n }
|
{ forString = singletonFormula MinLengthField $ MinLength n }
|
||||||
|
|
||||||
patternClause = case _schemaPattern of
|
patternClause = case _schemaPattern of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just p -> top
|
Just p -> top
|
||||||
{ forString = singletonFormula (t `Snoc` PatternField) $ Pattern p }
|
{ forString = singletonFormula PatternField $ Pattern p }
|
||||||
|
|
||||||
itemsClause <- case _schemaItems of
|
itemsClause <- case tracedItems sch of
|
||||||
Nothing -> pure top
|
Nothing -> pure top
|
||||||
Just (OpenApiItemsObject rs) -> do
|
Just (Left rs) -> do
|
||||||
let trs = Traced (t `Snoc` ItemsStep) rs
|
f <- processRefSchema rs
|
||||||
f <- processRefSchema trs
|
pure top { forArray = singletonFormula ItemsField $ Items f rs }
|
||||||
pure top { forArray = singletonFormula (t `Snoc` ItemsField) $ Items f trs }
|
Just (Right _) -> top <$ warn sch (NotSupported "array in items is not supported")
|
||||||
Just (OpenApiItemsArray _) -> top <$ warn t (NotSupported "array in items is not supported")
|
|
||||||
|
|
||||||
let
|
let
|
||||||
maxItemsClause = case _schemaMaxItems of
|
maxItemsClause = case _schemaMaxItems of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forArray = singletonFormula (t `Snoc` MaxItemsField) $ MaxItems n }
|
{ forArray = singletonFormula MaxItemsField $ MaxItems n }
|
||||||
|
|
||||||
minItemsClause = case _schemaMinItems of
|
minItemsClause = case _schemaMinItems of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forArray = singletonFormula (t `Snoc` MinItemsField) $ MinItems n }
|
{ forArray = singletonFormula MinItemsField $ MinItems n }
|
||||||
|
|
||||||
uniqueItemsClause = case _schemaUniqueItems of
|
uniqueItemsClause = case _schemaUniqueItems of
|
||||||
Just True -> top
|
Just True -> top
|
||||||
{ forArray = singletonFormula (t `Snoc` UniqueItemsField) UniqueItems }
|
{ forArray = singletonFormula UniqueItemsField UniqueItems }
|
||||||
_ -> top
|
_ -> top
|
||||||
|
|
||||||
(addProps, addPropSchema) <- case _schemaAdditionalProperties of
|
(addProps, addPropSchema) <- case tracedAdditionalProperties sch of
|
||||||
Just (AdditionalPropertiesSchema rs) -> do
|
Just (Right rs) -> (,Just rs) <$> processRefSchema rs
|
||||||
let trs = Traced (t `Snoc` AdditionalPropertiesStep) rs
|
Just (Left False) -> pure (bottom, Nothing)
|
||||||
(,Just trs) <$> processRefSchema trs
|
_ -> pure (top, Just $ traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty)
|
||||||
Just (AdditionalPropertiesAllowed False) -> pure (bottom, Nothing)
|
|
||||||
_ -> pure (top, Just $ Traced (t `Snoc` AdditionalPropertiesStep) $ Inline mempty)
|
|
||||||
propList <- forM (S.toList . S.fromList $ IOHM.keys _schemaProperties <> _schemaRequired) $ \k -> do
|
propList <- forM (S.toList . S.fromList $ IOHM.keys _schemaProperties <> _schemaRequired) $ \k -> do
|
||||||
(f, sch) <- case IOHM.lookup k _schemaProperties of
|
(f, psch) <- case IOHM.lookup k $ tracedProperties sch of
|
||||||
Just rs -> do
|
Just rs -> (,rs) <$> processRefSchema rs
|
||||||
let trs = Traced (t `Snoc` PropertiesStep k) rs
|
Nothing -> let fakeSchema = traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty
|
||||||
(,trs) <$> processRefSchema trs
|
|
||||||
Nothing -> pure (addProps, fromMaybe (Traced (t `Snoc` AdditionalPropertiesStep) $ Inline mempty) addPropSchema)
|
|
||||||
-- The mempty here is incorrect, but if addPropSchema was Nothing, then
|
-- The mempty here is incorrect, but if addPropSchema was Nothing, then
|
||||||
-- addProps is bottom, and k is in _schemaRequired. We handle this situation
|
-- addProps is bottom, and k is in _schemaRequired. We handle this situation
|
||||||
-- below and short-circuit the entire Properties condition to bottom
|
-- below and short-circuit the entire Properties condition to bottom
|
||||||
pure (k, Property (k `elem` _schemaRequired) f sch)
|
in pure (addProps, fromMaybe fakeSchema addPropSchema)
|
||||||
|
pure (k, Property (k `elem` _schemaRequired) f psch)
|
||||||
let
|
let
|
||||||
allBottom f = getAll $ foldType $ \ty -> case ty f of
|
allBottom f = getAll $ foldType $ \ty -> case ty f of
|
||||||
BottomFormula -> All True
|
BottomFormula -> All True
|
||||||
@ -537,21 +561,21 @@ processSchema (Traced t Schema{..}) = do
|
|||||||
= top -- if all fields are optional and have trivial schemata
|
= top -- if all fields are optional and have trivial schemata
|
||||||
| otherwise
|
| otherwise
|
||||||
= top
|
= top
|
||||||
{ forObject = singletonFormula (t `Snoc` PropertiesFields) $ Properties propMap addProps addPropSchema }
|
{ forObject = singletonFormula PropertiesFields $ Properties propMap addProps addPropSchema }
|
||||||
|
|
||||||
maxPropertiesClause = case _schemaMaxProperties of
|
maxPropertiesClause = case _schemaMaxProperties of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forObject = singletonFormula (t `Snoc` MaxPropertiesField) $ MaxProperties n }
|
{ forObject = singletonFormula MaxPropertiesField $ MaxProperties n }
|
||||||
|
|
||||||
minPropertiesClause = case _schemaMinProperties of
|
minPropertiesClause = case _schemaMinProperties of
|
||||||
Nothing -> top
|
Nothing -> top
|
||||||
Just n -> top
|
Just n -> top
|
||||||
{ forObject = singletonFormula (t `Snoc` MinPropertiesField) $ MinProperties n }
|
{ forObject = singletonFormula MinPropertiesField $ MinProperties n }
|
||||||
|
|
||||||
nullableClause
|
nullableClause
|
||||||
| Just True <- _schemaNullable = bottom
|
| Just True <- _schemaNullable = bottom
|
||||||
{ forNull = singletonFormula (t `Snoc` NullableField) $ Exactly TNull }
|
{ forNull = singletonFormula NullableField $ Exactly TNull }
|
||||||
| otherwise = bottom
|
| otherwise = bottom
|
||||||
|
|
||||||
pure $ nullableClause \/ meets (allClauses <>
|
pure $ nullableClause \/ meets (allClauses <>
|
||||||
@ -561,7 +585,7 @@ processSchema (Traced t Schema{..}) = do
|
|||||||
, uniqueItemsClause, propertiesClause, maxPropertiesClause, minPropertiesClause])
|
, uniqueItemsClause, propertiesClause, maxPropertiesClause, minPropertiesClause])
|
||||||
{- TODO: ReadOnly/WriteOnly -}
|
{- TODO: ReadOnly/WriteOnly -}
|
||||||
|
|
||||||
checkOneOfDisjoint :: [Referenced Schema] -> ProcessM Bool
|
checkOneOfDisjoint :: [Traced OpenApi (Referenced Schema)] -> ProcessM Bool
|
||||||
checkOneOfDisjoint = const $ pure True -- TODO
|
checkOneOfDisjoint = const $ pure True -- TODO
|
||||||
|
|
||||||
schemaToFormula
|
schemaToFormula
|
||||||
@ -575,7 +599,7 @@ checkFormulas
|
|||||||
=> HList xs
|
=> HList xs
|
||||||
-> Trace OpenApi Schema
|
-> Trace OpenApi Schema
|
||||||
-> ProdCons (ForeachType (JsonFormula OpenApi), T.TracePrefixTree SubtreeCheckIssue OpenApi)
|
-> ProdCons (ForeachType (JsonFormula OpenApi), T.TracePrefixTree SubtreeCheckIssue OpenApi)
|
||||||
-> CompatFormula Schema ()
|
-> CompatFormula ()
|
||||||
checkFormulas env tr (ProdCons (fp, ep) (fc, ec)) =
|
checkFormulas env tr (ProdCons (fp, ep) (fc, ec)) =
|
||||||
case T.toList ep ++ T.toList ec of
|
case T.toList ep ++ T.toList ec of
|
||||||
issues@(_:_) -> F.for_ issues $ \(AnItem t (SubtreeCheckIssue e)) -> issueAtTrace t e
|
issues@(_:_) -> F.for_ issues $ \(AnItem t (SubtreeCheckIssue e)) -> issueAtTrace t e
|
||||||
@ -613,13 +637,13 @@ checkFormulas env tr (ProdCons (fp, ep) (fc, ec)) =
|
|||||||
(DNF pss, SingleConjunct cs) -> F.for_ pss $ \(Conjunct ps) -> do
|
(DNF pss, SingleConjunct cs) -> F.for_ pss $ \(Conjunct ps) -> do
|
||||||
F.for_ cs $ checkImplication env ps -- avoid disjuntion if there's only one conjunct
|
F.for_ cs $ checkImplication env ps -- avoid disjuntion if there's only one conjunct
|
||||||
(DNF pss, DNF css) -> F.for_ pss $ \(Conjunct ps) -> do
|
(DNF pss, DNF css) -> F.for_ pss $ \(Conjunct ps) -> do
|
||||||
anyOfM tr (SubtreeCheckIssue $ NoMatchingCondition $ SomeCondition . getTraced <$> ps)
|
anyOfM tr (NoMatchingCondition $ SomeCondition <$> ps)
|
||||||
[F.for_ cs $ checkImplication env ps | Conjunct cs <- S.toList css]
|
[F.for_ cs $ checkImplication env ps | Conjunct cs <- S.toList css]
|
||||||
|
|
||||||
checkContradiction
|
checkContradiction
|
||||||
:: Trace OpenApi Schema
|
:: Trace OpenApi Schema
|
||||||
-> [Traced OpenApi (Condition t)]
|
-> [Traced OpenApi (Condition t)]
|
||||||
-> CompatFormula s ()
|
-> CompatFormula ()
|
||||||
checkContradiction tr _ = issueAtTrace tr NoContradiction -- TODO
|
checkContradiction tr _ = issueAtTrace tr NoContradiction -- TODO
|
||||||
|
|
||||||
checkImplication
|
checkImplication
|
||||||
@ -627,96 +651,93 @@ checkImplication
|
|||||||
=> HList xs
|
=> HList xs
|
||||||
-> [Traced OpenApi (Condition t)]
|
-> [Traced OpenApi (Condition t)]
|
||||||
-> Traced OpenApi (Condition t)
|
-> Traced OpenApi (Condition t)
|
||||||
-> CompatFormula s ()
|
-> CompatFormula ()
|
||||||
checkImplication env prods (Traced t cons) = case findExactly prods of
|
checkImplication env prods cons = case findExactly prods of
|
||||||
Just e
|
Just e
|
||||||
| all (satisfiesTyped e) (getTraced <$> prods) ->
|
| all (satisfiesTyped e) (extract <$> prods) ->
|
||||||
if satisfiesTyped e cons then pure ()
|
if satisfiesTyped e $ extract cons then pure ()
|
||||||
else issueAtTrace t (EnumDoesntSatisfy e)
|
else issueAt cons (EnumDoesntSatisfy e)
|
||||||
| otherwise -> pure () -- vacuously true
|
| otherwise -> pure () -- vacuously true
|
||||||
Nothing -> case cons of
|
Nothing -> case extract cons of
|
||||||
-- the above code didn't catch it, so there's no Exactly condition on the lhs
|
-- the above code didn't catch it, so there's no Exactly condition on the lhs
|
||||||
Exactly e -> issueAtTrace t (NoMatchingEnum e)
|
Exactly e -> issueAt cons (NoMatchingEnum e)
|
||||||
Maximum m -> case findRelevant min (\case Maximum m' -> Just m'; _ -> Nothing) prods of
|
Maximum m -> case findRelevant min (\case Maximum m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' <= m then pure ()
|
Just m' -> if m' <= m then pure ()
|
||||||
else issueAtTrace t (MatchingMaximumWeak m m')
|
else issueAt cons (MatchingMaximumWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMaximum m)
|
Nothing -> issueAt cons (NoMatchingMaximum m)
|
||||||
Minimum m -> case findRelevant max (\case Minimum m' -> Just m'; _ -> Nothing) prods of
|
Minimum m -> case findRelevant max (\case Minimum m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' >= m then pure ()
|
Just m' -> if m' >= m then pure ()
|
||||||
else issueAtTrace t (MatchingMinimumWeak (coerce m) (coerce m'))
|
else issueAt cons (MatchingMinimumWeak (coerce m) (coerce m'))
|
||||||
Nothing -> issueAtTrace t (NoMatchingMinimum (coerce m))
|
Nothing -> issueAt cons (NoMatchingMinimum (coerce m))
|
||||||
MultipleOf m -> case findRelevant lcmScientific (\case MultipleOf m' -> Just m'; _ -> Nothing) prods of
|
MultipleOf m -> case findRelevant lcmScientific (\case MultipleOf m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if lcmScientific m m' == m' then pure ()
|
Just m' -> if lcmScientific m m' == m' then pure ()
|
||||||
else issueAtTrace t (MatchingMultipleOfWeak m m')
|
else issueAt cons (MatchingMultipleOfWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMultipleOf m)
|
Nothing -> issueAt cons (NoMatchingMultipleOf m)
|
||||||
NumberFormat f -> if any (\case NumberFormat f' -> f == f'; _ -> False) $ getTraced <$> prods
|
NumberFormat f -> if any (\case NumberFormat f' -> f == f'; _ -> False) $ extract <$> prods
|
||||||
then pure () else issueAtTrace t (NoMatchingFormat f)
|
then pure () else issueAt cons (NoMatchingFormat f)
|
||||||
MaxLength m -> case findRelevant min (\case MaxLength m' -> Just m'; _ -> Nothing) prods of
|
MaxLength m -> case findRelevant min (\case MaxLength m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' <= m then pure ()
|
Just m' -> if m' <= m then pure ()
|
||||||
else issueAtTrace t (MatchingMaxLengthWeak m m')
|
else issueAt cons (MatchingMaxLengthWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMaxLength m)
|
Nothing -> issueAt cons (NoMatchingMaxLength m)
|
||||||
MinLength m -> case findRelevant max (\case MinLength m' -> Just m'; _ -> Nothing) prods of
|
MinLength m -> case findRelevant max (\case MinLength m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' >= m then pure ()
|
Just m' -> if m' >= m then pure ()
|
||||||
else issueAtTrace t (MatchingMinLengthWeak m m')
|
else issueAt cons (MatchingMinLengthWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMinLength m)
|
Nothing -> issueAt cons (NoMatchingMinLength m)
|
||||||
Pattern p -> if any (\case Pattern p' -> p == p'; _ -> False) $ getTraced <$> prods
|
Pattern p -> if any (\case Pattern p' -> p == p'; _ -> False) $ extract <$> prods
|
||||||
then pure () else issueAtTrace t (NoMatchingPattern p)
|
then pure () else issueAt cons (NoMatchingPattern p)
|
||||||
StringFormat f -> if any (\case StringFormat f' -> f == f'; _ -> False) $ getTraced <$> prods
|
StringFormat f -> if any (\case StringFormat f' -> f == f'; _ -> False) $ extract <$> prods
|
||||||
then pure () else issueAtTrace t (NoMatchingFormat f)
|
then pure () else issueAt cons (NoMatchingFormat f)
|
||||||
Items _ (Traced t' cons') -> case findRelevant (<>) (\case Items _ rs -> Just (rs NE.:| []); _ -> Nothing) prods of
|
Items _ cons' -> case findRelevant (<>) (\case Items _ rs -> Just (rs NE.:| []); _ -> Nothing) prods of
|
||||||
Just (rs NE.:| []) -> localTrace' (ProdCons (getTrace rs) t') $ checkCompatibility env $ ProdCons (getTraced rs) cons'
|
Just (rs NE.:| []) -> checkCompatibility env $ ProdCons rs cons'
|
||||||
Just rs -> do
|
Just rs -> do
|
||||||
let sch = Inline mempty { _schemaAllOf = Just . NE.toList $ getTraced <$> rs }
|
let sch = Inline mempty { _schemaAllOf = Just . NE.toList $ extract <$> rs }
|
||||||
localTrace' (pure t' {- TODO: what? -}) $ checkCompatibility env $ ProdCons sch cons'
|
checkCompatibility env $ ProdCons (traced (ask $ NE.head rs) sch) cons' -- TODO: bad trace
|
||||||
Nothing -> issueAtTrace t NoMatchingItems
|
Nothing -> issueAt cons NoMatchingItems
|
||||||
MaxItems m -> case findRelevant min (\case MaxItems m' -> Just m'; _ -> Nothing) prods of
|
MaxItems m -> case findRelevant min (\case MaxItems m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' <= m then pure ()
|
Just m' -> if m' <= m then pure ()
|
||||||
else issueAtTrace t (MatchingMaxItemsWeak m m')
|
else issueAt cons (MatchingMaxItemsWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMaxItems m)
|
Nothing -> issueAt cons (NoMatchingMaxItems m)
|
||||||
MinItems m -> case findRelevant max (\case MinItems m' -> Just m'; _ -> Nothing) prods of
|
MinItems m -> case findRelevant max (\case MinItems m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' >= m then pure ()
|
Just m' -> if m' >= m then pure ()
|
||||||
else issueAtTrace t (MatchingMinItemsWeak m m')
|
else issueAt cons (MatchingMinItemsWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMinItems m)
|
Nothing -> issueAt cons (NoMatchingMinItems m)
|
||||||
UniqueItems -> if any ((== UniqueItems) . getTraced) prods then pure ()
|
UniqueItems -> if any (== UniqueItems) $ extract <$> prods then pure ()
|
||||||
else issueAtTrace t NoMatchingUniqueItems
|
else issueAt cons NoMatchingUniqueItems
|
||||||
Properties props _ madd -> case findRelevant (<>) (\case Properties props' _ madd' -> Just $ (props', madd') NE.:| []; _ -> Nothing) prods of
|
Properties props _ madd -> case findRelevant (<>) (\case Properties props' _ madd' -> Just $ (props', madd') NE.:| []; _ -> Nothing) prods of
|
||||||
Just ((props', madd') NE.:| []) -> do
|
Just ((props', madd') NE.:| []) -> do
|
||||||
F.for_ (S.fromList $ M.keys props <> M.keys props') $ \k -> do
|
F.for_ (S.fromList $ M.keys props <> M.keys props') $ \k -> do
|
||||||
let
|
let go sch sch' = checkCompatibility env (ProdCons sch sch')
|
||||||
go sch' sch = let schs = ProdCons sch' sch
|
|
||||||
in localTrace' (getTrace <$> schs) $ checkCompatibility env $ getTraced <$> schs
|
|
||||||
case (M.lookup k props', madd', M.lookup k props, madd) of
|
case (M.lookup k props', madd', M.lookup k props, madd) of
|
||||||
(Nothing, Nothing, _, _) -> pure () -- vacuously
|
(Nothing, Nothing, _, _) -> pure () -- vacuously
|
||||||
(_, _, Nothing, Nothing) -> issueAtTrace t (UnexpectedProperty k)
|
(_, _, Nothing, Nothing) -> issueAt cons (UnexpectedProperty k)
|
||||||
(Just p', _, Just p, _) -> go (propRefSchema p') (propRefSchema p)
|
(Just p', _, Just p, _) -> go (propRefSchema p') (propRefSchema p)
|
||||||
(Nothing, Just add', Just p, _) -> go add' (propRefSchema p)
|
(Nothing, Just add', Just p, _) -> go add' (propRefSchema p)
|
||||||
(Just p', _, Nothing, Just add) -> go (propRefSchema p') add
|
(Just p', _, Nothing, Just add) -> go (propRefSchema p') add
|
||||||
(Nothing, Just _, Nothing, Just _) -> pure ()
|
(Nothing, Just _, Nothing, Just _) -> pure ()
|
||||||
case (maybe False propRequired $ M.lookup k props', maybe False propRequired $ M.lookup k props) of
|
case (maybe False propRequired $ M.lookup k props', maybe False propRequired $ M.lookup k props) of
|
||||||
(False, True) -> issueAtTrace t (PropertyNowRequired k)
|
(False, True) -> issueAt cons (PropertyNowRequired k)
|
||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
pure ()
|
pure ()
|
||||||
case (madd', madd) of
|
case (madd', madd) of
|
||||||
(Nothing, _) -> pure () -- vacuously
|
(Nothing, _) -> pure () -- vacuously
|
||||||
(_, Nothing) -> issueAtTrace t NoAdditionalProperties
|
(_, Nothing) -> issueAt cons NoAdditionalProperties
|
||||||
(Just add', Just add) -> let schs = ProdCons add' add
|
(Just add', Just add) -> checkCompatibility env (ProdCons add' add)
|
||||||
in localTrace' (getTrace <$> schs) $ checkCompatibility env $ getTraced <$> schs
|
|
||||||
pure ()
|
pure ()
|
||||||
Nothing -> issueAtTrace t NoMatchingProperties
|
Nothing -> issueAt cons NoMatchingProperties
|
||||||
MaxProperties m -> case findRelevant min (\case MaxProperties m' -> Just m'; _ -> Nothing) prods of
|
MaxProperties m -> case findRelevant min (\case MaxProperties m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' <= m then pure ()
|
Just m' -> if m' <= m then pure ()
|
||||||
else issueAtTrace t (MatchingMaxPropertiesWeak m m')
|
else issueAt cons (MatchingMaxPropertiesWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMaxProperties m)
|
Nothing -> issueAt cons (NoMatchingMaxProperties m)
|
||||||
MinProperties m -> case findRelevant max (\case MinProperties m' -> Just m'; _ -> Nothing) prods of
|
MinProperties m -> case findRelevant max (\case MinProperties m' -> Just m'; _ -> Nothing) prods of
|
||||||
Just m' -> if m' >= m then pure ()
|
Just m' -> if m' >= m then pure ()
|
||||||
else issueAtTrace t (MatchingMinPropertiesWeak m m')
|
else issueAt cons (MatchingMinPropertiesWeak m m')
|
||||||
Nothing -> issueAtTrace t (NoMatchingMinProperties m)
|
Nothing -> issueAt cons (NoMatchingMinProperties m)
|
||||||
where
|
where
|
||||||
findExactly (Traced _ (Exactly x):_) = Just x
|
findExactly ((extract -> Exactly x):_) = Just x
|
||||||
findExactly (_:xs) = findExactly xs
|
findExactly (_:xs) = findExactly xs
|
||||||
findExactly [] = Nothing
|
findExactly [] = Nothing
|
||||||
findRelevant combine extract
|
findRelevant combine extr
|
||||||
= fmap (foldr1 combine) . NE.nonEmpty . mapMaybe (extract . getTraced)
|
= fmap (foldr1 combine) . NE.nonEmpty . mapMaybe (extr . extract)
|
||||||
lcmScientific (toRational -> a) (toRational -> b)
|
lcmScientific (toRational -> a) (toRational -> b)
|
||||||
= fromRational $ lcm (numerator a) (numerator b) % gcd (denominator a) (denominator b)
|
= fromRational $ lcm (numerator a) (numerator b) % gcd (denominator a) (denominator b)
|
||||||
|
|
||||||
@ -753,9 +774,7 @@ instance Typeable t => Subtree (Condition t) where
|
|||||||
deriving stock (Eq, Ord, Show)
|
deriving stock (Eq, Ord, Show)
|
||||||
type CheckEnv (Condition t) = CheckEnv Schema
|
type CheckEnv (Condition t) = CheckEnv Schema
|
||||||
normalizeTrace = undefined
|
normalizeTrace = undefined
|
||||||
checkCompatibility env conds = withTrace $ \traces -> do
|
checkCompatibility env pc = checkImplication env [producer pc] (consumer pc)
|
||||||
case Traced <$> traces <*> conds of
|
|
||||||
ProdCons prod cons -> checkImplication env [prod] cons
|
|
||||||
|
|
||||||
instance Subtree Schema where
|
instance Subtree Schema where
|
||||||
data CheckIssue Schema
|
data CheckIssue Schema
|
||||||
@ -765,18 +784,16 @@ instance Subtree Schema where
|
|||||||
| NoContradiction
|
| NoContradiction
|
||||||
deriving stock (Eq, Ord, Show)
|
deriving stock (Eq, Ord, Show)
|
||||||
type CheckEnv Schema = '[ProdCons (Definitions Schema)]
|
type CheckEnv Schema = '[ProdCons (Definitions Schema)]
|
||||||
checkCompatibility env schs = withTrace $ \traces -> do
|
checkCompatibility env schs = do
|
||||||
let defs = getH env
|
let defs = getH env
|
||||||
checkFormulas env (producer traces) $ schemaToFormula <$> defs <*> (Traced <$> traces <*> schs)
|
checkFormulas env (ask $ producer schs) $ schemaToFormula <$> defs <*> schs
|
||||||
|
|
||||||
instance Subtree (Referenced Schema) where
|
instance Subtree (Referenced Schema) where
|
||||||
data CheckIssue (Referenced Schema)
|
data CheckIssue (Referenced Schema)
|
||||||
deriving stock (Eq, Ord, Show)
|
deriving stock (Eq, Ord, Show)
|
||||||
type CheckEnv (Referenced Schema) = CheckEnv Schema
|
type CheckEnv (Referenced Schema) = CheckEnv Schema
|
||||||
checkCompatibility env refs = withTrace $ \traces -> do
|
checkCompatibility env refs = do
|
||||||
let
|
let
|
||||||
defs = getH env
|
defs = getH env
|
||||||
schs = dereference <$> defs <*> refs
|
schs = dereference <$> defs <*> refs
|
||||||
schs' = retrace <$> traces <*> schs
|
checkFormulas env (ask $ producer schs) $ schemaToFormula <$> defs <*> schs
|
||||||
localTrace (getTrace <$> schs) $ do
|
|
||||||
checkFormulas env (producer $ getTrace <$> schs') $ schemaToFormula <$> defs <*> schs'
|
|
||||||
|
@ -1,9 +1,8 @@
|
|||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
|
|
||||||
module OpenAPI.Checker.Validate.SecurityRequirement
|
module OpenAPI.Checker.Validate.SecurityRequirement
|
||||||
(
|
( CheckIssue (..)
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import Data.OpenApi
|
import Data.OpenApi
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
@ -14,5 +13,6 @@ instance Subtree SecurityRequirement where
|
|||||||
'[ ProdCons (Definitions SecurityScheme)
|
'[ ProdCons (Definitions SecurityScheme)
|
||||||
]
|
]
|
||||||
data CheckIssue SecurityRequirement
|
data CheckIssue SecurityRequirement
|
||||||
|
= SecurityRequirementNotMet
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility = undefined
|
checkCompatibility = undefined
|
||||||
|
@ -1,9 +1,8 @@
|
|||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
|
|
||||||
module OpenAPI.Checker.Validate.Server
|
module OpenAPI.Checker.Validate.Server
|
||||||
(
|
( CheckIssue(..)
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import Data.OpenApi
|
import Data.OpenApi
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
@ -11,5 +10,6 @@ import OpenAPI.Checker.Subtree
|
|||||||
instance Subtree Server where
|
instance Subtree Server where
|
||||||
type CheckEnv Server = '[]
|
type CheckEnv Server = '[]
|
||||||
data CheckIssue Server
|
data CheckIssue Server
|
||||||
|
= ServerNotConsumed
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
checkCompatibility = undefined
|
checkCompatibility = undefined
|
||||||
|
@ -10,19 +10,17 @@ import OpenAPI.Checker.Trace
|
|||||||
|
|
||||||
|
|
||||||
checkSums
|
checkSums
|
||||||
:: forall k root t
|
:: forall k r t
|
||||||
. (Ord k, Subtree root)
|
. (Ord k, Subtree t)
|
||||||
=> (k -> CheckIssue root)
|
=> (k -> CheckIssue t)
|
||||||
-> (k -> ProdCons t -> CompatFormula t ())
|
-> (k -> ProdCons (Traced r t) -> CompatFormula' SubtreeCheckIssue r ())
|
||||||
-> ProdCons (Map k (Traced root t))
|
-> ProdCons (Map k (Traced r t))
|
||||||
-> CompatFormula root ()
|
-> CompatFormula' SubtreeCheckIssue r ()
|
||||||
checkSums noElt check (ProdCons p c) = for_ (M.toList p) $ \(key, prodElt) ->
|
checkSums noElt check (ProdCons p c) = for_ (M.toList p) $ \(key, prodElt) ->
|
||||||
case M.lookup key c of
|
case M.lookup key c of
|
||||||
Nothing -> issueAt consumer $ noElt key
|
Nothing -> issueAt prodElt $ noElt key
|
||||||
Just consElt ->
|
Just consElt ->
|
||||||
let
|
let
|
||||||
sumElts :: ProdCons (Traced root t)
|
sumElts :: ProdCons (Traced r t)
|
||||||
sumElts = ProdCons prodElt consElt
|
sumElts = ProdCons prodElt consElt
|
||||||
trace = getTrace <$> sumElts
|
in check key sumElts
|
||||||
elements = getTraced <$> sumElts
|
|
||||||
in localTrace trace $ check key elements
|
|
||||||
|
@ -7,6 +7,7 @@ import Control.Category
|
|||||||
import Data.HList
|
import Data.HList
|
||||||
import qualified Data.Yaml as Yaml
|
import qualified Data.Yaml as Yaml
|
||||||
import OpenAPI.Checker.Subtree
|
import OpenAPI.Checker.Subtree
|
||||||
|
import OpenAPI.Checker.Trace
|
||||||
import OpenAPI.Checker.Validate.OpenApi ()
|
import OpenAPI.Checker.Validate.OpenApi ()
|
||||||
import Spec.Golden.Extra
|
import Spec.Golden.Extra
|
||||||
import Test.Tasty (TestTree)
|
import Test.Tasty (TestTree)
|
||||||
@ -20,4 +21,4 @@ tests =
|
|||||||
"trace-tree.yaml"
|
"trace-tree.yaml"
|
||||||
("a.yaml", "b.yaml")
|
("a.yaml", "b.yaml")
|
||||||
Yaml.decodeFileThrow
|
Yaml.decodeFileThrow
|
||||||
(runCompatFormula (pure id) . checkCompatibility HNil . uncurry ProdCons)
|
(runCompatFormula . checkCompatibility HNil . fmap (traced Root) . uncurry ProdCons)
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationRequestBodyStep:
|
OperationRequestBodyStep:
|
||||||
InlineStep:
|
InlineStep:
|
||||||
RequestMediaTypeObject application/json:
|
RequestMediaTypeObject application/json:
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationParamsStep:
|
OperationParamsStep 0:
|
||||||
InlineStep: ParamEmptinessIncompatible
|
InlineStep: ParamEmptinessIncompatible
|
||||||
|
@ -1,8 +1,8 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationParamsStep:
|
OperationParamsStep 0:
|
||||||
InlineStep:
|
InlineStep:
|
||||||
ParamSchema:
|
ParamSchema:
|
||||||
InlineStep: NoContradiction
|
InlineStep: NoContradiction
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationParamsStep:
|
OperationParamsStep 0:
|
||||||
InlineStep: ParamRequired
|
InlineStep: ParamRequired
|
||||||
|
@ -1,4 +1,6 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep: ParamNotMatched ParamQuery "test2"
|
OperationMethodStep PostMethod:
|
||||||
|
OperationParamsStep 1:
|
||||||
|
InlineStep: ParamNotMatched "test2"
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationRequestBodyStep:
|
OperationRequestBodyStep:
|
||||||
InlineStep:
|
InlineStep:
|
||||||
RequestMediaTypeObject application/json:
|
RequestMediaTypeObject application/json:
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationRequestBodyStep:
|
OperationRequestBodyStep:
|
||||||
InlineStep: RequestMediaTypeNotFound application/x-www-form-urlencoded
|
InlineStep:
|
||||||
|
RequestMediaTypeObject application/x-www-form-urlencoded: RequestMediaTypeNotFound
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationRequestBodyStep:
|
OperationRequestBodyStep:
|
||||||
InlineStep: RequestBodyRequired
|
InlineStep: RequestBodyRequired
|
||||||
|
@ -1,5 +1,7 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationResponsesStep: ResponseCodeNotFound 500
|
OperationResponsesStep:
|
||||||
|
ResponseCodeStep 500:
|
||||||
|
InlineStep: ResponseCodeNotFound
|
||||||
|
@ -1,7 +1,9 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationResponsesStep:
|
OperationResponsesStep:
|
||||||
ResponseCodeStep 200:
|
ResponseCodeStep 200:
|
||||||
InlineStep: ResponseHeaderMissing "Test2"
|
InlineStep:
|
||||||
|
ResponseHeader "Test2":
|
||||||
|
InlineStep: ResponseHeaderMissing
|
||||||
|
@ -1,7 +1,8 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationResponsesStep:
|
OperationResponsesStep:
|
||||||
ResponseCodeStep 200:
|
ResponseCodeStep 200:
|
||||||
InlineStep: ResponseMediaTypeMissing application/x-www-form-urlencoded
|
InlineStep:
|
||||||
|
ResponseMediaObject application/x-www-form-urlencoded: ResponseMediaTypeMissing
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationResponsesStep:
|
OperationResponsesStep:
|
||||||
ResponseCodeStep 200:
|
ResponseCodeStep 200:
|
||||||
InlineStep:
|
InlineStep:
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationResponsesStep:
|
OperationResponsesStep:
|
||||||
ResponseCodeStep 200:
|
ResponseCodeStep 200:
|
||||||
InlineStep:
|
InlineStep:
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
Left:
|
Left:
|
||||||
OpenApiPathsStep:
|
OpenApiPathsStep:
|
||||||
MatchedPathStep "/test":
|
MatchedPathStep "/test":
|
||||||
PostStep:
|
OperationMethodStep PostMethod:
|
||||||
OperationRequestBodyStep:
|
OperationRequestBodyStep:
|
||||||
InlineStep:
|
InlineStep:
|
||||||
RequestMediaTypeObject application/json:
|
RequestMediaTypeObject application/json:
|
||||||
|
Loading…
Reference in New Issue
Block a user