on master help sign in
wip
commit12d42b98c2ee586b996d543f728a429689cc95dc authorAleksey Uymanov <s9gf4ult@gmail.com> dateFri 26 Feb 2021, 12:59 (6 years ago) parente728a37
6 files changed+64−19
.gitignore+1 openapi-diff.cabal+3−1 src/OpenAPI/Checker/Aux.hs+7 src/OpenAPI/Checker/Report.hs+15−3 src/OpenAPI/Checker/Validate.hs+33−12 src/OpenAPI/Checker/Validate/Monad.hs+5−3
.gitignore+1
@@ -1 +1,2 @@
11.stack-work
2+TAGS
openapi-diff.cabal+3−1
@@ -33,6 +33,7 @@ common common-options
3333 build-depends: base >= 4.12.0.0 && < 4.14
3434 , aeson
3535 , containers
36+ , generic-monoid
3637 , insert-ordered-containers
3738 , openapi3
3839 , text
@@ -72,7 +73,8 @@ common common-options
7273library
7374 import: common-options
7475 hs-source-dirs: src
75− exposed-modules: OpenAPI.Checker.Report
76+ exposed-modules: OpenAPI.Checker.Aux
77+ , OpenAPI.Checker.Report
7678 , OpenAPI.Checker.Run
7779 , OpenAPI.Checker.Validate
7880 , OpenAPI.Checker.Validate.Monad
src/OpenAPI/Checker/Aux.hsnew file+7
@@ -0,0 +1,7 @@
1+module OpenAPI.Checker.Aux where
2+
3+import Data.OpenApi.Internal
4+
5+-- | Megre servers from parent (like PathItem) and child (like Operation)
6+mergeServers :: [Server] -> [Server] -> [Server]
7+mergeServers = (error "FIXME: not implemented")
src/OpenAPI/Checker/Report.hs+15−3
@@ -1,6 +1,8 @@
11module OpenAPI.Checker.Report where
22
33import Data.Map.Strict as M
4+import Data.Monoid.Generic
5+import Data.Semigroup.Generic
46import Data.Text (Text)
57import GHC.Generics (Generic)
68import OpenAPI.Checker.Validate.Monad
@@ -22,9 +24,16 @@ data ReportTree = ReportTree
2224 { paths :: Map Path (Errorable PathItemTree)
2325 } deriving (Eq, Ord, Show, Generic)
2426
25−newtype PathItemTree = PathItemTree
27+data PathItemTree = PathItemTree
2628 { operations :: Map OperationName (Errorable OperationTree)
27− } deriving (Eq, Ord, Show, Generic, Semigroup, Monoid)
29+ , server :: Maybe (Errorable ServerTree)
30+ } deriving (Eq, Ord, Show, Generic)
31+
32+instance Semigroup PathItemTree where
33+ (<>) = genericMappend
34+
35+instance Monoid PathItemTree where
36+ mempty = genericMempty
2837
2938instance Nested PathItemTree where
3039 type Parent PathItemTree = ReportTree
@@ -41,4 +50,7 @@ data OperationTree = OperationTree
4150instance Nested OperationTree where
4251 type Parent OperationTree = PathItemTree
4352 type Key OperationTree = OperationName
44− nest key p = PathItemTree $ M.singleton key p
53+ nest key p = PathItemTree (M.singleton key p) mempty
54+
55+data ServerTree = ServerTree
56+ deriving (Eq, Ord, Show, Generic)
src/OpenAPI/Checker/Validate.hs+33−12
@@ -7,6 +7,7 @@ import Data.HashSet.InsOrd as InsSet
77import Data.OpenApi
88import Data.OpenApi.Internal
99import Data.Traversable
10+import OpenAPI.Checker.Aux
1011import OpenAPI.Checker.Report
1112import OpenAPI.Checker.Validate.Monad
1213
@@ -14,21 +15,26 @@ reportCompat :: OpenApi -> OpenApi -> Report
1415reportCompat = error "FIXME: reportCompat not implemented"
1516
1617forwardCompatible :: OpenApi -> OpenApi -> ReportTree
17−forwardCompatible dec enc = fst $ runTreeM $ openApiCompatible dec enc
18+forwardCompatible old new = fst $ runTreeM $ openApiCompatible old new
1819
1920openApiCompatible :: OpenApi -> OpenApi -> TreeM ReportTree ()
20−openApiCompatible dec enc = void $ follow $
21− (InsMap.toList $ _openApiPaths dec) <&> \(path, encItem) ->
22− (path, checkItem path encItem)
21+openApiCompatible old new = void $ follow $
22+ (InsMap.toList $ _openApiPaths old) <&> \(path, oldItem) ->
23+ (path, checkItem path oldItem)
2324 where
24− -- checkItem :: Path -> PathItem -> TreeM PathItemTree ()
25− checkItem path encItem = do
26− case (InsMap.lookup path $ _openApiPaths enc) of
27− Nothing -> pathError $ "Path deleted"
28− Just decItem -> pathItemsCompatible encItem decItem
25+ oldServers = _openApiServers old
26+ newServers = _openApiServers new
27+ checkItem path oldItem = do
28+ case (InsMap.lookup path $ _openApiPaths new) of
29+ Nothing -> treeError $ "Path deleted"
30+ Just newItem ->
31+ pathItemsCompatible (oldServers, oldItem) (newServers, newItem)
2932
30−pathItemsCompatible :: PathItem -> PathItem -> TreeM PathItemTree ()
31−pathItemsCompatible dec enc = void $ follow
33+pathItemsCompatible
34+ :: ([Server], PathItem)
35+ -> ([Server], PathItem)
36+ -> TreeM PathItemTree ()
37+pathItemsCompatible (oldServers' , old) (newServers' , new) = void $ follow
3238 [ (Get, go _pathItemGet)
3339 , (Put, go _pathItemPut)
3440 , (Post, go _pathItemPost)
@@ -38,5 +44,20 @@ pathItemsCompatible dec enc = void $ follow
3844 , (Patch, go _pathItemPatch)
3945 , (Trace, go _pathItemTrace) ]
4046 where
47+ oldServers = mergeServers oldServers' (_pathItemServers old)
48+ newServers = mergeServers newServers' (_pathItemServers new)
4149 go :: (PathItem -> Maybe Operation) -> TreeM OperationTree ()
42− go getOp = (error "FIXME: not implemented")
50+ go getOp = case getOp old of
51+ Nothing -> return ()
52+ -- Operation is not in old schema, so any addition is Ok
53+ Just oldOp -> case getOp new of
54+ Nothing -> do
55+ -- Operation was in old schema, but no in new one.
56+ treeError "Operation was deleted. Old client may try to use it."
57+ Just newOp -> operationsCompatible (oldServers, oldOp) (newServers, newOp)
58+
59+operationsCompatible
60+ :: ([Server], Operation)
61+ -> ([Server], Operation)
62+ -> TreeM OperationTree ()
63+operationsCompatible = error "FIXME: operationsCompatible not implemented"
src/OpenAPI/Checker/Validate/Monad.hs+5−3
@@ -4,6 +4,7 @@ import Data.Text (Text)
44
55
66data TreeM t a = TreeM
7+
78instance Functor (TreeM t)
89instance Applicative (TreeM t)
910instance Monad (TreeM t)
@@ -19,10 +20,11 @@ class Nested t where
1920runTreeM :: TreeM t a -> (t, a)
2021runTreeM = error "FIXME: runReportTree not implemented"
2122
22−pathError :: Text -> TreeM t a
23−pathError = error "FIXME: pathError not implemented"
23+-- | Throws error in current tree
24+treeError :: Text -> TreeM t a
25+treeError = error "FIXME: treeError not implemented"
2426
25−-- | Runs several computations in different paths
27+-- | Runs several computations in different paths in subtrees
2628follow
2729 :: (Traversable f, Nested t)
2830 => f (Key t, TreeM t a)