12d42b9 · compaREST · git.iko.soy

.gitignore+1

compare with master

unifiedsplit

@@ -1 +1,2 @@

1.stack-work

2+TAGS

openapi-diff.cabal+3−1

@@ -33,6 +33,7 @@ common common-options

33 build-depends: base >= 4.12.0.0 && < 4.14

34 , aeson

35 , containers

36+ , generic-monoid

36 , insert-ordered-containers

37 , insert-ordered-containers

37 , openapi3

38 , openapi3

38 , text

39 , text

@@ -72,7 +73,8 @@ common common-options

72library

73library

73 import: common-options

74 import: common-options

74 hs-source-dirs: src

75 hs-source-dirs: src

75− exposed-modules: OpenAPI.Checker.Report

76+ exposed-modules: OpenAPI.Checker.Aux

77+ , OpenAPI.Checker.Report

76 , OpenAPI.Checker.Run

78 , OpenAPI.Checker.Run

77 , OpenAPI.Checker.Validate

79 , OpenAPI.Checker.Validate

78 , OpenAPI.Checker.Validate.Monad

80 , 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 @@

1module OpenAPI.Checker.Report where

2

3import Data.Map.Strict as M

4+import Data.Monoid.Generic

5+import Data.Semigroup.Generic

4import Data.Text (Text)

6import Data.Text (Text)

5import GHC.Generics (Generic)

7import GHC.Generics (Generic)

6import OpenAPI.Checker.Validate.Monad

8import OpenAPI.Checker.Validate.Monad

@@ -22,9 +24,16 @@ data ReportTree = ReportTree

22 { paths :: Map Path (Errorable PathItemTree)

24 { paths :: Map Path (Errorable PathItemTree)

23 } deriving (Eq, Ord, Show, Generic)

25 } deriving (Eq, Ord, Show, Generic)

24

26

25−newtype PathItemTree = PathItemTree

27+data PathItemTree = PathItemTree

26 { operations :: Map OperationName (Errorable OperationTree)

28 { operations :: Map OperationName (Errorable OperationTree)

29+ , server :: Maybe (Errorable ServerTree)

27− } deriving (Eq, Ord, Show, Generic, Semigroup, Monoid)

30+ } deriving (Eq, Ord, Show, Generic)

31+

32+instance Semigroup PathItemTree where

33+ (<>) = genericMappend

34+

35+instance Monoid PathItemTree where

36+ mempty = genericMempty

28

37

29instance Nested PathItemTree where

38instance Nested PathItemTree where

30 type Parent PathItemTree = ReportTree

39 type Parent PathItemTree = ReportTree

@@ -41,4 +50,7 @@ data OperationTree = OperationTree

41instance Nested OperationTree where

50instance Nested OperationTree where

42 type Parent OperationTree = PathItemTree

51 type Parent OperationTree = PathItemTree

43 type Key OperationTree = OperationName

52 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

7import Data.OpenApi

8import Data.OpenApi.Internal

9import Data.Traversable

10+import OpenAPI.Checker.Aux

10import OpenAPI.Checker.Report

11import OpenAPI.Checker.Report

11import OpenAPI.Checker.Validate.Monad

12import OpenAPI.Checker.Validate.Monad

12

13

@@ -14,21 +15,26 @@ reportCompat :: OpenApi -> OpenApi -> Report

14reportCompat = error "FIXME: reportCompat not implemented"

15reportCompat = error "FIXME: reportCompat not implemented"

15

16

16forwardCompatible :: OpenApi -> OpenApi -> ReportTree

17forwardCompatible :: OpenApi -> OpenApi -> ReportTree

17−forwardCompatible dec enc = fst $ runTreeM $ openApiCompatible dec enc

18+forwardCompatible old new = fst $ runTreeM $ openApiCompatible old new

18

19

19openApiCompatible :: OpenApi -> OpenApi -> TreeM ReportTree ()

20openApiCompatible :: OpenApi -> OpenApi -> TreeM ReportTree ()

20−openApiCompatible dec enc = void $ follow $

21+openApiCompatible old new = void $ follow $

21− (InsMap.toList $ _openApiPaths dec) <&> \(path, encItem) ->

22+ (InsMap.toList $ _openApiPaths old) <&> \(path, oldItem) ->

22− (path, checkItem path encItem)

23+ (path, checkItem path oldItem)

23 where

24 where

24− -- checkItem :: Path -> PathItem -> TreeM PathItemTree ()

25+ oldServers = _openApiServers old

26+ newServers = _openApiServers new

25− checkItem path encItem = do

27+ checkItem path oldItem = do

26− case (InsMap.lookup path $ _openApiPaths enc) of

28+ case (InsMap.lookup path $ _openApiPaths new) of

27− Nothing -> pathError $ "Path deleted"

29+ Nothing -> treeError $ "Path deleted"

28− Just decItem -> pathItemsCompatible encItem decItem

30+ Just newItem ->

31+ pathItemsCompatible (oldServers, oldItem) (newServers, newItem)

29

32

30−pathItemsCompatible :: PathItem -> PathItem -> TreeM PathItemTree ()

33+pathItemsCompatible

34+ :: ([Server], PathItem)

35+ -> ([Server], PathItem)

36+ -> TreeM PathItemTree ()

31−pathItemsCompatible dec enc = void $ follow

37+pathItemsCompatible (oldServers' , old) (newServers' , new) = void $ follow

32 [ (Get, go _pathItemGet)

38 [ (Get, go _pathItemGet)

33 , (Put, go _pathItemPut)

39 , (Put, go _pathItemPut)

34 , (Post, go _pathItemPost)

40 , (Post, go _pathItemPost)

@@ -38,5 +44,20 @@ pathItemsCompatible dec enc = void $ follow

38 , (Patch, go _pathItemPatch)

44 , (Patch, go _pathItemPatch)

39 , (Trace, go _pathItemTrace) ]

45 , (Trace, go _pathItemTrace) ]

40 where

46 where

47+ oldServers = mergeServers oldServers' (_pathItemServers old)

48+ newServers = mergeServers newServers' (_pathItemServers new)

41 go :: (PathItem -> Maybe Operation) -> TreeM OperationTree ()

49 go :: (PathItem -> Maybe Operation) -> TreeM OperationTree ()

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 ()

42− go getOp = (error "FIXME: not implemented")

63+operationsCompatible = error "FIXME: operationsCompatible not implemented"

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

@@ -4,6 +4,7 @@ import Data.Text (Text)

4

5

6data TreeM t a = TreeM

7+

7instance Functor (TreeM t)

8instance Functor (TreeM t)

8instance Applicative (TreeM t)

9instance Applicative (TreeM t)

9instance Monad (TreeM t)

10instance Monad (TreeM t)

@@ -19,10 +20,11 @@ class Nested t where

19runTreeM :: TreeM t a -> (t, a)

20runTreeM :: TreeM t a -> (t, a)

20runTreeM = error "FIXME: runReportTree not implemented"

21runTreeM = error "FIXME: runReportTree not implemented"

21

22

23+-- | Throws error in current tree

22−pathError :: Text -> TreeM t a

24+treeError :: Text -> TreeM t a

23−pathError = error "FIXME: pathError not implemented"

25+treeError = error "FIXME: treeError not implemented"

24

26

25−-- | Runs several computations in different paths

27+-- | Runs several computations in different paths in subtrees

26follow

28follow

27 :: (Traversable f, Nested t)

29 :: (Traversable f, Nested t)

28 => f (Key t, TreeM t a)

30 => f (Key t, TreeM t a)