44e214b · typeable/compaREST

openapi-diff.cabal+19−1

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

3131 default-language: Haskell2010

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

3333 , aeson

34+ , deriving-aeson

3435 , containers

3536 , generic-monoid

3637 , insert-ordered-containers

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

3940 , openapi3

4041 , text

4142 , transformers

43+ , yaml

44+ , attoparsec

4245

4346 default-extensions: ConstraintKinds

4447 , DataKinds

48+ , DeriveAnyClass

4549 , DeriveFoldable

4650 , DeriveFunctor

4751 , DeriveGeneric

4852 , DeriveTraversable

53+ , DerivingStrategies

54+ , DerivingVia

4955 , DuplicateRecordFields

5056 , FlexibleContexts

5157 , FlexibleInstances

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

96102 type: exitcode-stdio-1.0

97103 hs-source-dirs: test

98104 main-is: Spec.hs

99− build-depends: openapi-diff

105+ other-modules:

106+ Spec.Golden.Report

107+ Spec.Golden.Extra

108+ Spec.Golden.ReportTree

109+ build-depends:

110+ , openapi-diff

111+ , tasty-golden

112+ , tasty

113+ , bytestring

114+ , aeson

115+ , yaml

116+ , directory

117+ , filepath

100118 ghc-options: -threaded

101119 -rtsopts

102120 -with-rtsopts=-N

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

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

11module OpenAPI.Checker.Report where

22

3+import Data.Aeson

4+import Data.Aeson.Types

5+import qualified Data.Attoparsec.Text as A

6+import Data.Functor

37import Data.Map.Strict as M

8+import Data.Maybe

49import Data.Monoid.Generic

510import Data.OpenApi.Internal

6−import Data.Semigroup.Generic

711import Data.Text (Text)

8−import GHC.Generics (Generic)

12+import Deriving.Aeson.Stock

913import OpenAPI.Checker.Validate.Monad

14+import Prelude as P

1015

1116printReport :: Report -> IO ()

1217printReport = error "FIXME: printReport not implemented"

1318

19+class HasUnsupportedFeature x where

20+ hasUnsupportedFeature :: x -> Bool

21+

1422data Report = Report

1523 { status :: Status

1624 , tree :: ReportTree

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

25+ }

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

1834

1935data Status = Success | Fail Text

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

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

37+ deriving (ToJSON, FromJSON) via Snake Status

2138

2239type Path = FilePath -- From the library

2340

2441newtype ReportTree = ReportTree

2542 { paths :: Map Path (Errorable PathItemTree)

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

43+ }

44+ deriving stock (Show, Generic)

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

46+ deriving (ToJSON, FromJSON) via Snake ReportTree

47+

48+instance HasUnsupportedFeature ReportTree

2749

2850data PathItemTree = PathItemTree

2951 { operations :: Map OperationName (Errorable OperationTree)

3052 , server :: Maybe (Errorable ServerTree)

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

53+ }

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

55+ deriving (ToJSON, FromJSON) via Snake PathItemTree

3256

3357instance Semigroup PathItemTree where

3458 (<>) = genericMappend

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

4468data OperationName

4670 deriving (Eq, Ord, Show, Generic)

71+ deriving (ToJSON, FromJSON) via Snake OperationName

72+ deriving anyclass (ToJSONKey, FromJSONKey)

4773

4874newtype OperationTree = OperationTree

4975 { parameters :: Map ParamKey (Errorable ParamTree)

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

76+ }

77+ deriving stock (Show, Generic)

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

5179

5280instance Nested OperationTree where

5381 type Parent OperationTree = PathItemTree

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

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

5684

5785data ServerTree = ServerTree

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

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

87+ deriving (ToJSON, FromJSON) via Snake ServerTree

5988

6089data ParamTree = ParamTree

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

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

91+ deriving (ToJSON, FromJSON) via Snake ParamTree

6292

6393instance Semigroup ParamTree where

6494 (<>) = error "Not implemented"

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

76106data ParamKey = ParamKey

77107 { name :: Text

78108 , paramIn :: ParamLocation

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

109+ }

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

111+ deriving (FromJSON, ToJSON) via Snake ParamKey

112+ deriving anyclass (ToJSONKey, FromJSONKey)

80113

81114getParamKey :: Param -> ParamKey

82115getParamKey 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 @@

11module Main (main) where

22

3+import qualified Spec.Golden.Report

4+import qualified Spec.Golden.ReportTree

5+import Test.Tasty

36

47main :: 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