@@ -4,10 +4,11 @@
44module OpenAPI.Checker.Validate.Param
55 ( Behave (..)
66 , Issue (..)
7− ) where
7+ )
8+where
89
9−import Control.Lens hiding (para)
1010import Control.Monad
11+import Data.Functor
1112import Data.Maybe
1213import Data.OpenApi
1314import Data.Text as T
@@ -22,13 +23,18 @@ import Text.Pandoc.Builder
2223data EncodingStyle = EncodingStyle
2324 { style :: Style
2425 , explode :: Bool
25− , allowReserved :: Maybe Bool
26− -- ^ Nothing when @in@ parameter is not @query@
27− } deriving (Eq, Ord, Show)
26+ , -- | Nothing when @in@ parameter is not @query@
27+ allowReserved :: Maybe Bool
28+ }
29+ deriving stock (Eq, Ord, Show)
2830
2931paramEncoding :: Param -> EncodingStyle
30−paramEncoding p = EncodingStyle
31− { style, explode, allowReserved }
32+paramEncoding p =
33+ EncodingStyle
34+ { style
35+ , explode
36+ , allowReserved
37+ }
3238 where
3339 style = fromMaybe defaultStyle $ _paramStyle p
3440 defaultStyle = case _paramIn p of
@@ -49,19 +55,19 @@ tracedSchema par = _paramSchema (extract par) <&> traced (ask par >>> step Param
4955
5056instance Issuable 'PathFragmentLevel where
5157 data Issue 'PathFragmentLevel
52− = ParamNameMismatch
53− -- ^ Params have different names
54− | ParamEmptinessIncompatible
55− -- ^ Consumer requires non-empty param, but producer gives emptyable
56− | ParamRequired
57− -- ^ Consumer requires mandatory parm, but producer optional
58+ = -- | Params have different names
59+ ParamNameMismatch
60+ | -- | Consumer requires non-empty param, but producer gives emptyable
61+ ParamEmptinessIncompatible
62+ | -- | Consumer requires mandatory parm, but producer optional
63+ ParamRequired
5864 | ParamPlaceIncompatible
59− | ParamStyleMismatch
60− -- ^ Params encoded in different styles
61− | ParamSchemaMismatch
62− -- ^ One of schemas not presented
65+ | -- | Params encoded in different styles
66+ ParamStyleMismatch
67+ | -- | One of schemas not presented
68+ ParamSchemaMismatch
6369 | PathFragmentsDontMatch Text Text
64− deriving (Eq, Ord, Show)
70+ deriving stock (Eq, Ord, Show)
6571 issueIsUnsupported _ = False
6672 describeIssue ParamNameMismatch = para "The path fragments don't match."
6773 describeIssue ParamEmptinessIncompatible = para "Expected that an empty parameter is allowed, but it isn't."
@@ -74,8 +80,8 @@ instance Issuable 'PathFragmentLevel where
7480instance Behavable 'PathFragmentLevel 'SchemaLevel where
7581 data Behave 'PathFragmentLevel 'SchemaLevel
7682 = InParamSchema
77− deriving (Eq, Ord, Show)
78−
83+ deriving stock (Eq, Ord, Show)
84+
7985 describeBehaviour InParamSchema = "JSON Schema"
8086
8187instance Subtree Param where
@@ -92,30 +98,32 @@ instance Subtree Param where
9298 structuralEq $ fmap _paramExplode <$> pc
9399 pure ()
94100 checkSemanticCompatibility env beh pc@(ProdCons p c) = do
95− when (_paramName (extract p) /= _paramName (extract c))
96− $ issueAt beh ParamNameMismatch
97− when ((fromMaybe False . _paramRequired . extract $ c) &&
98− not (fromMaybe False . _paramRequired . extract $ p))
101+ when (_paramName (extract p) /= _paramName (extract c)) $
102+ issueAt beh ParamNameMismatch
103+ when
104+ ((fromMaybe False . _paramRequired . extract $ c)
105+ && not (fromMaybe False . _paramRequired . extract $ p))
99106 $ issueAt beh ParamRequired
100107 case (_paramIn . extract $ p, _paramIn . extract $ c) of
101108 (ParamQuery, ParamQuery) -> do
102109 -- Emptiness is only for query params
103− when ((fromMaybe False . _paramAllowEmptyValue . extract $ p)
104− && not (fromMaybe False . _paramAllowEmptyValue . extract $ c))
110+ when
111+ ((fromMaybe False . _paramAllowEmptyValue . extract $ p)
112+ && not (fromMaybe False . _paramAllowEmptyValue . extract $ c))
105113 $ issueAt beh ParamEmptinessIncompatible
106114 (a, b) | a == b -> pure ()
107115 _ -> issueAt beh ParamPlaceIncompatible
108− unless (paramEncoding (extract p) == paramEncoding (extract c))
109− $ issueAt beh ParamStyleMismatch
116+ unless (paramEncoding (extract p) == paramEncoding (extract c)) $
117+ issueAt beh ParamStyleMismatch
110118 case tracedSchema <$> pc of
111119 ProdCons (Just prodSchema) (Just consSchema) -> do
112120 checkCompatibility env (beh >>> step InParamSchema) $ ProdCons prodSchema consSchema
113121 ProdCons Nothing Nothing -> pure ()
114122 ProdCons Nothing (Just _consSchema) -> issueAt beh ParamSchemaMismatch
115123 ProdCons (Just _prodSchema) Nothing -> pure ()
116− -- If consumer doesn't care then why we should?
124+ -- If consumer doesn't care then why we should?
117125 pure ()
118126
119127instance Steppable Param (Referenced Schema) where
120128 data Step Param (Referenced Schema) = ParamSchema
121− deriving (Eq, Ord, Show)
129+ deriving stock (Eq, Ord, Show)