@@ -37,7 +37,6 @@ import Servant.Client(ClientEnv, mkClientEnv, baseUrlPort, parseBaseUrl,HasClien
3737import Network.Wai(Application)
3838import qualified Network.Wai.Handler.Warp as Warp
3939import Network.HTTP.Client (newManager, defaultManagerSettings)
40−import Control.Monad((>=>))
4140
4241main :: IO ()
4342main = hspec spec
@@ -48,15 +47,15 @@ fuzzBoth
4847 HasClient ClientM a)
4948 => String -> Server a -> R.Config -> (Maybe R.Report -> IO ()) -> Spec
5049fuzzBoth name server config condition = do
51− it (name <> " via server") $
50+ it (name <> " via server") $ do
5251 RS.fuzz @a server config >>= condition
5352
54− around (withServer (serve (Proxy :: Proxy a) server)) $
53+ around (withServer (serve (Proxy :: Proxy a) server)) $ do
5554 it (name <> " via client") $ \(clientEnv::ClientEnv) -> do
56− RC.fuzz @a clientEnv config >>= condition
55+ RC.fuzz @a clientEnv config >>= condition
5756
5857withServer :: Application -> ActionWith ClientEnv -> IO ()
59−withServer app action = Warp.testWithApplication (pure app) (genClientEnv >=> action)
58+withServer app action = Warp.testWithApplication (pure app) (\p -> genClientEnv p >>= action)
6059 where genClientEnv port = do
6160 baseUrl <- parseBaseUrl "http://localhost"
6261 manager <- newManager defaultManagerSettings
@@ -75,14 +74,14 @@ spec = do
7574 Just (R.InsufficientCoverage _) -> True
7675 _ -> False
7776 ))
78− describe "posted body" $
77+ describe "posted body" $ do
7978 fuzzBoth @Post.Api "passes a coverage check using a posted body" Post.server R.defaultConfig {R.coverageThreshold = 0.99}
80− (`shouldSatisfy` isNothing)
79+ (`shouldSatisfy` isNothing)
8180
8281
83− describe "PUTted body" $
82+ describe "PUTted body" $ do
8483 fuzzBoth @Put.Api "passes a coverage check using a posted body" Put.server R.defaultConfig {R.coverageThreshold = 0.99}
85− (`shouldSatisfy` isNothing)
84+ (`shouldSatisfy` isNothing)
8685
8786
8887 describe "seeded" $ do
@@ -91,29 +90,31 @@ spec = do
9190 (R.defaultConfig {R.seed = [(toDyn res, hash res)]})
9291 (`shouldSatisfy` isNothing)
9392
94− describe "Foo" $
93+ describe "Foo" $ do
9594 fuzzBoth @Foo.Api "finds an error in a basic app" Foo.server R.defaultConfig (`shouldSatisfy` serverFailure)
9695
97− describe "QueryParams" $
96+ describe "QueryParams" $ do
9897 fuzzBoth @QueryParams.Api "can handle query params" QueryParams.server R.defaultConfig { R.seed = [R.hashedDyn (12::Int)] }
99− (`shouldSatisfy` isNothing)
98+ (`shouldSatisfy` isNothing)
10099
101100 describe "BuildFrom" $ do
102− describe "headers (and sum types)" $
101+ describe "headers (and sum types)" $ do
103102 fuzzBoth @Headers.Api "should find a failure that's dependent on using header info" Headers.server R.defaultConfig
104− (`shouldSatisfy` serverFailure)
105− describe "product types" $
103+ (`shouldSatisfy` serverFailure)
104+ describe "product types" $ do
106105 fuzzBoth @Product.Api "should find a failure that's dependent on creating a product" Product.server
107− R.defaultConfig {R.seed = [R.hashedDyn 'a', R.hashedDyn (1 :: Int)]}
108− (`shouldSatisfy` serverFailure)
106+ R.defaultConfig {R.seed = [R.hashedDyn 'a', R.hashedDyn (1 :: Int)]}
107+ (`shouldSatisfy` serverFailure)
109108 describe "Breakdown" $ do
110109 fuzzBoth @Breakdown.ProductApi "handles products" Breakdown.productServer R.defaultConfig
111110 (`shouldSatisfy` serverFailure)
112111 fuzzBoth @Breakdown.SumApi "handles sums" Breakdown.sumServer R.defaultConfig
113112 (`shouldSatisfy` serverFailure)
114− describe "flattening" $
113+ describe "flattening" $ do
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.
115116 fuzzBoth @Nested.FlatApi "can handle nested apis" Nested.server R.defaultConfig {R.coverageThreshold = 0.99}
116− (`shouldSatisfy` isNothing)
117+ (`shouldSatisfy` isNothing)
117118
118119serverFailure :: Maybe R.Report -> Bool
119120serverFailure = \case
@@ -158,7 +159,7 @@ shouldFail =
158159 ( \i ->
159160 i
160161 { itemExample = \p a cb -> do
161− r <- itemExample i p a cb
162+ r <- (itemExample i) p a cb
162163 pure
163164 r
164165 { resultStatus = case resultStatus r of