5568591 · typeable/compaREST

.gitignore+1

compare with master

unifiedsplit

@@ -1,3 +1,4 @@

1.stack-work

2TAGS

3.vscode

4+.dir-locals.el

openapi-diff.cabal+9−7

@@ -32,25 +32,26 @@ common common-options

32 build-depends: base >= 4.12.0.0 && < 4.15

33 , aeson

34 , attoparsec

35+ , bytestring

35 , containers

36 , containers

36 , deriving-aeson

37 , deriving-aeson

37 , generic-data

38 , generic-data

38 , generic-monoid

39 , generic-monoid

40+ , http-media

39 , insert-ordered-containers

41 , insert-ordered-containers

42+ , lattices

40 , lens

43 , lens

41 , mtl

44 , mtl

42 , openapi3

45 , openapi3

43 , optparse-applicative

46 , optparse-applicative

47+ , scientific

44 , tagged

48 , tagged

45 , text

49 , text

46 , transformers

50 , transformers

47 , typerep-map

51 , typerep-map

48− , yaml

49 , unordered-containers

52 , unordered-containers

50 , vector

53 , vector

51− , bytestring

54+ , yaml

52− , scientific

53− , lattices

54

55

55 default-extensions: ApplicativeDo

56 default-extensions: ApplicativeDo

56 , BangPatterns

57 , BangPatterns

@@ -105,16 +106,17 @@ library

105 , OpenAPI.Checker.Subtree

106 , OpenAPI.Checker.Subtree

106 , OpenAPI.Checker.Trace

107 , OpenAPI.Checker.Trace

107 , OpenAPI.Checker.TracePrefixTree

108 , OpenAPI.Checker.TracePrefixTree

109+ , OpenAPI.Checker.Validate.MediaTypeObject

108 , OpenAPI.Checker.Validate.OpenApi

110 , OpenAPI.Checker.Validate.OpenApi

109 , OpenAPI.Checker.Validate.Operation

111 , OpenAPI.Checker.Validate.Operation

110 , OpenAPI.Checker.Validate.Param

112 , OpenAPI.Checker.Validate.Param

111 , OpenAPI.Checker.Validate.PathFragment

113 , OpenAPI.Checker.Validate.PathFragment

114+ , OpenAPI.Checker.Validate.ProcessedPathItem

112 , OpenAPI.Checker.Validate.RequestBody

115 , OpenAPI.Checker.Validate.RequestBody

113 , OpenAPI.Checker.Validate.Responses

116 , OpenAPI.Checker.Validate.Responses

114− , OpenAPI.Checker.Validate.ProcessedPathItem

115− , OpenAPI.Checker.Validate.Server

116− , OpenAPI.Checker.Validate.SecurityRequirement

117 , OpenAPI.Checker.Validate.Schema

118+ , OpenAPI.Checker.Validate.SecurityRequirement

119+ , OpenAPI.Checker.Validate.Server

118

120

119executable openapi-diff

121executable openapi-diff

120 import: common-options

122 import: common-options

src/OpenAPI/Checker/Run.hs+8−3

@@ -15,9 +15,14 @@ runChecker = do

15 opts <- execParser optionsParserInfo

16 let parseSchema path =

17 eitherDecodeFileStrict path >>= \case

18− Left e -> do

18+ Left jsonErr -> do

19− putStrLn $ "Failed to parse: " ++ path

19+ Yaml.decodeFileEither path >>= \case

20+ Left yamlErr -> do

21+ putStrLn "Could not parse as json or yaml"

22+ putStrLn $ show jsonErr

23+ putStrLn $ show yamlErr

20− fail e

24+ fail "Exiting"

25+ Right s -> pure s

21 Right s -> pure s

26 Right s -> pure s

22 a <- parseSchema (clientFile opts)

27 a <- parseSchema (clientFile opts)

23 b <- parseSchema (serverFile opts)

28 b <- parseSchema (serverFile opts)

src/OpenAPI/Checker/Subtree.hs+15

@@ -5,6 +5,8 @@ module OpenAPI.Checker.Subtree

5 , CompatFormula

6 , ProdCons (..)

7 , HasUnsupportedFeature (..)

8+ , swapRoles

9+ , swapProdCons

