44e214b · compaREST · git.iko.soy

openapi-diff.cabal+19−1

compare with master

unifiedsplit

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

31 default-language: Haskell2010

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

33 , aeson

34+ , deriving-aeson

34 , containers

35 , containers

35 , generic-monoid

36 , generic-monoid

36 , insert-ordered-containers

37 , insert-ordered-containers

@@ -39,13 +40,18 @@ common common-options

39 , openapi3

40 , openapi3

40 , text

41 , text

41 , transformers

42 , transformers

43+ , yaml

44+ , attoparsec

42

45

43 default-extensions: ConstraintKinds

46 default-extensions: ConstraintKinds

44 , DataKinds

47 , DataKinds

48+ , DeriveAnyClass

45 , DeriveFoldable

49 , DeriveFoldable

46 , DeriveFunctor

50 , DeriveFunctor

47 , DeriveGeneric

51 , DeriveGeneric

48 , DeriveTraversable

52 , DeriveTraversable

53+ , DerivingStrategies

54+ , DerivingVia

49 , DuplicateRecordFields

55 , DuplicateRecordFields

50 , FlexibleContexts

56 , FlexibleContexts

51 , FlexibleInstances

57 , FlexibleInstances

@@ -96,7 +102,19 @@ test-suite openapi-diff-test

96 type: exitcode-stdio-1.0

102 type: exitcode-stdio-1.0

97 hs-source-dirs: test

103 hs-source-dirs: test

98 main-is: Spec.hs

104 main-is: Spec.hs

105+ other-modules:

106+ Spec.Golden.Report

107+ Spec.Golden.Extra

108+ Spec.Golden.ReportTree

99− build-depends: openapi-diff

109+ build-depends:

110+ , openapi-diff

111+ , tasty-golden

112+ , tasty

113+ , bytestring

114+ , aeson

115+ , yaml

116+ , directory

117+ , filepath

100 ghc-options: -threaded

118 ghc-options: -threaded

101 -rtsopts

119 -rtsopts

102 -with-rtsopts=-N

120 -with-rtsopts=-N

src/OpenAPI/Checker/Report.hs+43−10

@@ -1,34 +1,58 @@

1module OpenAPI.Checker.Report where

2

3+import Data.Aeson

4+import Data.Aeson.Types

5+import qualified Data.Attoparsec.Text as A

6+import Data.Functor

3import Data.Map.Strict as M

7import Data.Map.Strict as M

8+import Data.Maybe

4import Data.Monoid.Generic

9import Data.Monoid.Generic

5import Data.OpenApi.Internal

10import Data.OpenApi.Internal

6−import Data.Semigroup.Generic

7import Data.Text (Text)

11import Data.Text (Text)

8−import GHC.Generics (Generic)

12+import Deriving.Aeson.Stock

9import OpenAPI.Checker.Validate.Monad

13import OpenAPI.Checker.Validate.Monad

14+import Prelude as P

10

15

11printReport :: Report -> IO ()

16printReport :: Report -> IO ()

12printReport = error "FIXME: printReport not implemented"

17printReport = error "FIXME: printReport not implemented"

13

18

19+class HasUnsupportedFeature x where

20+ hasUnsupportedFeature :: x -> Bool

21+

14data Report = Report

22data Report = Report

15 { status :: Status

23 { status :: Status

16 , tree :: ReportTree

24 , tree :: ReportTree

25+ }

17− } deriving (Eq, Ord, Show, Generic)

26+ deriving stock (Eq, Ord, Show, Generic)

27+ deriving (ToJSON, FromJSON) via Snake Report

28+

29+instance HasUnsupportedFeature Report

30+

31+instance HasUnsupportedFeature x => HasUnsupportedFeature (Either e x) where

32+ hasUnsupportedFeature (Left _) = False

33+ hasUnsupportedFeature (Right x) = hasUnsupportedFeature x

18

34

19data Status = Success | Fail Text

35data Status = Success | Fail Text

20− deriving (Eq, Ord, Show, Generic)

36+ deriving stock (Eq, Ord, Show, Generic)

37+ deriving (ToJSON, FromJSON) via Snake Status

21

38

22type Path = FilePath -- From the library

39type Path = FilePath -- From the library

23

40

24newtype ReportTree = ReportTree

41newtype ReportTree = ReportTree

