packages feed

hedgehog-servant (empty) → 0.0.0.1

raw patch · 7 files changed

+731/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, case-insensitive, hedgehog, hedgehog-servant, http-client, http-media, http-types, servant, servant-client, servant-server, string-conversions, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hedgehog-servant++## 0.0.0.1 -- 2019-11-04++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2019 Felix Mulder++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hedgehog-servant.cabal view
@@ -0,0 +1,129 @@+name:+  hedgehog-servant+version:+  0.0.0.1+synopsis:+  Hedgehog property testing for Servant APIs+description:+  An adapter for using Hedgehog to create requests against Servant APIs.+bug-reports:+  https://github.com/felixmulder/hedgehog-servant+cabal-version:+  1.24+license:+  BSD3+license-file:+  LICENSE+author:+  Felix Mulder+maintainer:+  felix.mulder@gmail.com+copyright:+  Felix Mulder+category:+  testing+build-type:+  Simple+extra-source-files:+  CHANGELOG.md++source-repository head+  type: git+  location: git://github.com/felixmulder/hedgehog-servant.git++library+  default-extensions:+    DataKinds+    DeriveGeneric+    FlexibleContexts+    FlexibleInstances+    GADTs+    KindSignatures+    MultiParamTypeClasses+    OverloadedStrings+    PolyKinds+    RankNTypes+    ScopedTypeVariables+    TypeApplications+    TypeOperators+    ViewPatterns++  ghc-options:+    -Wall -Wredundant-constraints -fhide-source-paths++  exposed-modules:+    Hedgehog.Servant++  build-depends:+      base                      >= 4.9      && < 5+    , bytestring                >= 0.10     && < 0.11+    , case-insensitive          >= 1.2      && < 1.3+    , hedgehog                  >= 0.6      && < 1.1+    , http-client               >= 0.6      && < 0.7+    , http-media                >= 0.8      && < 0.9+    , http-types                >= 0.12     && < 0.13+    , servant                   >= 0.16     && < 0.17+    , servant-client            >= 0.16     && < 0.17+    , servant-server            >= 0.16     && < 0.17+    , string-conversions        >= 0.4      && < 0.5+    , text                      >= 1.2      && < 1.3++  hs-source-dirs:+    src++  default-language:+    Haskell2010++test-suite hedgehog-servant-tests+  type:+    exitcode-stdio-1.0++  default-language:+    Haskell2010++  main-is:+    Main.hs++  ghc-options:+    -Wall -Wredundant-constraints -fhide-source-paths -threaded++  hs-source-dirs:+    test++  other-modules:+    Test.Hedgehog.Servant++  default-extensions:+    DataKinds+    DeriveGeneric+    DerivingStrategies+    FlexibleContexts+    FlexibleInstances+    GADTs+    GeneralizedNewtypeDeriving+    KindSignatures+    MultiParamTypeClasses+    OverloadedStrings+    PolyKinds+    RankNTypes+    ScopedTypeVariables+    TypeApplications+    TypeOperators+    ViewPatterns++  build-depends:+      hedgehog-servant++    , aeson                     >= 1.4      && < 1.5+    , base                      >= 4.9      && < 5+    , bytestring                >= 0.10     && < 0.11+    , case-insensitive          >= 1.2      && < 1.3+    , hedgehog                  >= 0.6      && < 1.1+    , http-client               >= 0.6      && < 0.7+    , http-media                >= 0.8      && < 0.9+    , http-types                >= 0.12     && < 0.13+    , servant                   >= 0.16     && < 0.17+    , servant-client            >= 0.16     && < 0.17+    , servant-server            >= 0.16     && < 0.17+    , string-conversions        >= 0.4      && < 0.5+    , text                      >= 1.2      && < 1.3
+ src/Hedgehog/Servant.hs view
@@ -0,0 +1,318 @@+module Hedgehog.Servant+  ( GList(..)+  , HasGen(..)+  , GenRequest(..)+  ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Internal as BS (c2w)+import qualified Data.CaseInsensitive as CI+import           Data.Proxy (Proxy(..))+import           Data.Text.Encoding (encodeUtf8, decodeUtf8)+import qualified Data.Text as Text+import           Data.String.Conversions (ConvertibleStrings, cs)+import           GHC.TypeLits (KnownSymbol, symbolVal)+import           Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import           Network.HTTP.Media (renderHeader)+import           Network.HTTP.Client (Request(..), RequestBody(..))+import           Network.HTTP.Client (defaultRequest)+import           Network.HTTP.Types (HeaderName)+import           Servant.API (ToHttpApiData(..))+import           Servant.API (Capture', CaptureAll, Header', Description, Summary)+import           Servant.API (QueryParam', QueryParams, QueryFlag)+import           Servant.API (ReqBody', Verb, ReflectMethod)+import           Servant.API (BasicAuth, HttpVersion, IsSecure, RemoteHost, Vault)+import           Servant.API (WithNamedContext)+import           Servant.API ((:>), (:<|>))+import           Servant.API (reflectMethod)+import           Servant.API.ContentTypes (AllMimeRender(..))+import           Servant.Client (BaseUrl(..), Scheme(..))++-- | Data structure used in order to specify generators for API+--+-- Example usage:+--+-- @+-- type Api = "cats" :> ReqBody '[JSON] Cat :> Post '[JSON] ()+--+-- catGen :: Gen Cat+-- catGen = _+--+-- genApi :: Gen (BaseUrl -> Request)+-- genApi = genRequest (Proxy @Api) (catGen :*: GNil)+-- @+data GList (a :: [*]) where+  GNil :: GList '[]+  (:*:) :: Gen x -> GList xs -> GList (Gen x ': xs)++infixr 6 :*:++-- | Simple getter from a GList of possible generators+class HasGen (g :: *) (gens :: [*]) where+  getGen :: GList gens -> Gen g++instance {-# OVERLAPPING #-} HasGen h (Gen h ': rest) where+  getGen (ha :*: _) = ha++instance {-# OVERLAPPABLE #-} (HasGen h rest) => HasGen h (first ': rest) where+  getGen (_ :*: hs) = getGen hs++-- | Type class used to generate requests from a 'GList gens' for API @api@+class GenRequest (api :: *) (gens :: [*]) where+  genRequest :: Proxy api -> GList gens -> Gen (BaseUrl -> Request)++-- | Instance for composite APIs+instance+  ( GenRequest a reqs+  , GenRequest b reqs+  ) => GenRequest (a :<|> b) reqs where+  genRequest _ gens =+    Gen.choice+      [ genRequest (Proxy @a) gens+      , genRequest (Proxy @b) gens+      ]++-- | Instance for description+instance+  ( GenRequest api reqs+  ) => GenRequest (Description d :> api) reqs where+  genRequest _ = genRequest (Proxy @api)++-- | Instance for summary+instance+  ( GenRequest api reqs+  ) => GenRequest (Summary s :> api) reqs where+  genRequest _ = genRequest (Proxy @api)++-- | Instance for path part of API+instance+  ( KnownSymbol path+  , GenRequest api reqs+  ) => GenRequest (path :> api) reqs where+  genRequest _ gens = do+    makeRequest <- genRequest (Proxy @api) gens+    pure $ prependPath (symbolVal $ Proxy @path) . makeRequest++-- | Instance for path capture+instance+  ( ToHttpApiData a+  , HasGen a gens+  , GenRequest api gens+  ) => GenRequest (Capture' modifiers sym a :> api) gens where+    genRequest _ gens = do+      capture <- toUrlPiece <$> getGen @a @gens gens+      makeRequest <- genRequest (Proxy @api) gens+      pure $ prependPath capture . makeRequest++-- | Instance for capture rest of path, e.g:+--+-- @+-- type Api = "cats" :> CaptureAll "rest" Text :> Get '[JSON] [Cat]+-- @+--+-- For simplicity this will generate a number of paths from 0 to 10 linearly+--+instance+  ( ToHttpApiData a+  , HasGen a gens+  , GenRequest api gens+  ) => GenRequest (CaptureAll sym a :> api) gens where+    genRequest _ gens = do+      captures <- Gen.list (Range.linear 0 10) (getGen @a @gens gens)+      makeRequest <- genRequest (Proxy @api) gens+      pure $ \baseUrl ->+        foldr (prependPath . toUrlPiece) (makeRequest baseUrl) captures++-- | Instance for headers+--+-- /Note: this instance currently makes all headers mandatory/+instance+  ( HasGen header gens+  , KnownSymbol headerName+  , ToHttpApiData header+  , GenRequest api gens+  ) => GenRequest (Header' mods headerName header :> api) gens where+    genRequest _ gens = do+      let headerName = CI.mk . cs . symbolVal $ Proxy @headerName+      header <- getGen @header @gens gens+      makeRequest <- genRequest (Proxy @api) gens+      pure $ addHeader headerName (toHeader header) . makeRequest++-- | Instance for setting query flag+--+-- /Note: this instance currently makes all query flags mandatory/+instance+  ( KnownSymbol name+  , GenRequest api gens+  ) => GenRequest (QueryFlag name :> api) gens where+    genRequest _ gens = do+      let paramName = toUrlPiece . symbolVal $ Proxy @name+      makeRequest <- genRequest (Proxy @api) gens+      pure $ \baseUrl ->+        let+          partialReq = makeRequest baseUrl+          oldQuery = decodeUtf8 $ queryString partialReq+          newQuery =+            if Text.null oldQuery then paramName+            else paramName <> "&" <> oldQuery+        in+          partialReq { queryString = encodeUtf8 newQuery }++-- | Instance for setting query parameters+--+-- /Note: this instance currently makes all query params mandatory/+instance+  ( KnownSymbol paramName+  , ToHttpApiData param+  , HasGen param gens+  , GenRequest api gens+  ) => GenRequest (QueryParam' mods paramName param :> api) gens where+    genRequest _ gens = do+      queryParam <- toUrlPiece <$> getGen @param @gens gens++      let+        paramName = toUrlPiece . symbolVal $ Proxy @paramName+        query = paramName <> "=" <> queryParam++      makeRequest <- genRequest (Proxy @api) gens+      pure $ \baseUrl ->+        let+          partialReq = makeRequest baseUrl+          oldQuery = decodeUtf8 $ queryString partialReq+          newQuery =+            if Text.null oldQuery then query+            else query <> "&" <> oldQuery+        in+          partialReq { queryString = encodeUtf8 newQuery }++-- | Instance for generating query parameters for arrays of values+instance+  ( KnownSymbol paramName+  , HasGen param gens+  , ToHttpApiData param+  , GenRequest api gens+  ) => GenRequest (QueryParams paramName param :> api) gens where+    genRequest _ gens = do+      params <- Gen.list (Range.linear 1 20) (getGen @param @gens gens)++      let+        paramName = toUrlPiece . symbolVal $ Proxy @paramName+        params' = fmap (((paramName <> "[]=") <>) . toUrlPiece) params+        queryParams = Text.intercalate "&" params'++      makeRequest <- genRequest (Proxy @api) gens+      pure $ \baseUrl ->+        let+          partialReq = makeRequest baseUrl+          oldQuery = decodeUtf8 $ queryString partialReq+          newQuery =+            if Text.null oldQuery then queryParams+            else queryParams <> "&" <> oldQuery+        in+          partialReq { queryString = encodeUtf8 newQuery }++-- | Instance for request body+instance+  ( AllMimeRender contentTypes body+  , HasGen body gens+  , GenRequest api gens+  ) => GenRequest (ReqBody' mods contentTypes body :> api) gens where+    genRequest _ gens = do+      newBody <- getGen @body @gens gens++      (contentType, body) <-+        Gen.element $ allMimeRender (Proxy @contentTypes) newBody++      makeRequest <- genRequest (Proxy @api) gens++      pure $ setBody body+           . addHeader "Content-Type" (renderHeader contentType)+           . makeRequest++-- | Instnace for capturing verb e.g. @POST@ or @GET@+instance+  ( ReflectMethod method+  ) => GenRequest (Verb method status contentTypes body) gens where+    genRequest _ _ =+      pure $ \baseUrl -> defaultRequest+        { host = cs . baseUrlHost $ baseUrl+        , port = baseUrlPort baseUrl+        , secure = baseUrlScheme baseUrl == Https+        , method = reflectMethod (Proxy @method)+        }++-- | This instance doees not do anything right now+--+-- /Note:/ in order to use features provided by this type in the API, you'll+-- need to manually adjust the generated request.+instance+  ( GenRequest api gens+  ) => GenRequest (BasicAuth x y :> api) gens where+    genRequest _ gens = genRequest (Proxy @api) gens++-- | This instance doees not do anything right now+--+-- /Note:/ in order to use features provided by this type in the API, you'll+-- need to manually adjust the generated request.+instance+  ( GenRequest api gens+  ) => GenRequest (HttpVersion :> api) gens where+    genRequest _ gens = genRequest (Proxy @api) gens++-- | This instance doees not do anything right now+--+-- /Note:/ in order to use features provided by this type in the API, you'll+-- need to manually adjust the generated request.+instance+  ( GenRequest api gens+  ) => GenRequest (IsSecure :> api) gens where+    genRequest _ gens = genRequest (Proxy @api) gens++-- | This instance doees not do anything right now+--+-- /Note:/ in order to use features provided by this type in the API, you'll+-- need to manually adjust the generated request.+instance+  ( GenRequest api gens+  ) => GenRequest (RemoteHost :> api) gens where+    genRequest _ gens = genRequest (Proxy @api) gens++-- | This instance doees not do anything right now+--+-- /Note:/ in order to use features provided by this type in the API, you'll+-- need to manually adjust the generated request.+instance+  ( GenRequest api gens+  ) => GenRequest (Vault :> api) gens where+    genRequest _ gens = genRequest (Proxy @api) gens++-- | This instance doees not do anything right now+--+-- /Note:/ in order to use features provided by this type in the API, you'll+-- need to manually adjust the generated request.+instance+  ( GenRequest api gens+  ) => GenRequest (WithNamedContext x y api) gens where+    genRequest _ gens = genRequest (Proxy @api) gens++setBody :: LBS.ByteString -> Request -> Request+setBody body oldReq = oldReq { requestBody = RequestBodyLBS body }++addHeader :: HeaderName -> BS.ByteString -> Request -> Request+addHeader name value oldReq =+  let+    headers = (name, value) : requestHeaders oldReq+  in+    oldReq { requestHeaders = headers }++-- | Helper function for prepending a new URL piece+prependPath :: ConvertibleStrings s BS.ByteString => s -> Request -> Request+prependPath new oldReq =+  let+    partialUrl = BS.dropWhile (== BS.c2w '/') . path $ oldReq+    urlPieces = filter (not . BS.null) [cs new, partialUrl]+  in+    oldReq { path = "/" <> BS.intercalate "/" urlPieces }
+ test/Main.hs view
@@ -0,0 +1,10 @@+module Main (main) where++import           Hedgehog.Main (defaultMain)++import qualified Test.Hedgehog.Servant as Hedgehog.Servant++main :: IO ()+main = defaultMain+  [ Hedgehog.Servant.tests+  ]
+ test/Test/Hedgehog/Servant.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE TemplateHaskell #-}+module Test.Hedgehog.Servant+  ( tests+  ) where++import           Control.Monad (forM_)+import           Data.Aeson (FromJSON, ToJSON, eitherDecode)+import           Data.String (IsString)+import           Data.Proxy (Proxy(..))+import           Data.Text (Text, splitOn)+import           Data.Text.Encoding (decodeUtf8)+import           Data.Functor ((<&>))+import           Data.Foldable (find)+import           GHC.Generics (Generic)+import           Servant.API (Capture, ReqBody, Header, JSON)+import           Servant.API (QueryFlag, QueryParam, QueryParams)+import           Servant.API (Post)+import           Servant.API ((:>), (:<|>))+import           Servant.Client (BaseUrl(..), Scheme(..))+import           Network.HTTP.Client (Request(..), RequestBody(..))+import           Network.HTTP.Types (methodPost)++import           Hedgehog (Gen, Property, PropertyT)+import           Hedgehog (annotate, annotateShow, checkParallel, discover, forAll)+import           Hedgehog (failure, property, success)+import           Hedgehog ((===))+import qualified Hedgehog.Gen as Gen++import           Hedgehog.Servant (GenRequest(..), GList(..))++-- A typical cat:+data Cat = Cat+  { name :: Text+  , color :: Text+  }+  deriving stock (Generic)++-- With ability to go back and forth to JSON:+instance ToJSON Cat+instance FromJSON Cat++-- And a simple generator to get random values of Cat:+genCat :: Gen Cat+genCat = Cat+  <$> Gen.element [ "Kitty", "Misty" ]+  <*> Gen.element [ "Red", "Green", "Blue" ]++-- Here's a simple API that allows posting a Cat in JSON to+--+-- POST /cats+type SimplestApi =+  "my" :> "cats" :> ReqBody '[JSON] Cat :> Post '[JSON] ()++-- Generate a request to the Cat API from a base URL+catRequestGen :: BaseUrl -> Gen Request+catRequestGen baseUrl =+  genRequest (Proxy @SimplestApi) (genCat :*: GNil) <&>+    \makeReq -> makeReq baseUrl++defaultBaseUrl :: BaseUrl+defaultBaseUrl = BaseUrl+  { baseUrlScheme = Https+  , baseUrlHost = "localhost"+  , baseUrlPort = 8080+  , baseUrlPath = ""+  }++prop_check_cat_request :: Property+prop_check_cat_request = property $ do+  forAll (catRequestGen defaultBaseUrl) >>= propCat++type CaptureApi =+  "cats" :> Capture "pathParam" Text :> Capture "path2" Text :> Post '[JSON] ()++captureGen :: Gen Text -> BaseUrl -> Gen Request+captureGen txt baseUrl =+  genRequest (Proxy @CaptureApi) (txt :*: GNil) <&>+    \makeReq -> makeReq baseUrl++prop_check_capture_req :: Property+prop_check_capture_req =+  let+    pathParam :: IsString a => a+    pathParam = "myPathParam"+  in+    property $ do+      req <- forAll $ captureGen (pure pathParam) defaultBaseUrl+      propBaseUrl req+      method req === methodPost+      path req === "/cats/" <> pathParam <> "/" <> pathParam++-- A typical dog:+data Dog = Dog+  { dogName :: Text+  , dogHappy :: Bool+  }+  deriving stock (Generic)++-- With ability to go back and forth to JSON:+instance ToJSON Dog+instance FromJSON Dog++-- And a simple generator to get random values of Cat:+genDog :: Gen Dog+genDog = Dog+  <$> Gen.element [ "Pluto", "Rowdy" ]+  <*> Gen.bool++type AltApi =+       "my" :> "cats" :> ReqBody '[JSON] Cat :> Post '[JSON] ()+  :<|> "dogs" :> ReqBody '[JSON] Dog :> Post '[JSON] ()++-- Generate a request to the Cat API from a base URL+altRequestGen :: BaseUrl -> Gen Request+altRequestGen baseUrl =+  genRequest (Proxy @AltApi) (genCat :*: genDog :*: GNil) <&>+    \makeReq -> makeReq baseUrl++prop_check_alt_api :: Property+prop_check_alt_api = property $ do+  req <- forAll (altRequestGen defaultBaseUrl)+  case path req of+    "/my/cats" -> propCat req+    "/dogs" -> propDog req+    badPath -> annotate "Bad path" >> annotateShow badPath >> failure++type HeaderApi = "cats" :> Header "Correlation-Id" Text :> Post '[JSON] ()++headerRequestGen :: BaseUrl -> Gen Request+headerRequestGen baseUrl =+  let+    textGen :: Gen Text+    textGen = pure "some-corr-id"+  in+    genRequest (Proxy @HeaderApi) (textGen :*: GNil) <&>+      \makeReq -> makeReq baseUrl++prop_has_correlation_id :: Property+prop_has_correlation_id = property $ do+  req <- forAll (headerRequestGen defaultBaseUrl)+  case find ((== "Correlation-Id") . fst) (requestHeaders req) of+    Just _ -> success+    Nothing -> failure++type QueryFlagApi =+  "my" :> "cats" :> QueryFlag "foo" :> QueryFlag "fi" :> Post '[JSON] ()++queryFlagGen :: BaseUrl -> Gen Request+queryFlagGen baseUrl =+  genRequest (Proxy @QueryFlagApi) GNil <&>+    \makeReq -> makeReq baseUrl++prop_has_query_Flag :: Property+prop_has_query_Flag = property $ do+  req <- forAll (queryFlagGen defaultBaseUrl)+  queryString req === "foo&fi"++type QueryParamApi =+  "my" :> "cats" :> QueryParam "foo" Text :> QueryParam "fi" Text :> Post '[JSON] ()++queryParamGen :: BaseUrl -> Gen Request+queryParamGen baseUrl =+  let+    paramGen :: Gen Text+    paramGen = pure "bar"+  in+    genRequest (Proxy @QueryParamApi) (paramGen :*: GNil) <&>+      \makeReq -> makeReq baseUrl++prop_has_query_param :: Property+prop_has_query_param = property $ do+  req <- forAll (queryParamGen defaultBaseUrl)+  queryString req === "foo=bar&fi=bar"++type QueryParamsApi =+  "my" :> "cats" :> QueryParams "foo" Text :> Post '[JSON] ()++queryParamsGen :: BaseUrl -> Gen Request+queryParamsGen baseUrl =+  let+    paramGen :: Gen Text+    paramGen = pure "bar"+  in+    genRequest (Proxy @QueryParamsApi) (paramGen :*: GNil) <&>+      \makeReq -> makeReq baseUrl++prop_has_query_params :: Property+prop_has_query_params = property $ do+  queryParams <-+    decodeUtf8 . queryString <$>+      forAll (queryParamsGen defaultBaseUrl)++  forM_ (splitOn "&" queryParams) (=== "foo[]=bar")++propCat :: Request -> PropertyT IO ()+propCat req = do+  propBaseUrl req+  propContentTypeJson req+  propDecodeJson (Proxy @Cat) req+  method req === methodPost+  path req === "/my/cats"++propDog :: Request -> PropertyT IO ()+propDog req = do+  propBaseUrl req+  propContentTypeJson req+  propDecodeJson (Proxy @Dog) req+  method req === methodPost+  path req === "/dogs"+++propBaseUrl :: Request -> PropertyT IO ()+propBaseUrl req = do+  method req === methodPost+  secure req === True+  host req === "localhost"+  port req === 8080++propContentTypeJson :: Request -> PropertyT IO ()+propContentTypeJson req =+  let+    headers = requestHeaders req+  in+    case find ((== "Content-Type"). fst) headers of+      Just _ -> success+      Nothing -> do+        annotate "Couldn't find \"Content-Type\" header"+        annotateShow headers+        failure++propDecodeJson :: forall a. FromJSON a => Proxy a -> Request -> PropertyT IO ()+propDecodeJson _ req =+  case requestBody req of+    RequestBodyLBS (eitherDecode @a -> Right _) ->+      success+    RequestBodyLBS (eitherDecode @a -> Left err) ->+      annotateShow err >> failure+    _ -> failure++tests :: IO Bool+tests = checkParallel $$discover