5d71aaa..master · roboservant

package.yaml+1−1

since splitsnapshots

unifiedsplit

@@ -1,6 +1,6 @@

1

2name: roboservant

3−version: 0.1.0.2

3+version: 0.1.0.3

4github: "mwotton/roboservant"

5license: BSD3

6copyright: "2020 Mark Wotton, Samuel Schlesinger"

roboservant.cabal+4−4

@@ -1,13 +1,13 @@

1cabal-version: 1.12

2

3−-- This file has been generated from package.yaml by hpack version 0.33.0.

3+-- This file has been generated from package.yaml by hpack version 0.35.0.

4--

5-- see: https://github.com/sol/hpack

6--

7−-- hash: 76f10a967a70cffa900bcc3464a1fd973642332b3a86d22a19f5e3d1d8879f4d

7+-- hash: 0c0c35e1dca1d6c52e5bc61591cbd8c0da9d811b83341bbc676c5f8b93b0b20d

8

9name: roboservant

10−version: 0.1.0.2

10+version: 0.1.0.3

11synopsis: Automatic session-aware servant testing

12description: Please see the README on GitHub at <https://github.com/mwotton/roboservant#readme>

13category: Web

@@ -73,7 +73,7 @@ test-suite example

73 other-modules:

74 Paths_roboservant

75 hs-source-dirs:

76− ./.

76+ ./

77 ghc-options: -Wall -fwrite-ide-info -hiedir=.hie -pgmL markdown-unlit

78 build-tool-depends:

79 markdown-unlit:markdown-unlit

src/Roboservant/Client.hs+2−2

@@ -8,7 +8,7 @@

