@@ -21,9 +21,7 @@ import qualified Foo
2121import qualified Headers
2222import qualified Nested
2323import qualified Post
24−import qualified Put
2524import qualified Product
26−import qualified QueryParams
2725import qualified Roboservant as R
2826import qualified Roboservant.Server as RS
2927import qualified Roboservant.Client as RC
@@ -31,32 +29,31 @@ import qualified Seeded
3129import Test.Hspec
3230import Test.Hspec.Core.Spec (FailureReason (Reason), ResultStatus (Failure, Success), itemExample, mapSpecItem_, resultStatus)
3331import qualified Valid
34−import Servant ( Server, Proxy(..), serve, Endpoints, HasServer )
35−
32+import Servant(Server,Proxy(..), serve)
3633import Servant.Client(ClientEnv, mkClientEnv, baseUrlPort, parseBaseUrl,HasClient,ClientM)
3734import Network.Wai(Application)
3835import qualified Network.Wai.Handler.Warp as Warp
3936import Network.HTTP.Client (newManager, defaultManagerSettings)
40−import Control.Monad((>=>))
37+import Servant(Endpoints,HasServer)
4138
4239main :: IO ()
4340main = hspec spec
4441
4542fuzzBoth
46− :: forall a .
43+ :: forall a .
4744 (R.ToReifiedApi (Endpoints a), HasServer a '[], RS.FlattenServer a, RC.ToReifiedClientApi (Endpoints a), RC.FlattenClient a,
4845 HasClient ClientM a)
4946 => String -> Server a -> R.Config -> (Maybe R.Report -> IO ()) -> Spec
5047fuzzBoth name server config condition = do
51− it (name <> " via server") $
48+ it (name <> " via server") $ do
5249 RS.fuzz @a server config >>= condition
5350
54− around (withServer (serve (Proxy :: Proxy a) server)) $
51+ around (withServer (serve (Proxy :: Proxy a) server)) $ do
5552 it (name <> " via client") $ \(clientEnv::ClientEnv) -> do
56− RC.fuzz @a clientEnv config >>= condition
53+ RC.fuzz @a clientEnv config >>= condition
5754
5855withServer :: Application -> ActionWith ClientEnv -> IO ()
59−withServer app action = Warp.testWithApplication (pure app) (genClientEnv >=> action)
56+withServer app action = Warp.testWithApplication (pure app) (\p -> genClientEnv p >>= action)
6057 where genClientEnv port = do
6158 baseUrl <- parseBaseUrl "http://localhost"
6259 manager <- newManager defaultManagerSettings
@@ -75,45 +72,37 @@ spec = do
7572 Just (R.InsufficientCoverage _) -> True
7673 _ -> False
7774 ))
78− describe "posted body" $
75+ describe "posted body" $ do
7976 fuzzBoth @Post.Api "passes a coverage check using a posted body" Post.server R.defaultConfig {R.coverageThreshold = 0.99}
80− (`shouldSatisfy` isNothing)
81−
82−
83− describe "PUTted body" $
84− fuzzBoth @Put.Api "passes a coverage check using a posted body" Put.server R.defaultConfig {R.coverageThreshold = 0.99}
85− (`shouldSatisfy` isNothing)
86−
87−
77+ (`shouldSatisfy` isNothing)
78+
8879 describe "seeded" $ do
8980 let res = Seeded.Seed 1
9081 shouldFail $ fuzzBoth @Seeded.Api "finds an error using information passed in" Seeded.server
9182 (R.defaultConfig {R.seed = [(toDyn res, hash res)]})
9283 (`shouldSatisfy` isNothing)
93−
94− describe "Foo" $
84+
85+ describe "Foo" $ do
9586 fuzzBoth @Foo.Api "finds an error in a basic app" Foo.server R.defaultConfig (`shouldSatisfy` serverFailure)
9687
97− describe "QueryParams" $
98− fuzzBoth @QueryParams.Api "can handle query params" QueryParams.server R.defaultConfig { R.seed = [R.hashedDyn (12::Int)] }
99− (`shouldSatisfy` isNothing)
100−
10188 describe "BuildFrom" $ do
102− describe "headers (and sum types)" $
89+ describe "headers (and sum types)" $ do
10390 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" $
106− 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)
91+ (`shouldSatisfy` serverFailure)
92+ describe "product types" $ do
93+ fuzzBoth @Product.Api "should find a failure that's dependent on creating a product" Product.server
94+ R.defaultConfig {R.seed = [R.hashedDyn 'a', R.hashedDyn (1 :: Int)]}
95+ (`shouldSatisfy` serverFailure)
10996 describe "Breakdown" $ do
11097 fuzzBoth @Breakdown.ProductApi "handles products" Breakdown.productServer R.defaultConfig
11198 (`shouldSatisfy` serverFailure)
11299 fuzzBoth @Breakdown.SumApi "handles sums" Breakdown.sumServer R.defaultConfig
113100 (`shouldSatisfy` serverFailure)
114− describe "flattening" $
101+ describe "flattening" $ do
102+ -- we don't actually do much here, this is just here to document the appropriate response
103+ -- if you get a type error with a nested api.
115104 fuzzBoth @Nested.FlatApi "can handle nested apis" Nested.server R.defaultConfig {R.coverageThreshold = 0.99}
116− (`shouldSatisfy` isNothing)
105+ (`shouldSatisfy` isNothing)
117106
118107serverFailure :: Maybe R.Report -> Bool
119108serverFailure = \case
@@ -137,12 +126,8 @@ deriving via (R.Atom Seeded.Seed) instance R.BuildFrom Seeded.Seed
137126deriving via (R.Atom Void) instance R.BuildFrom Void
138127
139128deriving via (R.Atom Post.FooPost) instance R.Breakdown Post.FooPost
140−deriving via (R.Atom Post.FooPost) instance R.BuildFrom Post.FooPost
141−
142−deriving via (R.Atom Put.Foo) instance R.Breakdown Put.Foo
143−deriving via (R.Atom Put.Foo) instance R.BuildFrom Put.Foo
144−
145129
130+deriving via (R.Atom Post.FooPost) instance R.BuildFrom Post.FooPost
146131
147132deriving via (R.Compound Breakdown.Foo) instance R.Breakdown Breakdown.Foo
148133
@@ -158,7 +143,7 @@ shouldFail =
158143 ( \i ->
159144 i
160145 { itemExample = \p a cb -> do
161− r <- itemExample i p a cb
146+ r <- (itemExample i) p a cb
162147 pure
163148 r
164149 { resultStatus = case resultStatus r of