@@ -37,6 +37,7 @@ 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((>=>))
4041
4142main :: IO ()
4243main = hspec spec
@@ -47,15 +48,15 @@ fuzzBoth
4748 HasClient ClientM a)
4849 => String -> Server a -> R.Config -> (Maybe R.Report -> IO ()) -> Spec
4950fuzzBoth name server config condition = do
50− it (name <> " via server") $ do
51+ it (name <> " via server") $
5152 RS.fuzz @a server config >>= condition
5253
53− around (withServer (serve (Proxy :: Proxy a) server)) $ do
54+ around (withServer (serve (Proxy :: Proxy a) server)) $
5455 it (name <> " via client") $ \(clientEnv::ClientEnv) -> do
55− RC.fuzz @a clientEnv config >>= condition
56+ RC.fuzz @a clientEnv config >>= condition
5657
5758withServer :: 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)
5960 where genClientEnv port = do
6061 baseUrl <- parseBaseUrl "http://localhost"
6162 manager <- newManager defaultManagerSettings
@@ -74,14 +75,14 @@ spec = do
7475 Just (R.InsufficientCoverage _) -> True
7576 _ -> False
7677 ))
77− describe "posted body" $ do
78+ describe "posted body" $
7879 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)
8081
8182
82− describe "PUTted body" $ do
83+ describe "PUTted body" $
8384 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)
8586
8687
8788 describe "seeded" $ do
@@ -90,31 +91,29 @@ spec = do
9091 (R.defaultConfig {R.seed = [(toDyn res, hash res)]})
9192 (`shouldSatisfy` isNothing)
9293
93− describe "Foo" $ do
94+ describe "Foo" $
9495 fuzzBoth @Foo.Api "finds an error in a basic app" Foo.server R.defaultConfig (`shouldSatisfy` serverFailure)
9596
96− describe "QueryParams" $ do
97+ describe "QueryParams" $
9798 fuzzBoth @QueryParams.Api "can handle query params" QueryParams.server R.defaultConfig { R.seed = [R.hashedDyn (12::Int)] }
98− (`shouldSatisfy` isNothing)
99+ (`shouldSatisfy` isNothing)
99100
100101 describe "BuildFrom" $ do
101− describe "headers (and sum types)" $ do
102+ describe "headers (and sum types)" $
102103 fuzzBoth @Headers.Api "should find a failure that's dependent on using header info" Headers.server R.defaultConfig
103− (`shouldSatisfy` serverFailure)
104− describe "product types" $ do
104+ (`shouldSatisfy` serverFailure)
105+ describe "product types" $
105106 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− (`shouldSatisfy` serverFailure)
107+ R.defaultConfig {R.seed = [R.hashedDyn 'a', R.hashedDyn (1 :: Int)]}
108+ (`shouldSatisfy` serverFailure)
108109 describe "Breakdown" $ do
109110 fuzzBoth @Breakdown.ProductApi "handles products" Breakdown.productServer R.defaultConfig
110111 (`shouldSatisfy` serverFailure)
111112 fuzzBoth @Breakdown.SumApi "handles sums" Breakdown.sumServer R.defaultConfig
112113 (`shouldSatisfy` serverFailure)
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.
114+ describe "flattening" $
116115 fuzzBoth @Nested.FlatApi "can handle nested apis" Nested.server R.defaultConfig {R.coverageThreshold = 0.99}
117− (`shouldSatisfy` isNothing)
116+ (`shouldSatisfy` isNothing)
118117
119118serverFailure :: Maybe R.Report -> Bool
120119serverFailure = \case
@@ -159,7 +158,7 @@ shouldFail =
159158 ( \i ->
160159 i
161160 { itemExample = \p a cb -> do
162− r <- (itemExample i) p a cb
161+ r <- itemExample i p a cb
163162 pure
164163 r
165164 { resultStatus = case resultStatus r of