25 { paths :: Map Path (Errorable PathItemTree)

42 { paths :: Map Path (Errorable PathItemTree)

43+ }

44+ deriving stock (Show, Generic)

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

45+ deriving newtype (Eq, Ord, Semigroup, Monoid)

46+ deriving (ToJSON, FromJSON) via Snake ReportTree

47+

48+instance HasUnsupportedFeature ReportTree

27

49

28data PathItemTree = PathItemTree

50data PathItemTree = PathItemTree

29 { operations :: Map OperationName (Errorable OperationTree)

51 { operations :: Map OperationName (Errorable OperationTree)

30 , server :: Maybe (Errorable ServerTree)

52 , server :: Maybe (Errorable ServerTree)

53+ }

31− } deriving (Eq, Ord, Show, Generic)

54+ deriving stock (Eq, Ord, Show, Generic)

55+ deriving (ToJSON, FromJSON) via Snake PathItemTree

32

56

33instance Semigroup PathItemTree where

57instance Semigroup PathItemTree where

34 (<>) = genericMappend

58 (<>) = genericMappend

@@ -44,10 +68,14 @@ instance Nested PathItemTree where

44data OperationName

68data OperationName

46 deriving (Eq, Ord, Show, Generic)

70 deriving (Eq, Ord, Show, Generic)

71+ deriving (ToJSON, FromJSON) via Snake OperationName

72+ deriving anyclass (ToJSONKey, FromJSONKey)

47

73

48newtype OperationTree = OperationTree

74newtype OperationTree = OperationTree

49 { parameters :: Map ParamKey (Errorable ParamTree)

75 { parameters :: Map ParamKey (Errorable ParamTree)

76+ }

77+ deriving stock (Show, Generic)

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

78+ deriving newtype (Eq, Ord, Semigroup, Monoid, FromJSON, ToJSON)

51

79

52instance Nested OperationTree where

80instance Nested OperationTree where

53 type Parent OperationTree = PathItemTree

81 type Parent OperationTree = PathItemTree

@@ -55,10 +83,12 @@ instance Nested OperationTree where

55 nest key p = PathItemTree (M.singleton key p) mempty

83 nest key p = PathItemTree (M.singleton key p) mempty

56

84

57data ServerTree = ServerTree

85data ServerTree = ServerTree

58− deriving (Eq, Ord, Show, Generic)

86+ deriving stock (Eq, Ord, Show, Generic)

87+ deriving (ToJSON, FromJSON) via Snake ServerTree

59

88

60data ParamTree = ParamTree

89data ParamTree = ParamTree

61− deriving (Eq, Ord, Show, Generic)

90+ deriving stock (Eq, Ord, Show, Generic)

91+ deriving (ToJSON, FromJSON) via Snake ParamTree

62

92

63instance Semigroup ParamTree where

93instance Semigroup ParamTree where

64 (<>) = error "Not implemented"

94 (<>) = error "Not implemented"

@@ -76,7 +106,10 @@ deriving instance Ord ParamLocation

76data ParamKey = ParamKey

106data ParamKey = ParamKey

77 { name :: Text

107 { name :: Text

78 , paramIn :: ParamLocation

108 , paramIn :: ParamLocation

109+ }

79− } deriving (Eq, Ord, Show, Generic)

110+ deriving stock (Eq, Ord, Show, Generic)

111+ deriving (FromJSON, ToJSON) via Snake ParamKey

112+ deriving anyclass (ToJSONKey, FromJSONKey)

80

113

81getParamKey :: Param -> ParamKey

114getParamKey :: Param -> ParamKey

82getParamKey p = ParamKey

115getParamKey p = ParamKey

test/README.mdnew file+37

@@ -0,0 +1,37 @@

1+# Golden tests

2+

3+## The basics

4+

5+The `test/golden` directory contains a tree with golden tests. A test is a any nested directory with no folders nested inside it (i. e. tests can only be leaves in the file system):

6+

7+```

8+id

9+├── a.yaml

10+├── b.yaml

11+└── report.yaml

12+```

13+

14+All of the files and their meaning are specified in code:

15+

16+

17+```haskell

18+tests :: IO TestTree

19+tests =

20+ goldenInputsTreeUniform

21+ "Golden Reports"

22+ "test/golden/common"

23+ "report.yaml"

24+ ("a.yaml", "b.yaml")

25+ Yaml.decodeFileThrow

26+ (uncurry reportCompat)

27+```

28+

29+This test would read the files `a.yaml` and `b.yaml` using the `Yaml.decodeFileThrow` function, and pass the resulting tuple to `uncurry reportCompat`. The resul will be compared to `report.yaml`.

30+

31+## Supported feature tests

32+

33+If a test starts with either `x ` or `v `, the test is assumed to test the support of some OpenApi functionality. If the test begins `x ` it means that the feature is expected to be not supported, and the result will only be checked to have an "unsupported" flag set. If it starts with `v ` the test is expected to be supported and the result is compared to some file on disk.

34+

35+The result will be reflected in the generated compatibility matrix.

36+

37+If a test does not begin with either `x ` or `v `, then it is presumed to be a normal test and will not be reflected in the resulting compatibility matrix.

test/Spec.hs+15−1

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

1module Main (main) where

2

3+import qualified Spec.Golden.Report

4+import qualified Spec.Golden.ReportTree

5+import Test.Tasty

3

6

4main :: IO ()

7main :: IO ()

5−main = putStrLn ("Test suite is not implemented" :: String)

8+main = defaultMain =<< tests

9+

10+tests :: IO TestTree

11+tests = do

12+ goldenReport <- Spec.Golden.Report.tests

13+ goldenReportTree <- Spec.Golden.ReportTree.tests

14+ return $

15+ testGroup

16+ "Golden tests"

17+ [ goldenReport,

18+ goldenReportTree

19+ ]

test/Spec/Golden/Extra.hsnew file+119

@@ -0,0 +1,119 @@

1+module Spec.Golden.Extra

2+ ( getGoldenInputs,

3+ getGoldenInputsUniform,

4+ goldenInputsTree,

5+ goldenInputsTreeUniform,

6+ )

7+where

8+

9+import Control.Lens

10+import Control.Monad

11+import Data.Aeson hiding (Result)

12+import qualified Data.ByteString.Lazy as BSL

13+import qualified Data.Yaml as Yaml

14+import OpenAPI.Checker.Report

15+import System.Directory

16+import System.FilePath

17+import Test.Tasty

18+import Test.Tasty.Golden

19+import Test.Tasty.Providers

20+

21+data TestInput t

22+ = TestInputNode TestName [TestInput t]

23+ | TestInputLeaf TestName t FilePath

24+ deriving (Functor)

25+

26+getGoldenInputs ::

27+ (Each s t (FilePath, FilePath -> IO a) a) =>

28+ TestName ->

29+ FilePath ->

30+ s ->

31+ IO (TestInput t)

32+getGoldenInputs name filepath inp = do

33+ dirs' <- listDirectory filepath >>= filterM (doesDirectoryExist . (filepath </>))

34+ case dirs' of

35+ -- A test

36+ [] -> do

37+ x <-

38+ inp & each %%~ \(file, f) ->

39+ f $ filepath </> file

40+ return $ TestInputLeaf name x filepath

41+ -- A test group

42+ dirs ->

43+ TestInputNode name

44+ <$> forM dirs (\dir -> getGoldenInputs dir (filepath </> dir) inp)

45+

46+getGoldenInputsUniform ::

47+ (Each t h (FilePath, FilePath -> IO a) a) =>

48+ (Each s t FilePath (FilePath, FilePath -> IO a)) =>

49+ TestName ->

50+ (FilePath -> IO a) ->

51+ FilePath ->

52+ s ->

53+ IO (TestInput h)

54+getGoldenInputsUniform name f filepath inp = getGoldenInputs name filepath $ inp & each %~ (,f)

55+

56+goldenInputsTree ::

57+ (Each s t (FilePath, FilePath -> IO a) a, ToJSON x, HasUnsupportedFeature x) =>

58+ TestName ->

59+ -- | Root path

60+ FilePath ->

61+ -- | Name of golden file

62+ FilePath ->

63+ s ->

64+ (t -> x) ->

65+ IO TestTree

66+goldenInputsTree name filepath golden inp f = do

67+ runTestInputTree golden f <$> getGoldenInputs name filepath inp

68+

69+runTestInputTree ::

70+ (ToJSON x, HasUnsupportedFeature x) =>

71+ FilePath ->

72+ (t -> x) ->

73+ TestInput t ->

74+ TestTree

75+runTestInputTree golden f (TestInputNode name rest) =

76+ testGroup name (runTestInputTree golden f <$> rest)

77+runTestInputTree golden f (TestInputLeaf name t path)

78+ | testSupported name =

79+ goldenVsStringDiff

80+ name

81+ (\ref new -> ["diff", "-u", ref, new])

82+ (path </> golden)

83+ (pure . BSL.fromStrict . Yaml.encode . f $ t)

84+runTestInputTree _ f (TestInputLeaf name t _) =

85+ reportResult name $

86+ if hasUnsupportedFeature (f t)

87+ then testPassed "Feature unsupported"

88+ else testFailed "Unexpected feature support"

89+

90+reportResult :: TestName -> Result -> TestTree

91+reportResult name result = singleTest name $ SimpleTestReporter result

92+

93+newtype SimpleTestReporter = SimpleTestReporter Result

94+

95+instance IsTest SimpleTestReporter where

96+ run _ (SimpleTestReporter result) _ = return result

97+ testOptions = mempty

98+

99+testSupported :: TestName -> Bool

100+testSupported ('x' : ' ' : _) = False

101+testSupported _ = True

102+

103+goldenInputsTreeUniform ::

104+ ( Each t h (FilePath, FilePath -> IO a) a,

105+ ToJSON x,

106+ Each s t FilePath (FilePath, FilePath -> IO a),

107+ HasUnsupportedFeature x

108+ ) =>

109+ String ->

110+ -- | Root path

111+ FilePath ->

112+ -- | Name of golden file

113+ FilePath ->

114+ s ->

115+ (FilePath -> IO a) ->

116+ (h -> x) ->

117+ IO TestTree

118+goldenInputsTreeUniform name filepath golden inp h =

119+ goldenInputsTree name filepath golden (inp & each %~ (,h))

test/Spec/Golden/Report.hsnew file+19

@@ -0,0 +1,19 @@

1+module Spec.Golden.Report

2+ ( tests,

3+ )

4+where

5+

6+import qualified Data.Yaml as Yaml

7+import OpenAPI.Checker.Validate

8+import Spec.Golden.Extra

9+import Test.Tasty

10+

11+tests :: IO TestTree

12+tests =

13+ goldenInputsTreeUniform

14+ "Golden Reports"

15+ "test/golden/common"

16+ "report.yaml"

17+ ("a.yaml", "b.yaml")

18+ Yaml.decodeFileThrow

19+ (uncurry reportCompat)

test/Spec/Golden/ReportTree.hsnew file+19

@@ -0,0 +1,19 @@

1+module Spec.Golden.ReportTree

2+ ( tests,

3+ )

4+where

5+

6+import qualified Data.Yaml as Yaml

7+import OpenAPI.Checker.Validate

8+import Spec.Golden.Extra

9+import Test.Tasty

10+

11+tests :: IO TestTree

12+tests =

13+ goldenInputsTreeUniform

14+ "Golden ReportTrees"

15+ "test/golden/common"

16+ "report-tree.yaml"

17+ ("a.yaml", "b.yaml")

18+ Yaml.decodeFileThrow

19+ (uncurry forwardCompatible)

test/golden/common/id/a.yamlnew file+111

@@ -0,0 +1,111 @@

1+openapi: "3.0.0"

2+info:

3+ version: 1.0.0

4+ title: Swagger Petstore

5+ license:

6+ name: MIT

7+servers:

8+ - url: http://petstore.swagger.io/v1

9+paths:

10+ /pets:

11+ get:

12+ summary: List all pets

13+ operationId: listPets

14+ tags:

15+ - pets

16+ parameters:

17+ - name: limit

18+ in: query

19+ description: How many items to return at one time (max 100)

20+ required: false

21+ schema:

22+ type: integer

23+ format: int32

24+ responses:

25+ '200':

26+ description: A paged array of pets

27+ headers:

28+ x-next:

29+ description: A link to the next page of responses

30+ schema:

31+ type: string

32+ content:

33+ application/json:

34+ schema:

35+ $ref: "#/components/schemas/Pets"

36+ default:

37+ description: unexpected error

38+ content:

39+ application/json:

40+ schema:

41+ $ref: "#/components/schemas/Error"

42+ post:

43+ summary: Create a pet

44+ operationId: createPets

45+ tags:

46+ - pets

47+ responses:

48+ '201':

49+ description: Null response

50+ default:

51+ description: unexpected error

52+ content:

53+ application/json:

54+ schema:

55+ $ref: "#/components/schemas/Error"

56+ /pets/{petId}:

57+ get:

58+ summary: Info for a specific pet

59+ operationId: showPetById

60+ tags:

61+ - pets

62+ parameters:

63+ - name: petId

64+ in: path

65+ required: true

66+ description: The id of the pet to retrieve

67+ schema:

68+ type: string

69+ responses:

70+ '200':

71+ description: Expected response to a valid request

72+ content:

73+ application/json:

74+ schema:

75+ $ref: "#/components/schemas/Pet"

76+ default:

77+ description: unexpected error

78+ content:

79+ application/json:

80+ schema:

81+ $ref: "#/components/schemas/Error"

82+components:

83+ schemas:

84+ Pet:

85+ type: object

86+ required:

87+ - id

88+ - name

89+ properties:

90+ id:

91+ type: integer

92+ format: int64

93+ name:

94+ type: string

95+ tag:

96+ type: string

97+ Pets:

98+ type: array

99+ items:

100+ $ref: "#/components/schemas/Pet"

101+ Error:

102+ type: object

103+ required:

104+ - code

105+ - message

106+ properties:

107+ code:

108+ type: integer

109+ format: int32

110+ message:

111+ type: string

test/golden/common/id/b.yamlnew file+111