mirror of
https://github.com/ilyakooo0/compaREST.git
synced 2024-09-11 14:35:25 +03:00
Added basic test infrastructure (#5)
This commit is contained in:
parent
d430079e6a
commit
44e214bf8c
@ -31,6 +31,7 @@ common common-options
|
||||
default-language: Haskell2010
|
||||
build-depends: base >= 4.12.0.0 && < 4.15
|
||||
, aeson
|
||||
, deriving-aeson
|
||||
, containers
|
||||
, generic-monoid
|
||||
, insert-ordered-containers
|
||||
@ -39,13 +40,18 @@ common common-options
|
||||
, openapi3
|
||||
, text
|
||||
, transformers
|
||||
, yaml
|
||||
, attoparsec
|
||||
|
||||
default-extensions: ConstraintKinds
|
||||
, DataKinds
|
||||
, DeriveAnyClass
|
||||
, DeriveFoldable
|
||||
, DeriveFunctor
|
||||
, DeriveGeneric
|
||||
, DeriveTraversable
|
||||
, DerivingStrategies
|
||||
, DerivingVia
|
||||
, DuplicateRecordFields
|
||||
, FlexibleContexts
|
||||
, FlexibleInstances
|
||||
@ -96,7 +102,19 @@ test-suite openapi-diff-test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Spec.hs
|
||||
build-depends: openapi-diff
|
||||
other-modules:
|
||||
Spec.Golden.Report
|
||||
Spec.Golden.Extra
|
||||
Spec.Golden.ReportTree
|
||||
build-depends:
|
||||
, openapi-diff
|
||||
, tasty-golden
|
||||
, tasty
|
||||
, bytestring
|
||||
, aeson
|
||||
, yaml
|
||||
, directory
|
||||
, filepath
|
||||
ghc-options: -threaded
|
||||
-rtsopts
|
||||
-with-rtsopts=-N
|
||||
|
@ -1,34 +1,58 @@
|
||||
module OpenAPI.Checker.Report where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import qualified Data.Attoparsec.Text as A
|
||||
import Data.Functor
|
||||
import Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Data.Monoid.Generic
|
||||
import Data.OpenApi.Internal
|
||||
import Data.Semigroup.Generic
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics (Generic)
|
||||
import Deriving.Aeson.Stock
|
||||
import OpenAPI.Checker.Validate.Monad
|
||||
import Prelude as P
|
||||
|
||||
printReport :: Report -> IO ()
|
||||
printReport = error "FIXME: printReport not implemented"
|
||||
|
||||
class HasUnsupportedFeature x where
|
||||
hasUnsupportedFeature :: x -> Bool
|
||||
|
||||
data Report = Report
|
||||
{ status :: Status
|
||||
, tree :: ReportTree
|
||||
} deriving (Eq, Ord, Show, Generic)
|
||||
}
|
||||
deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving (ToJSON, FromJSON) via Snake Report
|
||||
|
||||
instance HasUnsupportedFeature Report
|
||||
|
||||
instance HasUnsupportedFeature x => HasUnsupportedFeature (Either e x) where
|
||||
hasUnsupportedFeature (Left _) = False
|
||||
hasUnsupportedFeature (Right x) = hasUnsupportedFeature x
|
||||
|
||||
data Status = Success | Fail Text
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving (ToJSON, FromJSON) via Snake Status
|
||||
|
||||
type Path = FilePath -- From the library
|
||||
|
||||
newtype ReportTree = ReportTree
|
||||
{ paths :: Map Path (Errorable PathItemTree)
|
||||
} deriving (Eq, Ord, Show, Generic, Semigroup, Monoid)
|
||||
}
|
||||
deriving stock (Show, Generic)
|
||||
deriving newtype (Eq, Ord, Semigroup, Monoid)
|
||||
deriving (ToJSON, FromJSON) via Snake ReportTree
|
||||
|
||||
instance HasUnsupportedFeature ReportTree
|
||||
|
||||
data PathItemTree = PathItemTree
|
||||
{ operations :: Map OperationName (Errorable OperationTree)
|
||||
, server :: Maybe (Errorable ServerTree)
|
||||
} deriving (Eq, Ord, Show, Generic)
|
||||
}
|
||||
deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving (ToJSON, FromJSON) via Snake PathItemTree
|
||||
|
||||
instance Semigroup PathItemTree where
|
||||
(<>) = genericMappend
|
||||
@ -44,10 +68,14 @@ instance Nested PathItemTree where
|
||||
data OperationName
|
||||
= Get | Put | Post | Delete | Options | Head | Patch | Trace
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
deriving (ToJSON, FromJSON) via Snake OperationName
|
||||
deriving anyclass (ToJSONKey, FromJSONKey)
|
||||
|
||||
newtype OperationTree = OperationTree
|
||||
{ parameters :: Map ParamKey (Errorable ParamTree)
|
||||
} deriving (Eq, Ord, Show, Generic, Semigroup, Monoid)
|
||||
}
|
||||
deriving stock (Show, Generic)
|
||||
deriving newtype (Eq, Ord, Semigroup, Monoid, FromJSON, ToJSON)
|
||||
|
||||
instance Nested OperationTree where
|
||||
type Parent OperationTree = PathItemTree
|
||||
@ -55,10 +83,12 @@ instance Nested OperationTree where
|
||||
nest key p = PathItemTree (M.singleton key p) mempty
|
||||
|
||||
data ServerTree = ServerTree
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving (ToJSON, FromJSON) via Snake ServerTree
|
||||
|
||||
data ParamTree = ParamTree
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving (ToJSON, FromJSON) via Snake ParamTree
|
||||
|
||||
instance Semigroup ParamTree where
|
||||
(<>) = error "Not implemented"
|
||||
@ -76,7 +106,10 @@ deriving instance Ord ParamLocation
|
||||
data ParamKey = ParamKey
|
||||
{ name :: Text
|
||||
, paramIn :: ParamLocation
|
||||
} deriving (Eq, Ord, Show, Generic)
|
||||
}
|
||||
deriving stock (Eq, Ord, Show, Generic)
|
||||
deriving (FromJSON, ToJSON) via Snake ParamKey
|
||||
deriving anyclass (ToJSONKey, FromJSONKey)
|
||||
|
||||
getParamKey :: Param -> ParamKey
|
||||
getParamKey p = ParamKey
|
||||
|
37
test/README.md
Normal file
37
test/README.md
Normal file
@ -0,0 +1,37 @@
|
||||
# Golden tests
|
||||
|
||||
## The basics
|
||||
|
||||
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):
|
||||
|
||||
```
|
||||
id
|
||||
├── a.yaml
|
||||
├── b.yaml
|
||||
└── report.yaml
|
||||
```
|
||||
|
||||
All of the files and their meaning are specified in code:
|
||||
|
||||
|
||||
```haskell
|
||||
tests :: IO TestTree
|
||||
tests =
|
||||
goldenInputsTreeUniform
|
||||
"Golden Reports"
|
||||
"test/golden/common"
|
||||
"report.yaml"
|
||||
("a.yaml", "b.yaml")
|
||||
Yaml.decodeFileThrow
|
||||
(uncurry reportCompat)
|
||||
```
|
||||
|
||||
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`.
|
||||
|
||||
## Supported feature tests
|
||||
|
||||
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.
|
||||
|
||||
The result will be reflected in the generated compatibility matrix.
|
||||
|
||||
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.
|
16
test/Spec.hs
16
test/Spec.hs
@ -1,5 +1,19 @@
|
||||
module Main (main) where
|
||||
|
||||
import qualified Spec.Golden.Report
|
||||
import qualified Spec.Golden.ReportTree
|
||||
import Test.Tasty
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn ("Test suite is not implemented" :: String)
|
||||
main = defaultMain =<< tests
|
||||
|
||||
tests :: IO TestTree
|
||||
tests = do
|
||||
goldenReport <- Spec.Golden.Report.tests
|
||||
goldenReportTree <- Spec.Golden.ReportTree.tests
|
||||
return $
|
||||
testGroup
|
||||
"Golden tests"
|
||||
[ goldenReport,
|
||||
goldenReportTree
|
||||
]
|
||||
|
119
test/Spec/Golden/Extra.hs
Normal file
119
test/Spec/Golden/Extra.hs
Normal file
@ -0,0 +1,119 @@
|
||||
module Spec.Golden.Extra
|
||||
( getGoldenInputs,
|
||||
getGoldenInputsUniform,
|
||||
goldenInputsTree,
|
||||
goldenInputsTreeUniform,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Data.Aeson hiding (Result)
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import qualified Data.Yaml as Yaml
|
||||
import OpenAPI.Checker.Report
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Golden
|
||||
import Test.Tasty.Providers
|
||||
|
||||
data TestInput t
|
||||
= TestInputNode TestName [TestInput t]
|
||||
| TestInputLeaf TestName t FilePath
|
||||
deriving (Functor)
|
||||
|
||||
getGoldenInputs ::
|
||||
(Each s t (FilePath, FilePath -> IO a) a) =>
|
||||
TestName ->
|
||||
FilePath ->
|
||||
s ->
|
||||
IO (TestInput t)
|
||||
getGoldenInputs name filepath inp = do
|
||||
dirs' <- listDirectory filepath >>= filterM (doesDirectoryExist . (filepath </>))
|
||||
case dirs' of
|
||||
-- A test
|
||||
[] -> do
|
||||
x <-
|
||||
inp & each %%~ \(file, f) ->
|
||||
f $ filepath </> file
|
||||
return $ TestInputLeaf name x filepath
|
||||
-- A test group
|
||||
dirs ->
|
||||
TestInputNode name
|
||||
<$> forM dirs (\dir -> getGoldenInputs dir (filepath </> dir) inp)
|
||||
|
||||
getGoldenInputsUniform ::
|
||||
(Each t h (FilePath, FilePath -> IO a) a) =>
|
||||
(Each s t FilePath (FilePath, FilePath -> IO a)) =>
|
||||
TestName ->
|
||||
(FilePath -> IO a) ->
|
||||
FilePath ->
|
||||
s ->
|
||||
IO (TestInput h)
|
||||
getGoldenInputsUniform name f filepath inp = getGoldenInputs name filepath $ inp & each %~ (,f)
|
||||
|
||||
goldenInputsTree ::
|
||||
(Each s t (FilePath, FilePath -> IO a) a, ToJSON x, HasUnsupportedFeature x) =>
|
||||
TestName ->
|
||||
-- | Root path
|
||||
FilePath ->
|
||||
-- | Name of golden file
|
||||
FilePath ->
|
||||
s ->
|
||||
(t -> x) ->
|
||||
IO TestTree
|
||||
goldenInputsTree name filepath golden inp f = do
|
||||
runTestInputTree golden f <$> getGoldenInputs name filepath inp
|
||||
|
||||
runTestInputTree ::
|
||||
(ToJSON x, HasUnsupportedFeature x) =>
|
||||
FilePath ->
|
||||
(t -> x) ->
|
||||
TestInput t ->
|
||||
TestTree
|
||||
runTestInputTree golden f (TestInputNode name rest) =
|
||||
testGroup name (runTestInputTree golden f <$> rest)
|
||||
runTestInputTree golden f (TestInputLeaf name t path)
|
||||
| testSupported name =
|
||||
goldenVsStringDiff
|
||||
name
|
||||
(\ref new -> ["diff", "-u", ref, new])
|
||||
(path </> golden)
|
||||
(pure . BSL.fromStrict . Yaml.encode . f $ t)
|
||||
runTestInputTree _ f (TestInputLeaf name t _) =
|
||||
reportResult name $
|
||||
if hasUnsupportedFeature (f t)
|
||||
then testPassed "Feature unsupported"
|
||||
else testFailed "Unexpected feature support"
|
||||
|
||||
reportResult :: TestName -> Result -> TestTree
|
||||
reportResult name result = singleTest name $ SimpleTestReporter result
|
||||
|
||||
newtype SimpleTestReporter = SimpleTestReporter Result
|
||||
|
||||
instance IsTest SimpleTestReporter where
|
||||
run _ (SimpleTestReporter result) _ = return result
|
||||
testOptions = mempty
|
||||
|
||||
testSupported :: TestName -> Bool
|
||||
testSupported ('x' : ' ' : _) = False
|
||||
testSupported _ = True
|
||||
|
||||
goldenInputsTreeUniform ::
|
||||
( Each t h (FilePath, FilePath -> IO a) a,
|
||||
ToJSON x,
|
||||
Each s t FilePath (FilePath, FilePath -> IO a),
|
||||
HasUnsupportedFeature x
|
||||
) =>
|
||||
String ->
|
||||
-- | Root path
|
||||
FilePath ->
|
||||
-- | Name of golden file
|
||||
FilePath ->
|
||||
s ->
|
||||
(FilePath -> IO a) ->
|
||||
(h -> x) ->
|
||||
IO TestTree
|
||||
goldenInputsTreeUniform name filepath golden inp h =
|
||||
goldenInputsTree name filepath golden (inp & each %~ (,h))
|
19
test/Spec/Golden/Report.hs
Normal file
19
test/Spec/Golden/Report.hs
Normal file
@ -0,0 +1,19 @@
|
||||
module Spec.Golden.Report
|
||||
( tests,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Yaml as Yaml
|
||||
import OpenAPI.Checker.Validate
|
||||
import Spec.Golden.Extra
|
||||
import Test.Tasty
|
||||
|
||||
tests :: IO TestTree
|
||||
tests =
|
||||
goldenInputsTreeUniform
|
||||
"Golden Reports"
|
||||
"test/golden/common"
|
||||
"report.yaml"
|
||||
("a.yaml", "b.yaml")
|
||||
Yaml.decodeFileThrow
|
||||
(uncurry reportCompat)
|
19
test/Spec/Golden/ReportTree.hs
Normal file
19
test/Spec/Golden/ReportTree.hs
Normal file
@ -0,0 +1,19 @@
|
||||
module Spec.Golden.ReportTree
|
||||
( tests,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Yaml as Yaml
|
||||
import OpenAPI.Checker.Validate
|
||||
import Spec.Golden.Extra
|
||||
import Test.Tasty
|
||||
|
||||
tests :: IO TestTree
|
||||
tests =
|
||||
goldenInputsTreeUniform
|
||||
"Golden ReportTrees"
|
||||
"test/golden/common"
|
||||
"report-tree.yaml"
|
||||
("a.yaml", "b.yaml")
|
||||
Yaml.decodeFileThrow
|
||||
(uncurry forwardCompatible)
|
111
test/golden/common/id/a.yaml
Normal file
111
test/golden/common/id/a.yaml
Normal file
@ -0,0 +1,111 @@
|
||||
openapi: "3.0.0"
|
||||
info:
|
||||
version: 1.0.0
|
||||
title: Swagger Petstore
|
||||
license:
|
||||
name: MIT
|
||||
servers:
|
||||
- url: http://petstore.swagger.io/v1
|
||||
paths:
|
||||
/pets:
|
||||
get:
|
||||
summary: List all pets
|
||||
operationId: listPets
|
||||
tags:
|
||||
- pets
|
||||
parameters:
|
||||
- name: limit
|
||||
in: query
|
||||
description: How many items to return at one time (max 100)
|
||||
required: false
|
||||
schema:
|
||||
type: integer
|
||||
format: int32
|
||||
responses:
|
||||
'200':
|
||||
description: A paged array of pets
|
||||
headers:
|
||||
x-next:
|
||||
description: A link to the next page of responses
|
||||
schema:
|
||||
type: string
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Pets"
|
||||
default:
|
||||
description: unexpected error
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Error"
|
||||
post:
|
||||
summary: Create a pet
|
||||
operationId: createPets
|
||||
tags:
|
||||
- pets
|
||||
responses:
|
||||
'201':
|
||||
description: Null response
|
||||
default:
|
||||
description: unexpected error
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Error"
|
||||
/pets/{petId}:
|
||||
get:
|
||||
summary: Info for a specific pet
|
||||
operationId: showPetById
|
||||
tags:
|
||||
- pets
|
||||
parameters:
|
||||
- name: petId
|
||||
in: path
|
||||
required: true
|
||||
description: The id of the pet to retrieve
|
||||
schema:
|
||||
type: string
|
||||
responses:
|
||||
'200':
|
||||
description: Expected response to a valid request
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Pet"
|
||||
default:
|
||||
description: unexpected error
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Error"
|
||||
components:
|
||||
schemas:
|
||||
Pet:
|
||||
type: object
|
||||
required:
|
||||
- id
|
||||
- name
|
||||
properties:
|
||||
id:
|
||||
type: integer
|
||||
format: int64
|
||||
name:
|
||||
type: string
|
||||
tag:
|
||||
type: string
|
||||
Pets:
|
||||
type: array
|
||||
items:
|
||||
$ref: "#/components/schemas/Pet"
|
||||
Error:
|
||||
type: object
|
||||
required:
|
||||
- code
|
||||
- message
|
||||
properties:
|
||||
code:
|
||||
type: integer
|
||||
format: int32
|
||||
message:
|
||||
type: string
|
111
test/golden/common/id/b.yaml
Normal file
111
test/golden/common/id/b.yaml
Normal file
@ -0,0 +1,111 @@
|
||||
openapi: "3.0.0"
|
||||
info:
|
||||
version: 1.0.0
|
||||
title: Swagger Petstore
|
||||
license:
|
||||
name: MIT
|
||||
servers:
|
||||
- url: http://petstore.swagger.io/v1
|
||||
paths:
|
||||
/pets:
|
||||
get:
|
||||
summary: List all pets
|
||||
operationId: listPets
|
||||
tags:
|
||||
- pets
|
||||
parameters:
|
||||
- name: limit
|
||||
in: query
|
||||
description: How many items to return at one time (max 100)
|
||||
required: false
|
||||
schema:
|
||||
type: integer
|
||||
format: int32
|
||||
responses:
|
||||
'200':
|
||||
description: A paged array of pets
|
||||
headers:
|
||||
x-next:
|
||||
description: A link to the next page of responses
|
||||
schema:
|
||||
type: string
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Pets"
|
||||
default:
|
||||
description: unexpected error
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Error"
|
||||
post:
|
||||
summary: Create a pet
|
||||
operationId: createPets
|
||||
tags:
|
||||
- pets
|
||||
responses:
|
||||
'201':
|
||||
description: Null response
|
||||
default:
|
||||
description: unexpected error
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Error"
|
||||
/pets/{petId}:
|
||||
get:
|
||||
summary: Info for a specific pet
|
||||
operationId: showPetById
|
||||
tags:
|
||||
- pets
|
||||
parameters:
|
||||
- name: petId
|
||||
in: path
|
||||
required: true
|
||||
description: The id of the pet to retrieve
|
||||
schema:
|
||||
type: string
|
||||
responses:
|
||||
'200':
|
||||
description: Expected response to a valid request
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Pet"
|
||||
default:
|
||||
description: unexpected error
|
||||
content:
|
||||
application/json:
|
||||
schema:
|
||||
$ref: "#/components/schemas/Error"
|
||||
components:
|
||||
schemas:
|
||||
Pet:
|
||||
type: object
|
||||
required:
|
||||
- id
|
||||
- name
|
||||
properties:
|
||||
id:
|
||||
type: integer
|
||||
format: int64
|
||||
name:
|
||||
type: string
|
||||
tag:
|
||||
type: string
|
||||
Pets:
|
||||
type: array
|
||||
items:
|
||||
$ref: "#/components/schemas/Pet"
|
||||
Error:
|
||||
type: object
|
||||
required:
|
||||
- code
|
||||
- message
|
||||
properties:
|
||||
code:
|
||||
type: integer
|
||||
format: int32
|
||||
message:
|
||||
type: string
|
Loading…
Reference in New Issue
Block a user