8 , checkProdCons

10 , checkProdCons

9 , SubtreeCheckIssue (..)

11 , SubtreeCheckIssue (..)

10 , runCompatFormula

12 , runCompatFormula

@@ -49,6 +51,9 @@ data ProdCons a = ProdCons

49 }

51 }

50 deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

52 deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

51

53

54+swapProdCons :: ProdCons a -> ProdCons a

55+swapProdCons (ProdCons a b) = ProdCons b a

56+

52instance Applicative ProdCons where

57instance Applicative ProdCons where

53 pure x = ProdCons x x

58 pure x = ProdCons x x

54 ProdCons fp fc <*> ProdCons xp xc = ProdCons (fp xp) (fc xc)

59 ProdCons fp fc <*> ProdCons xp xc = ProdCons (fp xp) (fc xc)

@@ -70,6 +75,13 @@ newtype CompatM t a = CompatM

70

75

71type CompatFormula t = Compose (CompatM t) (FormulaF SubtreeCheckIssue OpenApi)

76type CompatFormula t = Compose (CompatM t) (FormulaF SubtreeCheckIssue OpenApi)

72

77

78+-- | Swaps roles of producer and consumer. Used when we check the @Response@ at

79+-- least. In response producer and consumer swap their places because response

80+-- is generated by consumer and parsed by producer.

81+swapRoles :: CompatFormula t a -> CompatFormula t a

82+swapRoles (Compose r) = Compose $ do

83+ local swapProdCons r

84+

73class (Typeable t, Ord (CheckIssue t), Show (CheckIssue t)) => Subtree (t :: Type) where

85class (Typeable t, Ord (CheckIssue t), Show (CheckIssue t)) => Subtree (t :: Type) where

74 type CheckEnv t :: [Type]

86 type CheckEnv t :: [Type]

75 data CheckIssue t :: Type

87 data CheckIssue t :: Type

