servant-swagger 1.1.5 → 1.1.6

raw patch · 15 files changed

+245/−127 lines, 15 filesdep +aeson-prettydep +base-compatdep +template-haskelldep −aeson-qqdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson-pretty, base-compat, template-haskell, utf8-string

Dependencies removed: aeson-qq

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +1/−1
• example/swagger.json +6/−6
• servant-swagger.cabal +21/−15
• src/Servant/Swagger.hs +5/−3
• src/Servant/Swagger/Internal.hs +39/−35
• src/Servant/Swagger/Internal/Test.hs +95/−23
• src/Servant/Swagger/Internal/TypeLevel.hs +3/−3
• src/Servant/Swagger/Internal/TypeLevel/API.hs +9/−9
• src/Servant/Swagger/Internal/TypeLevel/Every.hs +18/−18
• src/Servant/Swagger/Internal/TypeLevel/TMap.hs +11/−11
• src/Servant/Swagger/Test.hs +1/−1
• src/Servant/Swagger/TypeLevel.hs +1/−1
• test/Data/Aeson/QQ/Simple2.hs +24/−0
• test/Servant/SwaggerSpec.hs +2/−1

@@ -1,3 +1,12 @@+1.1.6+-----++* Fixes:+  * `validateEveryToJSON` now prints validation errors++* Notes:+  * GHC-8.6 compatible release+ 1.1.5 ----- 

@@ -11,7 +11,7 @@  ### Motivation -Swagger™ is a project used to describe and document RESTful APIs.+Swagger is a project used to describe and document RESTful APIs. Unlike Servant it is language-agnostic and thus is quite popular among developers in different languages. It also exists for a longer time and has more tools to work with. 