8{-# LANGUAGE PolyKinds #-}

9{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE TypeApplications #-}

11−{-# LANGUAGE TypeOperators #-}

11+

12{-# LANGUAGE UndecidableInstances #-}

13{-# LANGUAGE TypeFamilies #-}

14{-# LANGUAGE FlexibleContexts #-}

@@ -97,7 +97,7 @@ instance (Typeable x, Hashable x, Breakdown x) => NormalizeFunction (ClientM x)

97 where

98 renderClientError :: ClientError -> InteractionError

99 renderClientError err = case err of

100− FailureResponse _ (Response{responseStatusCode}) -> InteractionError textual (responseStatusCode == status500)

100+ FailureResponse _ Response{responseStatusCode} -> InteractionError textual (responseStatusCode == status500)

101 _ -> InteractionError textual True

102

103 where textual = T.pack $ show err

src/Roboservant/Direct.hs+11−12

@@ -7,7 +7,7 @@

7{-# LANGUAGE RecordWildCards #-}

8{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE TupleSections #-}

10−{-# LANGUAGE TypeApplications #-}

10+

11{-# LANGUAGE TypeFamilies #-}

12{-# LANGUAGE UndecidableInstances #-}

13

@@ -150,12 +150,12 @@ fuzz' reifiedApi Config {..} = handle (pure . Just . formatException) $ do

150 Report

151 (unlines [show failureType, show exception])

152 r

153− displayDiagnostics FuzzState {..} = liftIO $ do

153+ displayDiagnostics FuzzState {..} = liftIO $

154 logInfo $ unlines $

155− ["api endpoints covered"]

155+ ["api endpoints covered"]

156− <> (map show . Set.toList . Set.fromList $ map apiOffset path)

156+ <> (map show . Set.toList . Set.fromList $ map apiOffset path)

157− <> ["", "types in stash"]

157+ <> ["", "types in stash"]

158− <> DM.foldrWithKey (\_ v r -> (show . NEL.length . getStashValue $ v) : r) [] (getStash stash)

158+ <> DM.foldrWithKey (\_ v r -> (show . NEL.length . getStashValue $ v) : r) [] (getStash stash)

159 -- <> (map (show . NEL.length . getStashValue ) $ DM.assocs (getStash stash))

160 -- $ \_k v ->

161 -- (show . NEL.length $ getStashValue v))

@@ -246,11 +246,11 @@ fuzz' reifiedApi Config {..} = handle (pure . Just . formatException) $ do

246 if fatalError e

247 then throw e

248 else pure ()

249− Right (dyn :: NEL.NonEmpty (Dynamic, Int)) -> do

249+ Right (dyn :: NEL.NonEmpty (Dynamic, Int)) ->

250 modify'

251− ( \fs@FuzzState {..} ->

251+ ( \fs@FuzzState {..} ->

252− fs {stash = addToStash (NEL.toList dyn) stash}

252+ fs {stash = addToStash (NEL.toList dyn) stash}

253− )

253+ )

254 where

255 argVals = V.rmap (\(_ :*: V.Identity x) -> V.Identity x) args

256 -- argTypes = recordToList' (\(tr :*: _) -> R.SomeTypeRep tr) args

@@ -262,8 +262,7 @@ fuzz' reifiedApi Config {..} = handle (pure . Just . formatException) $ do

262 (execute op func args)

263 [ Handler (\(e :: SomeAsyncException) -> throw e),

264 Handler

265− ( \(e :: SomeException) -> do

265+ ( \(e :: SomeException) ->

266− -- displayDiagnostics =<< get

267 throw . RoboservantException ServerCrashed (Just e) =<< get

266 throw . RoboservantException ServerCrashed (Just e) =<< get

268 )

267 )

269 ]

268 ]

src/Roboservant/Server.hs+2−2

@@ -5,7 +5,7 @@

5{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE GADTs #-}

7{-# LANGUAGE PolyKinds #-}

8−{-# LANGUAGE RankNTypes #-}

8+

9{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE TypeApplications #-}

11{-# LANGUAGE TypeFamilies #-}

@@ -27,7 +27,7 @@ fuzz :: forall api.

27 Server api ->

28 Config ->

29 IO (Maybe Report)

30−fuzz s = fuzz' (reifyServer s)

30+fuzz s = fuzz' (reifyServer s)

31 -- todo: how do we pull reifyServer out?

32 where reifyServer :: (FlattenServer api, ToReifiedApi (Endpoints api))

33 => Server api -> ReifiedApi

src/Roboservant/Types.hs−1

@@ -14,7 +14,6 @@ module Roboservant.Types

14 module Roboservant.Types.ReifiedApi.Server,

15 module Roboservant.Types.Internal,

16 module Roboservant.Types.Config,

17− module Roboservant.Types.Orphans,

18 )

17 )

19where

18where

20

19

src/Roboservant/Types/Breakdown.hs+2−1

@@ -1,5 +1,6 @@

1{-# LANGUAGE AllowAmbiguousTypes #-}

2{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE DerivingVia #-}

4{-# LANGUAGE DerivingVia #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE GADTs #-}

6{-# LANGUAGE GADTs #-}

@@ -48,7 +49,7 @@ instance (Hashable x, Typeable x, Breakdown x) => Breakdown [x] where

48 breakdownExtras stash = concatMap (NEL.toList . breakdown) stash

49 breakdownExtras stash = concatMap (NEL.toList . breakdown) stash

49

50

51

51−class GBreakdown (f :: k -> *) where

52+class GBreakdown (f :: k -> Type) where

52 gBreakdownExtras :: f a -> [(Dynamic, Int)]

53 gBreakdownExtras :: f a -> [(Dynamic, Int)]

53

54

54instance (Hashable x, Typeable x, Generic x, GBreakdown (Rep x)) => Breakdown (Compound (x :: Type)) where

55instance (Hashable x, Typeable x, Generic x, GBreakdown (Rep x)) => Breakdown (Compound (x :: Type)) where

src/Roboservant/Types/BuildFrom.hs+1−1

@@ -77,7 +77,7 @@ deriving via (Atom Int) instance BuildFrom Int

77

78deriving via (Atom Char) instance BuildFrom Char

79

80−class GBuildFrom (f :: k -> *) where

80+class GBuildFrom (f :: k -> Type) where

81 gExtras :: Stash -> [([Provenance], f a)]

82

83instance GBuildFrom b => GBuildFrom (M1 D a b) where

src/Roboservant/Types/Internal.hs+2−2

@@ -43,11 +43,11 @@ instance Show Stash where

43

44-- | Can't be built up from parts, can't be broken down further.

45newtype Atom x = Atom {unAtom :: x}

46− deriving newtype (Hashable, Typeable)

46+ deriving newtype (Hashable, Typeable,Eq)

47

48-- | can be broken down and built up from generic pieces

49newtype Compound x = Compound {unCompound :: x}

50− deriving newtype (Hashable, Typeable)

50+ deriving newtype (Hashable, Typeable, Eq)

51

52hashedDyn :: (Hashable a, Typeable a) => a -> (Dynamic, Int)

53hashedDyn a = (toDyn a, hash a)

src/Roboservant/Types/ReifiedApi.hs+1−1

@@ -57,7 +57,7 @@ instance Show ReifiedEndpoint where

57

58class ( V.RecordToList (EndpointArgs endpoint)

59 , V.RMap (EndpointArgs endpoint)

60− ) => ToReifiedEndpoint (endpoint :: *) where

60+ ) => ToReifiedEndpoint (endpoint :: Type) where

61 type EndpointArgs endpoint :: [Type]

62 type EndpointRes endpoint :: Type

63

src/Roboservant/Types/ReifiedApi/Server.hs+1−1

@@ -6,7 +6,7 @@

6{-# LANGUAGE GADTs #-}

7{-# LANGUAGE LambdaCase #-}

8{-# LANGUAGE PolyKinds #-}

9−{-# LANGUAGE RankNTypes #-}

9+

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeApplications #-}

12{-# LANGUAGE TypeFamilies #-}

stack.yaml+5−5

@@ -1,10 +1,10 @@

1−resolver: lts-17.6

1+resolver: lts-20.4

2packages:

3- .

4

5extra-deps:

6−- dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657

6+# - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657

7−- dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068

7+# - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068

8- servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234

9−- constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853

9+# - constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853

10−- some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055

10+- some-1.0.3

stack.yaml.lock+9−30

@@ -4,44 +4,23 @@

4# https://docs.haskellstack.org/en/stable/lock_files

5

6packages:

7−- completed:

8− hackage: dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657

9− pantry-tree:

10− size: 551

11− sha256: 5defa30010904d2ad05a036f3eaf83793506717c93cbeb599f40db1a3632cfc5

12− original:

13− hackage: dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657

14−- completed:

15− hackage: dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068

16− pantry-tree:

17− size: 290

18− sha256: 9cbfb32b5a8a782b7a1c941803fd517633cb699159b851c1d82267a9e9391b50

19− original:

20− hackage: dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068

21- completed:

7- completed:

22 hackage: servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234

8 hackage: servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234

23 pantry-tree:

9 pantry-tree:

24− size: 325

25 sha256: 04f12c7bef2c3f9a25d94eb9489752ed498db8e243069fe95838dbb51df1dcb3

10 sha256: 04f12c7bef2c3f9a25d94eb9489752ed498db8e243069fe95838dbb51df1dcb3

11+ size: 325

26 original:

12 original:

27 hackage: servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234

13 hackage: servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234

28- completed:

14- completed:

29− hackage: constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853

15+ hackage: some-1.0.3@sha256:938cec5fc0d3a08dde34cfc0acd5a0aa2e9fd489c9dbb64417f16588dfb47af0,2399

30− pantry-tree:

31− size: 594

32− sha256: 3ce1012bfb02e4d7def9df19ce80b8cd2b472c691b25b181d9960638673fecd1

33− original:

34− hackage: constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853

35−- completed:

36− hackage: some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055

37 pantry-tree:

16 pantry-tree:

17+ sha256: b88dddc6b991cd570c6750f8d309a9feb76938b29a690abdabc4ababb8c7b2f8

38− size: 708

18+ size: 709

39− sha256: c882b6ebe8a0616f1ab3908f1620087ad5c6d8d82d1a72b99226f6487419bfe6

40 original:

19 original:

41− hackage: some-1.0.1@sha256:26e5bab7276f48b25ea8660d3fd1166c0f20fd497dac879a40f408e23211f93e,2055

20+ hackage: some-1.0.3

42snapshots:

21snapshots:

43- completed:

22- completed:

23+ sha256: 3770dfd79f5aed67acdcc65c4e7730adddffe6dba79ea723cfb0918356fc0f94

44− size: 565712

24+ size: 648660

45− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/6.yaml

25+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/4.yaml

46− sha256: 4e5e581a709c88e3fe26a9ce8bf331435729bead762fb5c190064c6c5bb1b835

47− original: lts-17.6

26+ original: lts-20.4

test/Breakdown.hs+1−1

@@ -1,7 +1,7 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE TypeOperators #-}

7

test/Nested.hs+2−2

@@ -1,7 +1,7 @@

1{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

2+

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE TypeOperators #-}

7

test/Post.hs+2−2

@@ -1,8 +1,8 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5−{-# LANGUAGE OverloadedStrings #-}

5+

6{-# LANGUAGE TypeOperators #-}

7

8module Post where

test/Product.hs+1−1

@@ -1,7 +1,7 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE TypeOperators #-}

7

test/Put.hs+2−2

@@ -1,8 +1,8 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5−{-# LANGUAGE OverloadedStrings #-}

5+

6{-# LANGUAGE TypeOperators #-}

7

8module Put where

test/QueryParams.hs+3−3

@@ -1,8 +1,8 @@

1{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

2+

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5−{-# LANGUAGE OverloadedStrings #-}

5+

6{-# LANGUAGE TypeOperators #-}

7

8module QueryParams where

test/Spec.hs+20−21

@@ -37,6 +37,7 @@ import Servant.Client(ClientEnv, mkClientEnv, baseUrlPort, parseBaseUrl,HasClien

37import Network.Wai(Application)

38import qualified Network.Wai.Handler.Warp as Warp

39import Network.HTTP.Client (newManager, defaultManagerSettings)

40+import Control.Monad((>=>))

40

41

41main :: IO ()

42main :: IO ()

42main = hspec spec

43main = hspec spec

@@ -47,15 +48,15 @@ fuzzBoth

47 HasClient ClientM a)

48 HasClient ClientM a)

48 => String -> Server a -> R.Config -> (Maybe R.Report -> IO ()) -> Spec

49 => String -> Server a -> R.Config -> (Maybe R.Report -> IO ()) -> Spec

49fuzzBoth name server config condition = do

50fuzzBoth name server config condition = do

50− it (name <> " via server") $ do

51+ it (name <> " via server") $

51 RS.fuzz @a server config >>= condition

52 RS.fuzz @a server config >>= condition

52

53

53− around (withServer (serve (Proxy :: Proxy a) server)) $ do

54+ around (withServer (serve (Proxy :: Proxy a) server)) $

54 it (name <> " via client") $ \(clientEnv::ClientEnv) -> do

55 it (name <> " via client") $ \(clientEnv::ClientEnv) -> do

55− RC.fuzz @a clientEnv config >>= condition

56+ RC.fuzz @a clientEnv config >>= condition

56

57

57withServer :: Application -> ActionWith ClientEnv -> IO ()

58withServer :: Application -> ActionWith ClientEnv -> IO ()

58−withServer app action = Warp.testWithApplication (pure app) (\p -> genClientEnv p >>= action)

59+withServer app action = Warp.testWithApplication (pure app) (genClientEnv >=> action)

59 where genClientEnv port = do

60 where genClientEnv port = do

60 baseUrl <- parseBaseUrl "http://localhost"

61 baseUrl <- parseBaseUrl "http://localhost"

61 manager <- newManager defaultManagerSettings

62 manager <- newManager defaultManagerSettings

@@ -74,14 +75,14 @@ spec = do

74 Just (R.InsufficientCoverage _) -> True

75 Just (R.InsufficientCoverage _) -> True

75 _ -> False

76 _ -> False

76 ))

77 ))

77− describe "posted body" $ do

78+ describe "posted body" $

78 fuzzBoth @Post.Api "passes a coverage check using a posted body" Post.server R.defaultConfig {R.coverageThreshold = 0.99}

79 fuzzBoth @Post.Api "passes a coverage check using a posted body" Post.server R.defaultConfig {R.coverageThreshold = 0.99}

79− (`shouldSatisfy` isNothing)

80+ (`shouldSatisfy` isNothing)

80

81

82

82− describe "PUTted body" $ do

83+ describe "PUTted body" $

83 fuzzBoth @Put.Api "passes a coverage check using a posted body" Put.server R.defaultConfig {R.coverageThreshold = 0.99}

84 fuzzBoth @Put.Api "passes a coverage check using a posted body" Put.server R.defaultConfig {R.coverageThreshold = 0.99}

84− (`shouldSatisfy` isNothing)

85+ (`shouldSatisfy` isNothing)

85

86

87

87 describe "seeded" $ do

88 describe "seeded" $ do

@@ -90,31 +91,29 @@ spec = do

90 (R.defaultConfig {R.seed = [(toDyn res, hash res)]})

91 (R.defaultConfig {R.seed = [(toDyn res, hash res)]})

91 (`shouldSatisfy` isNothing)

92 (`shouldSatisfy` isNothing)

92

93

93− describe "Foo" $ do

94+ describe "Foo" $

94 fuzzBoth @Foo.Api "finds an error in a basic app" Foo.server R.defaultConfig (`shouldSatisfy` serverFailure)

95 fuzzBoth @Foo.Api "finds an error in a basic app" Foo.server R.defaultConfig (`shouldSatisfy` serverFailure)

95

96

96− describe "QueryParams" $ do

97+ describe "QueryParams" $

97 fuzzBoth @QueryParams.Api "can handle query params" QueryParams.server R.defaultConfig { R.seed = [R.hashedDyn (12::Int)] }

98 fuzzBoth @QueryParams.Api "can handle query params" QueryParams.server R.defaultConfig { R.seed = [R.hashedDyn (12::Int)] }

98− (`shouldSatisfy` isNothing)

99+ (`shouldSatisfy` isNothing)

99

100

100 describe "BuildFrom" $ do

101 describe "BuildFrom" $ do

101− describe "headers (and sum types)" $ do

102+ describe "headers (and sum types)" $

102 fuzzBoth @Headers.Api "should find a failure that's dependent on using header info" Headers.server R.defaultConfig

103 fuzzBoth @Headers.Api "should find a failure that's dependent on using header info" Headers.server R.defaultConfig

103− (`shouldSatisfy` serverFailure)

104+ (`shouldSatisfy` serverFailure)

104− describe "product types" $ do

105+ describe "product types" $

105 fuzzBoth @Product.Api "should find a failure that's dependent on creating a product" Product.server

106 fuzzBoth @Product.Api "should find a failure that's dependent on creating a product" Product.server

106− R.defaultConfig {R.seed = [R.hashedDyn 'a', R.hashedDyn (1 :: Int)]}

107+ R.defaultConfig {R.seed = [R.hashedDyn 'a', R.hashedDyn (1 :: Int)]}

107− (`shouldSatisfy` serverFailure)

108+ (`shouldSatisfy` serverFailure)

108 describe "Breakdown" $ do

109 describe "Breakdown" $ do

109 fuzzBoth @Breakdown.ProductApi "handles products" Breakdown.productServer R.defaultConfig

110 fuzzBoth @Breakdown.ProductApi "handles products" Breakdown.productServer R.defaultConfig

110 (`shouldSatisfy` serverFailure)

111 (`shouldSatisfy` serverFailure)

111 fuzzBoth @Breakdown.SumApi "handles sums" Breakdown.sumServer R.defaultConfig

112 fuzzBoth @Breakdown.SumApi "handles sums" Breakdown.sumServer R.defaultConfig

112 (`shouldSatisfy` serverFailure)

113 (`shouldSatisfy` serverFailure)

113− describe "flattening" $ do

114+ describe "flattening" $

114− -- we don't actually do much here, this is just here to document the appropriate response

115− -- if you get a type error with a nested api.

116 fuzzBoth @Nested.FlatApi "can handle nested apis" Nested.server R.defaultConfig {R.coverageThreshold = 0.99}

115 fuzzBoth @Nested.FlatApi "can handle nested apis" Nested.server R.defaultConfig {R.coverageThreshold = 0.99}

117− (`shouldSatisfy` isNothing)

116+ (`shouldSatisfy` isNothing)

118

117

119serverFailure :: Maybe R.Report -> Bool

118serverFailure :: Maybe R.Report -> Bool

120serverFailure = \case

119serverFailure = \case

@@ -159,7 +158,7 @@ shouldFail =

159 ( \i ->

158 ( \i ->

160 i

159 i

161 { itemExample = \p a cb -> do

160 { itemExample = \p a cb -> do

162− r <- (itemExample i) p a cb

161+ r <- itemExample i p a cb

163 pure

162 pure

164 r

163 r

165 { resultStatus = case resultStatus r of

164 { resultStatus = case resultStatus r of

test/UnsafeIO.hs+3−3

@@ -1,7 +1,7 @@

1{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

2+

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE TypeOperators #-}

7

@@ -22,7 +22,7 @@ healthcheck ref = do

22 t <- liftIO $ readIORef ref

23 case t of

24 0 -> pure ()

25− n -> throwError $ err500 {errBody = "observed inconsistency: " <> (BL8.pack $ show n)}

25+ n -> throwError $ err500 {errBody = "observed inconsistency: " <> BL8.pack (show n)}

26

27makeServer :: IO (Server UnsafeApi)

28makeServer = do

test/Valid.hs+1−2

@@ -1,7 +1,7 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE TypeOperators #-}

7

@@ -10,7 +10,6 @@ module Valid where

10import Data.Void

11import GHC.Generics

12import Servant

13−import Servant.API.Generic

14import Servant.Server.Generic

13import Servant.Server.Generic

15

14

16type Api =

15type Api =