@@ -79,9 +91,12 @@ class (Typeable t, Ord (CheckIssue t), Show (CheckIssue t)) => Subtree (t :: Typ

79

91

80 -- | If we ever followed a reference, reroute the path through "components"

92 -- | If we ever followed a reference, reroute the path through "components"

81 normalizeTrace :: Trace OpenApi t -> Trace OpenApi t

93 normalizeTrace :: Trace OpenApi t -> Trace OpenApi t

94+ normalizeTrace = id

82

95

83 checkCompatibility :: HasAll (CheckEnv t) xs => HList xs -> ProdCons t -> CompatFormula t ()

96 checkCompatibility :: HasAll (CheckEnv t) xs => HList xs -> ProdCons t -> CompatFormula t ()

84

97

98+{-# WARNING normalizeTrace "It must be refactored. Does nothing for now" #-}

99+

85checkProdCons :: (Subtree t, HasAll (CheckEnv t) env) => HList env -> ProdCons (Traced r t) -> CompatFormula r ()

100checkProdCons :: (Subtree t, HasAll (CheckEnv t) env) => HList env -> ProdCons (Traced r t) -> CompatFormula r ()

86checkProdCons env (ProdCons (Traced p x) (Traced c y)) =

101checkProdCons env (ProdCons (Traced p x) (Traced c y)) =

87 localTrace (ProdCons p c) $ checkCompatibility env $ ProdCons x y

102 localTrace (ProdCons p c) $ checkCompatibility env $ ProdCons x y

src/OpenAPI/Checker/Validate/MediaTypeObject.hsnew file+64

@@ -0,0 +1,64 @@

1+{-# OPTIONS_GHC -Wno-orphans #-}

2+

3+module OpenAPI.Checker.Validate.MediaTypeObject () where

4+

5+import Data.Foldable as F

6+import Data.HList

7+import Data.HashMap.Strict.InsOrd as IOHM

8+import Data.OpenApi

9+import Data.Text (Text)

10+import Network.HTTP.Media (MediaType, mainType, subType)

11+import OpenAPI.Checker.Subtree

12+import OpenAPI.Checker.Trace

13+import OpenAPI.Checker.Validate.Schema

14+

15+instance Subtree MediaTypeObject where

16+ type CheckEnv MediaTypeObject =

17+ '[ MediaType

18+ , ProdCons (Definitions Schema)

19+ ]

20+ data CheckIssue MediaTypeObject

21+ = MediaEncodingMissing

22+ | MediaEncodingIncompat

23+ | MediaTypeSchemaRequired

24+ deriving (Eq, Ord, Show)

25+ checkCompatibility env (ProdCons p c) = do

26+ tryCheckEncoding

27+ checkSchema

28+ pure ()

29+ where

30+ mediaType = getH @MediaType env

31+ tryCheckEncoding =

32+ if | "multipart" == mainType mediaType -> checkEncoding

33+ | "application" == mainType mediaType &&

34+ "x-www-form-urlencoded" == subType mediaType -> checkEncoding

35+ | otherwise -> pure ()

36+ where

37+ checkEncoding = for_ (IOHM.toList $ _mediaTypeObjectEncoding c) $ \(paramName, consEncoding) ->

38+ case IOHM.lookup paramName $ _mediaTypeObjectEncoding p of

39+ Nothing -> issueAt producer MediaEncodingMissing

40+ Just prodEncoding -> localStep (MediaTypeParamEncoding paramName)

41+ $ checkCompatibility HNil

42+ $ ProdCons prodEncoding consEncoding

43+ checkSchema = for_ (_mediaTypeObjectSchema c) $ \consRef ->

44+ case _mediaTypeObjectSchema p of

45+ Nothing -> issueAt producer MediaTypeSchemaRequired

46+ Just prodRef -> localStep MediaTypeSchema

47+ $ checkCompatibility env $ ProdCons prodRef consRef

48+

49+instance Subtree Encoding where

50+ type CheckEnv Encoding = '[]

51+ data CheckIssue Encoding = EncodingNotSupported

52+ -- FIXME: Support only JSON body for now. Then Encoding is checked only for

53+ -- multipart/form-url-encoded

54+ deriving (Eq, Ord, Show)

55+ checkCompatibility _env _prodCons =

56+ issueAt producer EncodingNotSupported

57+

58+instance Steppable MediaTypeObject (Referenced Schema) where

59+ data Step MediaTypeObject (Referenced Schema) = MediaTypeSchema

60+ deriving (Eq, Ord, Show)

61+

62+instance Steppable MediaTypeObject Encoding where

63+ data Step MediaTypeObject Encoding = MediaTypeParamEncoding Text

64+ deriving (Eq, Ord, Show)

src/OpenAPI/Checker/Validate/OpenApi.hs+4−2

@@ -1,5 +1,5 @@

1−{-# LANGUAGE PartialTypeSignatures #-}

2{-# OPTIONS_GHC -Wno-orphans #-}

1{-# OPTIONS_GHC -Wno-orphans #-}

2+{-# OPTIONS_GHC -fconstraint-solver-iterations=5 #-} -- Not compiles without

3

4module OpenAPI.Checker.Validate.OpenApi

5 (

@@ -17,7 +17,6 @@ instance Subtree OpenApi where

17 type CheckEnv OpenApi = '[]

18 data CheckIssue OpenApi

19 deriving (Eq, Ord, Show)

20− normalizeTrace = undefined

21 checkCompatibility _ prodCons = do

20 checkCompatibility _ prodCons = do

22 let cs = _openApiComponents <$> prodCons

21 let cs = _openApiComponents <$> prodCons

23 localStep OpenApiPathsStep $

22 localStep OpenApiPathsStep $

@@ -25,6 +24,9 @@ instance Subtree OpenApi where

25 ((_componentsRequestBodies <$> cs)

24 ((_componentsRequestBodies <$> cs)

26 `HCons` (_componentsParameters <$> cs)

25 `HCons` (_componentsParameters <$> cs)

27 `HCons` (_componentsSecuritySchemes <$> cs)

26 `HCons` (_componentsSecuritySchemes <$> cs)

27+ `HCons` (_componentsResponses <$> cs)

28+ `HCons` (_componentsHeaders <$> cs)

29+ `HCons` (_componentsSchemas <$> cs)

28 `HCons` HNil)

30 `HCons` HNil)

29 (processPathItems . IOHM.toList . _openApiPaths <$> prodCons)

31 (processPathItems . IOHM.toList . _openApiPaths <$> prodCons)

30

32

src/OpenAPI/Checker/Validate/Operation.hs+5−3

@@ -22,6 +22,9 @@ instance Subtree Operation where

22 '[ ProdCons (Definitions Param)

23 , ProdCons (Definitions RequestBody)

24 , ProdCons (Definitions SecurityScheme)

25+ , ProdCons (Definitions Response)

26+ , ProdCons (Definitions Header)

27+ , ProdCons (Definitions Schema)

25 ]

28 ]

26 data CheckIssue Operation

29 data CheckIssue Operation

27 = ParamNotMatched Text -- Param name

30 = ParamNotMatched Text -- Param name

@@ -30,7 +33,6 @@ instance Subtree Operation where

30 | SecurityRequirementNotMet Int -- security indexs

33 | SecurityRequirementNotMet Int -- security indexs

31 | ServerNotConsumed Int -- server index

34 | ServerNotConsumed Int -- server index

32 deriving (Eq, Ord, Show)

35 deriving (Eq, Ord, Show)

33− normalizeTrace = undefined

34 checkCompatibility env prodCons = do

36 checkCompatibility env prodCons = do

35 let ProdCons {producer = pNonPathParams, consumer = cNonPathParams} = do

37 let ProdCons {producer = pNonPathParams, consumer = cNonPathParams} = do

36 op <- _operationParameters <$> prodCons

38 op <- _operationParameters <$> prodCons

@@ -54,11 +56,11 @@ instance Subtree Operation where

54 ProdCons Nothing Nothing -> pure ()

56 ProdCons Nothing Nothing -> pure ()

55 ProdCons (Just pBody) (Just cBody) ->

57 ProdCons (Just pBody) (Just cBody) ->

56 localStep OperationRequestBodyStep $

58 localStep OperationRequestBodyStep $

57− checkProdCons HNil (ProdCons pBody cBody)

59+ checkProdCons env (ProdCons pBody cBody)

58 ProdCons Nothing (Just _) -> issueAt producer NoRequestBody

60 ProdCons Nothing (Just _) -> issueAt producer NoRequestBody

59 ProdCons (Just _) Nothing -> issueAt consumer NoRequestBody

61 ProdCons (Just _) Nothing -> issueAt consumer NoRequestBody

60 localStep OperationResponsesStep $

62 localStep OperationResponsesStep $

61− checkCompatibility HNil $ _operationResponses <$> prodCons

63+ checkCompatibility env $ _operationResponses <$> prodCons

62 -- FIXME: https://github.com/typeable/openapi-diff/issues/27

64 -- FIXME: https://github.com/typeable/openapi-diff/issues/27

63 case IOHM.null . _operationCallbacks <$> prodCons of

65 case IOHM.null . _operationCallbacks <$> prodCons of

64 (ProdCons True True) -> pure ()

66 (ProdCons True True) -> pure ()

src/OpenAPI/Checker/Validate/Param.hs+20−2

@@ -3,11 +3,29 @@

3module OpenAPI.Checker.Validate.Param () where

4

5import Data.OpenApi

6+import Data.Maybe

6import OpenAPI.Checker.Subtree

7import OpenAPI.Checker.Subtree

7

8

8instance Subtree Param where

9instance Subtree Param where

9 type CheckEnv Param = '[]

10 type CheckEnv Param = '[]

10 data CheckIssue Param

11 data CheckIssue Param

12+ = ParamNameMismatch

13+ -- ^ Params have different names

14+ | ParamOptionalityIncompatible

15+ -- ^ Consumer requires non-empty param, but producer gives optional

16+ | ParamPlaceIncompatible

11 deriving (Eq, Ord, Show)

17 deriving (Eq, Ord, Show)

12− normalizeTrace = undefined

13− checkCompatibility = undefined

18+ checkCompatibility _ (ProdCons p c) = case ( _paramIn p, _paramIn c) of

19+ (ParamQuery, ParamQuery) ->

20+ namesCompatible $

21+ if (fromMaybe False $ _paramAllowEmptyValue p)

22+ && not (fromMaybe False $ _paramAllowEmptyValue c)

23+ then issueAt producer ParamOptionalityIncompatible

24+ else pure ()

25+ (a, b) | a == b -> namesCompatible $ pure ()

26+ _ -> issueAt producer ParamPlaceIncompatible

27+ where

28+ namesCompatible next =

29+ if _paramName p /= _paramName c

30+ then issueAt producer ParamNameMismatch

31+ else next

src/OpenAPI/Checker/Validate/PathFragment.hs−2

@@ -62,8 +62,6 @@ instance Subtree PathFragment where

62 data CheckIssue PathFragment = PathFragmentsDontMatch Text Text

63 deriving (Eq, Ord, Show)

64

65− normalizeTrace = undefined

66−

67 -- This case isn't strictly needed. It is here for optimization.

65 -- This case isn't strictly needed. It is here for optimization.

68 checkCompatibility _ ProdCons {producer = (StaticPath x), consumer = (StaticPath y)} =

66 checkCompatibility _ ProdCons {producer = (StaticPath x), consumer = (StaticPath y)} =

69 if x == y

67 if x == y

src/OpenAPI/Checker/Validate/ProcessedPathItem.hs+3−1

@@ -36,10 +36,12 @@ instance Subtree ProcessedPathItems where

36 '[ ProdCons (Definitions Param)

37 , ProdCons (Definitions RequestBody)

38 , ProdCons (Definitions SecurityScheme)

39+ , ProdCons (Definitions Response)

40+ , ProdCons (Definitions Header)

41+ , ProdCons (Definitions Schema)

39 ]

42 ]

40 data CheckIssue ProcessedPathItems = NoPathsMatched | WrongNumberOfFragments

43 data CheckIssue ProcessedPathItems = NoPathsMatched | WrongNumberOfFragments

41 deriving (Eq, Ord, Show)

44 deriving (Eq, Ord, Show)

42− normalizeTrace = undefined

43 checkCompatibility env prodCons = do

45 checkCompatibility env prodCons = do

44 let ProdCons {producer = p, consumer = c} =

46 let ProdCons {producer = p, consumer = c} =

45 (\paramDefs -> fmap (processPathItem paramDefs) . unProcessedPathItems)

47 (\paramDefs -> fmap (processPathItem paramDefs) . unProcessedPathItems)

src/OpenAPI/Checker/Validate/RequestBody.hs+27−3

@@ -5,12 +5,36 @@ module OpenAPI.Checker.Validate.RequestBody

5 )

6where

7

8+import Data.Foldable as F

9+import Data.HList

10+import Data.HashMap.Strict.InsOrd as IOHM

11+import Data.Maybe

8import Data.OpenApi

12import Data.OpenApi

13+import Network.HTTP.Media (MediaType)

9import OpenAPI.Checker.Subtree

14import OpenAPI.Checker.Subtree

15+import OpenAPI.Checker.Trace

16+import OpenAPI.Checker.Validate.MediaTypeObject ()

10

17

11instance Subtree RequestBody where

18instance Subtree RequestBody where

12− type CheckEnv RequestBody = '[]

19+ type CheckEnv RequestBody =

20+ '[ ProdCons (Definitions Schema) ]

13 data CheckIssue RequestBody

21 data CheckIssue RequestBody

22+ = RequestBodyRequired

23+ | RequestMediaTypeNotFound

24+ deriving (Eq, Ord, Show)

25+ checkCompatibility env (ProdCons p c) =

26+ if not (fromMaybe False $ _requestBodyRequired p)

27+ && (fromMaybe False $ _requestBodyRequired c)

28+ then issueAt producer RequestBodyRequired

29+ else

30+ -- For each consumer we must find at least one compatible producer media

31+ -- type

32+ for_ (IOHM.toList $ _requestBodyContent c) $ \(mediaType, consMedia) ->

33+ case IOHM.lookup mediaType $ _requestBodyContent p of

34+ Nothing -> issueAt producer RequestMediaTypeNotFound

35+ Just prodMedia -> localStep (MediaTypeStep mediaType) $

36+ checkCompatibility (HCons mediaType env) (ProdCons prodMedia consMedia)

37+

38+instance Steppable RequestBody MediaTypeObject where

39+ data Step RequestBody MediaTypeObject = MediaTypeStep MediaType

14 deriving (Eq, Ord, Show)

40 deriving (Eq, Ord, Show)

15− normalizeTrace = undefined

16− checkCompatibility = undefined

src/OpenAPI/Checker/Validate/Responses.hs+104−4

@@ -1,14 +1,114 @@

1+{-# OPTIONS_GHC -Wno-orphans #-}

2+

1module OpenAPI.Checker.Validate.Responses

3module OpenAPI.Checker.Validate.Responses

2 (

4 (

3 )

5 )

4where

6where

5

7

8+import Data.Foldable

9+import Data.HList

10+import Data.HashMap.Strict.InsOrd as IOHM

11+import Data.Maybe

6import Data.OpenApi

12import Data.OpenApi

13+import Network.HTTP.Media (MediaType)

14+import OpenAPI.Checker.References

7import OpenAPI.Checker.Subtree

15import OpenAPI.Checker.Subtree

16+import OpenAPI.Checker.Trace

17+import OpenAPI.Checker.Validate.MediaTypeObject ()

18+import OpenAPI.Checker.Validate.Schema ()

8

19

9instance Subtree Responses where

20instance Subtree Responses where

10− type CheckEnv Responses = '[]

21+ type CheckEnv Responses =

22+ '[ ProdCons (Definitions Response)

23+ , ProdCons (Definitions Header)

24+ , ProdCons (Definitions Schema)

25+ ]

26+ data CheckIssue Responses = ResponseCodeNotFound HttpStatusCode

27+ deriving (Eq, Ord, Show)

28+ -- Here we are checking responses, so, the consumer and producer swap their

29+ -- roles. The consumer now generates the response and producer consumes

30+ -- it. So, the logic is swapped.

31+ checkCompatibility env (ProdCons p c) = do

32+ let defs = getH @(ProdCons (Definitions Response)) env

33+ for_ (IOHM.toList $ _responsesResponses p) $ \ (prodStatus, prodRef) ->

34+ case IOHM.lookup prodStatus $ _responsesResponses c of

35+ Nothing -> issueAt consumer $ ResponseCodeNotFound prodStatus

36+ Just consRef -> do

37+ let tracedRefs = dereference <$> defs <*> ProdCons prodRef consRef

38+ localStep (ResponseCodeStep prodStatus)

39+ $ checkProdCons env tracedRefs

40+ -- FIXME: Do we need to check "default" fields somehow here?

41+

42+instance Subtree Response where

43+ type CheckEnv Response =

44+ '[ ProdCons (Definitions Header)

45+ , ProdCons (Definitions Schema)

46+ ]

11− data CheckIssue Responses

47+ data CheckIssue Response

48+ = ResponseMediaTypeMissing MediaType

49+ | ResponseHeaderMissing HeaderName

50+ deriving (Eq, Ord, Show)

51+ -- Here we are checking responses, so, the consumer and producer swap their

52+ -- roles. The consumer now generates the response and producer consumes

53+ -- it. So, the logic is swapped.

54+ checkCompatibility env (ProdCons p c) = do

55+ checkMediaTypes

56+ checkHeaders

57+ pure ()

58+ where

59+ -- Each response type expected by producer must be in the consumer (logic

60+ -- is swapped)

61+ checkMediaTypes = do

62+ for_ (IOHM.toList $ _responseContent p) $ \ (mediaType, prodMediaObject) ->

63+ case IOHM.lookup mediaType $ _responseContent c of

64+ Nothing -> issueAt consumer $ ResponseMediaTypeMissing mediaType

65+ Just consMediaObject -> localStep (ResponseMediaObject mediaType)

66+ $ swapRoles

67+ $ checkCompatibility @MediaTypeObject (HCons mediaType env)

68+ $ ProdCons consMediaObject prodMediaObject

69+ checkHeaders = do

70+ for_ (IOHM.toList $ _responseHeaders p) $ \ (hname, prodRef) ->

71+ case IOHM.lookup hname $ _responseHeaders c of

72+ Nothing -> issueAt consumer $ ResponseHeaderMissing hname

73+ Just consRef -> do

74+ let headerRefs = dereference <$> headerDefs <*> ProdCons prodRef consRef

75+ localStep (ResponseHeader hname)

76+ $ swapRoles

77+ $ checkProdCons env $ swapProdCons headerRefs

78+ headerDefs = getH @(ProdCons (Definitions Header)) env

79+

80+instance Subtree Header where

81+ type CheckEnv Header = '[ProdCons (Definitions Schema)]

82+ data CheckIssue Header

83+ = RequiredHeaderMissing

84+ | NonEmptyHeaderRequired

85+ | HeaderSchemaRequired

86+ deriving (Eq, Ord, Show)

87+ checkCompatibility env (ProdCons p c) = do

88+ if (fromMaybe False $ _headerRequired c) && not (fromMaybe False $ _headerRequired p)

89+ then issueAt producer RequiredHeaderMissing else pure ()

90+ if not (fromMaybe False $ _headerAllowEmptyValue c) && (fromMaybe False $ _headerAllowEmptyValue p)

91+ then issueAt producer NonEmptyHeaderRequired else pure ()

92+ for_ (_headerSchema c) $ \consRef ->

93+ case (_headerSchema p) of

94+ Nothing -> issueAt producer HeaderSchemaRequired

95+ Just prodRef -> do

96+ localStep HeaderSchema

97+ $ checkCompatibility env $ ProdCons prodRef consRef

98+ pure ()

99+

100+instance Steppable Header (Referenced Schema) where

101+ data Step Header (Referenced Schema) = HeaderSchema

102+ deriving (Eq, Ord, Show)

103+

104+instance Steppable Response (Referenced Header) where

105+ data Step Response (Referenced Header) = ResponseHeader HeaderName

106+ deriving (Eq, Ord, Show)

107+

108+instance Steppable Response MediaTypeObject where

109+ data Step Response MediaTypeObject = ResponseMediaObject MediaType

110+ deriving (Eq, Ord, Show)

111+

112+instance Steppable Responses (Referenced Response) where

113+ data Step Responses (Referenced Response) = ResponseCodeStep HttpStatusCode

12 deriving (Eq, Ord, Show)

114 deriving (Eq, Ord, Show)

13− normalizeTrace = undefined

14− checkCompatibility = undefined

src/OpenAPI/Checker/Validate/Schema.hs−2

@@ -761,7 +761,6 @@ instance Subtree Schema where

761 | NoMatchingCondition [SomeCondition]

762 deriving stock (Eq, Ord, Show)

763 type CheckEnv Schema = '[ProdCons (Definitions Schema)]

764− normalizeTrace = undefined

765 checkCompatibility env schs = withTrace $ \traces -> do

764 checkCompatibility env schs = withTrace $ \traces -> do

766 let defs = getH env

765 let defs = getH env

767 checkFormulas env (producer traces) $ schemaToFormula <$> defs <*> (Traced <$> traces <*> schs)

766 checkFormulas env (producer traces) $ schemaToFormula <$> defs <*> (Traced <$> traces <*> schs)

@@ -770,7 +769,6 @@ instance Subtree (Referenced Schema) where

770 data CheckIssue (Referenced Schema)

769 data CheckIssue (Referenced Schema)

771 deriving stock (Eq, Ord, Show)

770 deriving stock (Eq, Ord, Show)

772 type CheckEnv (Referenced Schema) = CheckEnv Schema

771 type CheckEnv (Referenced Schema) = CheckEnv Schema

773− normalizeTrace = undefined

774 checkCompatibility env refs = withTrace $ \traces -> do

772 checkCompatibility env refs = withTrace $ \traces -> do

775 let

773 let

776 defs = getH env

774 defs = getH env

src/OpenAPI/Checker/Validate/SecurityRequirement.hs−1

@@ -15,5 +15,4 @@ instance Subtree SecurityRequirement where

15 ]

16 data CheckIssue SecurityRequirement

17 deriving (Eq, Ord, Show)

18− normalizeTrace = undefined

19 checkCompatibility = undefined

18 checkCompatibility = undefined

src/OpenAPI/Checker/Validate/Server.hs−1

@@ -12,5 +12,4 @@ instance Subtree Server where

12 type CheckEnv Server = '[]

13 data CheckIssue Server

14 deriving (Eq, Ord, Show)

15− normalizeTrace = undefined

16 checkCompatibility = undefined

15 checkCompatibility = undefined