@@ -56,7 +56,7 @@                     }                 },                 "produces": [-                    "application/json"+                    "application/json;charset=utf-8"                 ],                 "parameters": [                     {@@ -71,7 +71,7 @@             },             "put": {                 "consumes": [-                    "application/json"+                    "application/json;charset=utf-8"                 ],                 "responses": {                     "404": {@@ -88,7 +88,7 @@                     }                 },                 "produces": [-                    "application/json"+                    "application/json;charset=utf-8"                 ],                 "parameters": [                     {@@ -113,7 +113,7 @@         "/todo": {             "post": {                 "consumes": [-                    "application/json"+                    "application/json;charset=utf-8"                 ],                 "responses": {                     "400": {@@ -127,7 +127,7 @@                     }                 },                 "produces": [-                    "application/json"+                    "application/json;charset=utf-8"                 ],                 "parameters": [                     {@@ -153,7 +153,7 @@                     }                 },                 "produces": [-                    "application/json"+                    "application/json;charset=utf-8"                 ]             }         }

@@ -1,8 +1,8 @@ name:                servant-swagger-version:             1.1.5+version:             1.1.6 synopsis:            Generate Swagger specification for your servant API. description:-  Swagger™ is a project used to describe and document RESTful APIs.+  Swagger is a project used to describe and document RESTful APIs.   Unlike Servant it is language-agnostic and thus is quite popular among developers   in different languages. It also exists for a longer time and has more tools to work with.   .@@ -27,10 +27,12 @@ build-type:          Custom cabal-version:       1.18 tested-with:-  GHC==7.8.4,-  GHC==7.10.3,-  GHC==8.0.2,-  GHC==8.2.2+  GHC ==7.8.4+   || ==7.10.3+   || ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.1  extra-source-files:     README.md@@ -51,8 +53,8 @@  custom-setup   setup-depends:-    base >=4.7 && <4.11,-    Cabal >= 1.18 && <2.1,+    base >=4.7 && <4.13,+    Cabal >= 1.18 && <2.5,     cabal-doctest >=1.0.2 && <1.1  library@@ -70,15 +72,16 @@     Servant.Swagger.Internal.TypeLevel.Every     Servant.Swagger.Internal.TypeLevel.TMap   hs-source-dirs:      src-  build-depends:       aeson                     >=0.11.2.0 && <1.3-                     , base                      >=4.7.0.0  && <4.11+  build-depends:       aeson                     >=0.11.2.0 && <1.5+                     , aeson-pretty              >=0.4      && <0.9+                     , base                      >=4.7.0.0  && <4.13                      , bytestring                >=0.10.4.0 && <0.11                      , http-media                >=0.6.3    && <0.8                      , insert-ordered-containers >=0.1.0.0  && <0.3-                     , lens                      >=4.7.0.1  && <4.17-                     , servant                   >=0.13     && <0.14+                     , lens                      >=4.7.0.1  && <4.18+                     , servant                   >=0.13     && <0.15                      , singleton-bool            >=0.1.3    && <0.2-                     , swagger2                  >=2.1      && <2.3+                     , swagger2                  >=2.1      && <2.4                      , text                      >=1.2.0.6  && <1.3                      , unordered-containers      >=0.2.5.1  && <0.3 @@ -91,7 +94,7 @@   build-depends:     base,     directory >= 1.0,-    doctest >= 0.11.1 && <0.14,+    doctest >= 0.11.1 && <0.17,     servant,     QuickCheck,     filepath@@ -107,8 +110,8 @@   main-is:          Spec.hs   build-tool-depends: hspec-discover:hspec-discover   build-depends:    base+                  , base-compat >= 0.10.4 && <0.11                   , aeson-                  , aeson-qq >=0.8.1                   , hspec                   , QuickCheck                   , lens@@ -116,7 +119,10 @@                   , servant-swagger                   , swagger2                   , text+                  , template-haskell+                  , utf8-string >=1.0.1.1 && <1.1                   , time   other-modules:     Servant.SwaggerSpec+    Data.Aeson.QQ.Simple2   default-language: Haskell2010

@@ -7,14 +7,14 @@ -- This module provides means to generate and manipulate -- Swagger specification for servant APIs. ----- Swagger™ is a project used to describe and document RESTful APIs.+-- Swagger is a project used to describe and document RESTful APIs. -- -- The Swagger specification defines a set of files required to describe such an API. -- These files can then be used by the Swagger-UI project to display the API -- and Swagger-Codegen to generate clients in various languages. -- Additional utilities can also take advantage of the resulting files, such as testing tools. ----- For more information see <http://swagger.io/ Swagger™ documentation>.+-- For more information see <http://swagger.io/ Swagger documentation>. module Servant.Swagger (   -- * How to use this library   -- $howto@@ -158,9 +158,11 @@ -- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI) -- <BLANKLINE> -- [User]+-- ... -- User+-- ... -- UserId--- <BLANKLINE>+-- ... -- Finished in ... seconds -- 3 examples, 0 failures --

@@ -1,40 +1,44 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE ConstraintKinds      #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeOperators        #-} #if __GLASGOW_HASKELL__ >= 710 #define OVERLAPPABLE_ {-# OVERLAPPABLE #-} #else {-# LANGUAGE OverlappingInstances #-} #define OVERLAPPABLE_ #endif+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE UndecidableInstances #-}+#endif module Servant.Swagger.Internal where -import Control.Lens-import Data.Aeson-import Data.Monoid-import Data.Proxy-import qualified Data.Swagger as Swagger-import Data.Swagger hiding (Header)-import Data.Swagger.Declare-import Data.HashMap.Strict.InsOrd (InsOrdHashMap)-import qualified Data.HashMap.Strict.InsOrd  as InsOrdHashMap-import Data.Text (Text)-import qualified Data.Text as Text-import GHC.TypeLits-import Network.HTTP.Media (MediaType)-import Servant.API-import Servant.API.Description (FoldDescription, reflectDescription)-import Servant.API.Modifiers (FoldRequired)-import Data.Singletons.Bool+import           Control.Lens+import           Data.Aeson+import           Data.HashMap.Strict.InsOrd             (InsOrdHashMap)+import qualified Data.HashMap.Strict.InsOrd             as InsOrdHashMap+import           Data.Monoid+import           Data.Proxy+import           Data.Singletons.Bool+import           Data.Swagger                           hiding (Header)+import qualified Data.Swagger                           as Swagger+import           Data.Swagger.Declare+import           Data.Text                              (Text)+import qualified Data.Text                              as Text+import           GHC.TypeLits+import           Network.HTTP.Media                     (MediaType)+import           Servant.API+import           Servant.API.Description                (FoldDescription,+                                                         reflectDescription)+import           Servant.API.Modifiers                  (FoldRequired) -import Servant.Swagger.Internal.TypeLevel.API+import           Servant.Swagger.Internal.TypeLevel.API  -- | Generate a Swagger specification for a servant API. --@@ -119,15 +123,15 @@ mkEndpointWithSchemaRef mref path _ = mempty   & paths.at path ?~     (mempty & method ?~ (mempty-      & produces ?~ MimeList contentTypes+      & produces ?~ MimeList responseContentTypes       & at code ?~ Inline (mempty             & schema  .~ mref             & headers .~ responseHeaders)))   where-    method          = swaggerMethod (Proxy :: Proxy method)-    code            = fromIntegral (natVal (Proxy :: Proxy status))-    contentTypes    = allContentType (Proxy :: Proxy cs)-    responseHeaders = toAllResponseHeaders (Proxy :: Proxy hs)+    method               = swaggerMethod (Proxy :: Proxy method)+    code                 = fromIntegral (natVal (Proxy :: Proxy status))+    responseContentTypes = allContentType (Proxy :: Proxy cs)+    responseHeaders      = toAllResponseHeaders (Proxy :: Proxy hs)  -- | Add parameter to every operation in the spec. addParam :: Param -> Swagger -> Swagger@@ -355,9 +359,9 @@   toAllResponseHeaders _ = mempty  instance (ToResponseHeader h, AllToResponseHeader hs) => AllToResponseHeader (h ': hs) where-  toAllResponseHeaders _ = InsOrdHashMap.insert hname header hdrs+  toAllResponseHeaders _ = InsOrdHashMap.insert headerName headerBS hdrs     where-      (hname, header) = toResponseHeader (Proxy :: Proxy h)+      (headerName, headerBS) = toResponseHeader (Proxy :: Proxy h)       hdrs = toAllResponseHeaders (Proxy :: Proxy hs)  instance AllToResponseHeader hs => AllToResponseHeader (HList hs) where

@@ -1,21 +1,27 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators       #-} module Servant.Swagger.Internal.Test where -import Data.Aeson (ToJSON)-import Data.Swagger-import Data.Text (Text)-import Data.Typeable-import Test.Hspec-import Test.Hspec.QuickCheck-import Test.QuickCheck (Arbitrary)+import           Data.Aeson                         (ToJSON (..))+import           Data.Aeson.Encode.Pretty           (encodePretty)+import           Data.Swagger                       (Pattern, ToSchema,+                                                     toSchema)+import           Data.Swagger.Schema.Validation+import           Data.Text                          (Text)+import qualified Data.Text.Lazy                     as TL+import qualified Data.Text.Lazy.Encoding            as TL+import           Data.Typeable+import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Test.QuickCheck                    (Arbitrary, Property,+                                                     counterexample, property) -import Servant.API-import Servant.Swagger.Internal.TypeLevel+import           Servant.API+import           Servant.Swagger.Internal.TypeLevel  -- $setup -- >>> import Control.Applicative@@ -47,8 +53,9 @@ -- <BLANKLINE> -- ToJSON matches ToSchema --   User+-- ... --   UserId--- <BLANKLINE>+-- ... -- Finished in ... seconds -- 2 examples, 0 failures --@@ -75,7 +82,7 @@   -> Spec validateEveryToJSON _ = props   (Proxy :: Proxy [ToJSON, ToSchema])-  (null . validateToJSON)+  (maybeCounterExample . prettyValidateWith validateToJSON)   (Proxy :: Proxy (BodyTypes JSON api))  -- | Verify that every type used with @'JSON'@ content type in a servant API@@ -88,7 +95,7 @@   -> Spec validateEveryToJSONWithPatternChecker checker _ = props   (Proxy :: Proxy [ToJSON, ToSchema])-  (null . validateToJSONWithPatternChecker checker)+  (maybeCounterExample . prettyValidateWith (validateToJSONWithPatternChecker checker))   (Proxy :: Proxy (BodyTypes JSON api))  -- * QuickCheck-related stuff@@ -101,21 +108,23 @@ --    context "read . show == id" $ --      props --        (Proxy :: Proxy [Eq, Show, Read])---        (\x -> read (show x) == x)+--        (\x -> read (show x) === x) --        (Proxy :: Proxy [Bool, Int, String]) -- :} -- <BLANKLINE> -- read . show == id --   Bool+-- ... --   Int+-- ... --   [Char]--- <BLANKLINE>+-- ... -- Finished in ... seconds -- 3 examples, 0 failures props :: forall p p'' cs xs. TMap (Every (Typeable ': Show ': Arbitrary ': cs)) xs =>-  p cs                                      -- ^ A list of constraints.-  -> (forall x. EveryTF cs x => x -> Bool)  -- ^ Property predicate.-  -> p'' xs                                 -- ^ A list of types.+  p cs                                          -- ^ A list of constraints.+  -> (forall x. EveryTF cs x => x -> Property)  -- ^ Property predicate.+  -> p'' xs                                     -- ^ A list of types.   -> Spec props _ f px = sequence_ specs   where@@ -123,5 +132,68 @@     specs = tmapEvery (Proxy :: Proxy (Typeable ': Show ': Arbitrary ': cs)) aprop px      aprop :: forall p' a. (EveryTF cs a, Typeable a, Show a, Arbitrary a) => p' a -> Spec-    aprop _ = prop (show (typeOf (undefined :: a))) (f :: a -> Bool)+    aprop _ = prop (show (typeOf (undefined :: a))) (f :: a -> Property) +-- | Pretty print validation errors+-- together with actual JSON and Swagger Schema+-- (using 'encodePretty').+--+-- >>> import Data.Aeson+-- >>> import Data.Foldable (traverse_)+-- >>> data Person = Person { name :: String, phone :: Integer } deriving (Generic)+-- >>> instance ToJSON Person where toJSON p = object [ "name" .= name p ]+-- >>> instance ToSchema Person+-- >>> let person = Person { name = "John", phone = 123456 }+-- >>> traverse_ putStrLn $ prettyValidateWith validateToJSON person+-- Validation against the schema fails:+--   * property "phone" is required, but not found in "{\"name\":\"John\"}"+-- <BLANKLINE>+-- JSON value:+-- {+--     "name": "John"+-- }+-- <BLANKLINE>+-- Swagger Schema:+-- {+--     "required": [+--         "name",+--         "phone"+--     ],+--     "type": "object",+--     "properties": {+--         "phone": {+--             "type": "integer"+--         },+--         "name": {+--             "type": "string"+--         }+--     }+-- }+-- <BLANKLINE>+--+-- FIXME: this belongs in "Data.Swagger.Schema.Validation" (in @swagger2@).+prettyValidateWith+  :: forall a. (ToJSON a, ToSchema a)+  => (a -> [ValidationError]) -> a -> Maybe String+prettyValidateWith f x =+  case f x of+    []      -> Nothing+    errors  -> Just $ unlines+      [ "Validation against the schema fails:"+      , unlines (map ("  * " ++) errors)+      , "JSON value:"+      , ppJSONString json+      , ""+      , "Swagger Schema:"+      , ppJSONString (toJSON schema)+      ]+  where+    ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty++    json   = toJSON x+    schema = toSchema (Proxy :: Proxy a)++-- | Provide a counterexample if there is any.+maybeCounterExample :: Maybe String -> Property+maybeCounterExample Nothing  = property True+maybeCounterExample (Just s) = counterexample s (property False)

@@ -4,6 +4,6 @@   module Servant.Swagger.Internal.TypeLevel.TMap, ) where -import Servant.Swagger.Internal.TypeLevel.API-import Servant.Swagger.Internal.TypeLevel.Every-import Servant.Swagger.Internal.TypeLevel.TMap+import           Servant.Swagger.Internal.TypeLevel.API+import           Servant.Swagger.Internal.TypeLevel.Every+import           Servant.Swagger.Internal.TypeLevel.TMap

@@ -1,15 +1,15 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds      #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE KindSignatures       #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-} {-# LANGUAGE UndecidableInstances #-} module Servant.Swagger.Internal.TypeLevel.API where -import Data.Type.Bool (If)-import Servant.API-import GHC.Exts (Constraint)+import           Data.Type.Bool (If)+import           GHC.Exts       (Constraint)+import           Servant.API  -- | Build a list of endpoints from an API. type family EndpointsList api where

@@ -1,27 +1,27 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP                     #-}+{-# LANGUAGE ConstraintKinds         #-}+{-# LANGUAGE DataKinds               #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE GADTs                   #-}+{-# LANGUAGE InstanceSigs            #-}+{-# LANGUAGE KindSignatures          #-}+{-# LANGUAGE MultiParamTypeClasses   #-}+{-# LANGUAGE PolyKinds               #-}+{-# LANGUAGE RankNTypes              #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE TypeOperators           #-}+{-# LANGUAGE UndecidableInstances    #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE UndecidableSuperClasses #-} #endif module Servant.Swagger.Internal.TypeLevel.Every where -import Data.Proxy-import GHC.Exts (Constraint)+import           Data.Proxy+import           GHC.Exts                                (Constraint) -import Servant.Swagger.Internal.TypeLevel.TMap+import           Servant.Swagger.Internal.TypeLevel.TMap  -- $setup -- >>> :set -XDataKinds

@@ -1,17 +1,17 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds             #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-} module Servant.Swagger.Internal.TypeLevel.TMap where -import Data.Proxy-import GHC.Exts (Constraint)+import           Data.Proxy+import           GHC.Exts   (Constraint)  -- $setup -- >>> :set -XDataKinds

@@ -10,4 +10,4 @@   validateEveryToJSONWithPatternChecker, ) where -import Servant.Swagger.Internal.Test+import           Servant.Swagger.Internal.Test

@@ -11,5 +11,5 @@   BodyTypes, ) where -import Servant.Swagger.Internal.TypeLevel+import           Servant.Swagger.Internal.TypeLevel 

@@ -0,0 +1,24 @@+-- | Like "Data.Aeson.QQ" but without interpolation.+module Data.Aeson.QQ.Simple2 (aesonQQ) where++import           Data.Aeson (eitherDecode, Value)+import           Data.ByteString.Lazy.UTF8  as UTF8+import           Language.Haskell.TH+import           Language.Haskell.TH.Quote+import           Language.Haskell.TH.Syntax (Lift (..))+import           Prelude                    ()+import           Prelude.Compat++aesonQQ :: QuasiQuoter+aesonQQ = QuasiQuoter+    { quoteExp  = aesonExp+    , quotePat  = const $ error "No quotePat defined for jsonQQ"+    , quoteType = const $ error "No quoteType defined for jsonQQ"+    , quoteDec  = const $ error "No quoteDec defined for jsonQQ"+    }++aesonExp :: String -> ExpQ+aesonExp txt =+  case eitherDecode $ UTF8.fromString txt of+    Left err  -> error $ "Error in aesonExp: " ++ show err+    Right val -> lift (val :: Value)

@@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE QuasiQuotes        #-} {-# LANGUAGE TypeOperators      #-}+{-# LANGUAGE PackageImports     #-} #if __GLASGOW_HASKELL__ == 708 {-# OPTIONS_GHC -fcontext-stack=31 #-} #endif@@ -12,7 +13,7 @@  import           Control.Lens import           Data.Aeson       (ToJSON(toJSON), Value, genericToJSON)-import           Data.Aeson.QQ+import           Data.Aeson.QQ.Simple2 -- aeson will have the Simple module soon import qualified Data.Aeson.Types as JSON import           Data.Char        (toLower) import           Data.Int         (Int64)