@@ -30,17 +30,16 @@ import Control.Concurrent (forkIO, killThread, ThreadId)
3030import Control.Exception (bracket)
3131import Control.Monad.Trans.Except (ExceptT, throwE)
3232import Data.Aeson
33+import qualified Data.ByteString.Lazy as BS
3334import Data.Char (chr, isPrint)
3435import Data.Foldable (forM_)
3536import Data.Monoid hiding (getLast)
3637import Data.Proxy
3738import qualified Data.Text as T
3839import GHC.Generics (Generic)
39−import GHC.TypeLits
4040import qualified Network.HTTP.Client as C
4141import Network.HTTP.Media
42−import Network.HTTP.Types (Status (..), badRequest400,
43− methodGet, ok200, status400)
42+import qualified Network.HTTP.Types as HTTP
4443import Network.Socket
4544import Network.Wai (Application, Request,
4645 requestHeaders, responseLBS)
@@ -120,6 +119,53 @@ type Api =
120119api :: Proxy Api
121120api = Proxy
122121
122+getGet :: SCR.ClientM Person
123+getDeleteEmpty :: SCR.ClientM NoContent
124+getCapture :: String
125+ -> SCR.ClientM Person
126+getBody :: Person
127+ -> SCR.ClientM Person
128+getQueryParam :: Maybe String
129+ -> SCR.ClientM Person
130+getQueryParams :: [String]
131+ -> SCR.ClientM [Person]
132+getQueryFlag :: Bool
133+ -> SCR.ClientM Bool
134+getRawSuccess :: HTTP.Method
135+ -> SCR.ClientM ( Int
136+ , BS.ByteString
137+ , MediaType
138+ , [HTTP.Header]
139+ , C.Response BS.ByteString )
140+getRawFailure :: HTTP.Method
141+ -> SCR.ClientM ( Int
142+ , BS.ByteString
143+ , MediaType
144+ , [HTTP.Header]
145+ , C.Response BS.ByteString )
146+getMultiple :: String
147+ -> Maybe Int
148+ -> Bool
149+ -> [(String, [Rational])]
150+ -> SCR.ClientM ( String
151+ , Maybe Int
152+ , Bool
153+ , [(String, [Rational])] )
154+getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)
155+getDeleteContentType :: SCR.ClientM NoContent
156+getGet
157+ :<|> getDeleteEmpty
158+ :<|> getCapture
159+ :<|> getBody
160+ :<|> getQueryParam
161+ :<|> getQueryParams
162+ :<|> getQueryFlag
163+ :<|> getRawSuccess
164+ :<|> getRawFailure
165+ :<|> getMultiple
166+ :<|> getRespHeaders
167+ :<|> getDeleteContentType = client api
168+
123169server :: Application
124170server = serve api (
125171 return alice
@@ -132,8 +178,8 @@ server = serve api (
132178 Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
133179 :<|> (\ names -> return (zipWith Person names [0..]))
134180 :<|> return
135− :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
136− :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
181+ :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
182+ :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")
137183 :<|> (\ a b c d -> return (a, b, c, d))
138184 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
139185 :<|> return NoContent
@@ -149,9 +195,9 @@ failApi = Proxy
149195
150196failServer :: Application
151197failServer = serve failApi (
152− (\ _request respond -> respond $ responseLBS ok200 [] "")
153− :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
154− :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
198+ (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
199+ :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")
200+ :<|> (\_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
155201 )
156202
157203-- * basic auth stuff
@@ -208,66 +254,54 @@ sucessSpec :: Spec
208254sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
209255
210256 it "Servant.API.Get" $ \(_, baseUrl) -> do
211− let getGet = getNth (Proxy :: Proxy 0) $ client api
212257 (left show <$> SCR.runClientM getGet baseUrl manager) `shouldReturn` Right alice
213258
214259 describe "Servant.API.Delete" $ do
215260 it "allows empty content type" $ \(_, baseUrl) -> do
216− let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api
217261 (left show <$> SCR.runClientM getDeleteEmpty baseUrl manager) `shouldReturn` Right NoContent
218262
219263 it "allows content type" $ \(_, baseUrl) -> do
220− let getDeleteContentType :: SCR.ClientM NoContent
221− getDeleteContentType = getLast $ client api
222264 (left show <$> SCR.runClientM getDeleteContentType baseUrl manager) `shouldReturn` Right NoContent
223265
224266 it "Servant.API.Capture" $ \(_, baseUrl) -> do
225− let getCapture = getNth (Proxy :: Proxy 2) $ client api
226267 (left show <$> SCR.runClientM (getCapture "Paula") baseUrl manager) `shouldReturn` Right (Person "Paula" 0)
227268
228269 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
229270 let p = Person "Clara" 42
230− getBody = getNth (Proxy :: Proxy 3) $ client api
231271 (left show <$> SCR.runClientM (getBody p) baseUrl manager) `shouldReturn` Right p
232272
233273 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
234− let getQueryParam = getNth (Proxy :: Proxy 4) $ client api
235274 left show <$> SCR.runClientM (getQueryParam (Just "alice")) baseUrl manager `shouldReturn` Right alice
236275 Left FailureResponse{..} <- SCR.runClientM (getQueryParam (Just "bob")) baseUrl manager
237− responseStatus `shouldBe` Status 400 "bob not found"
276+ responseStatus `shouldBe` HTTP.Status 400 "bob not found"
238277
239278 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
240− let getQueryParams = getNth (Proxy :: Proxy 5) $ client api
241279 (left show <$> SCR.runClientM (getQueryParams []) baseUrl manager) `shouldReturn` Right []
242280 (left show <$> SCR.runClientM (getQueryParams ["alice", "bob"]) baseUrl manager)
243281 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
244282
245283 context "Servant.API.QueryParam.QueryFlag" $
246284 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
247− let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api
248285 (left show <$> SCR.runClientM (getQueryFlag flag) baseUrl manager) `shouldReturn` Right flag
249286
250287 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
251− let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api
252− res <- SCR.runClientM (getRawSuccess methodGet) baseUrl manager
288+ res <- SCR.runClientM (getRawSuccess HTTP.methodGet) baseUrl manager
253289 case res of
254290 Left e -> assertFailure $ show e
255291 Right (code, body, ct, _, response) -> do
256292 (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
257293 C.responseBody response `shouldBe` body
258− C.responseStatus response `shouldBe` ok200
294+ C.responseStatus response `shouldBe` HTTP.ok200
259295
260296 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
261− let getRawFailure = getNth (Proxy :: Proxy 8) $ client api
262− res <- SCR.runClientM (getRawFailure methodGet) baseUrl manager
297+ res <- SCR.runClientM (getRawFailure HTTP.methodGet) baseUrl manager
263298 case res of
264299 Right _ -> assertFailure "expected Left, but got Right"
265300 Left e -> do
266− Servant.Client.responseStatus e `shouldBe` status400
301+ Servant.Client.responseStatus e `shouldBe` HTTP.status400
267302 Servant.Client.responseBody e `shouldBe` "rawFailure"
268303
269304 it "Returns headers appropriately" $ \(_, baseUrl) -> do
270− let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api
271305 res <- SCR.runClientM getRespHeaders baseUrl manager
272306 case res of
273307 Left e -> assertFailure $ show e
@@ -275,8 +309,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
275309
276310 modifyMaxSuccess (const 20) $ do
277311 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
278− let getMultiple = getNth (Proxy :: Proxy 9) $ client api
279− in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
312+ property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
280313 ioProperty $ do
281314 result <- left show <$> SCR.runClientM (getMultiple cap num flag body) baseUrl manager
282315 return $
@@ -293,7 +326,7 @@ wrappedApiSpec = describe "error status codes" $ do
293326 let getResponse :: SCR.ClientM ()
294327 getResponse = client api
295328 Left FailureResponse{..} <- SCR.runClientM getResponse baseUrl manager
296− responseStatus `shouldBe` (Status 500 "error message")
329+ responseStatus `shouldBe` (HTTP.Status 500 "error message")
297330 in mapM_ test $
298331 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
299332 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
@@ -309,7 +342,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
309342 let (_ :<|> getDeleteEmpty :<|> _) = client api
310343 Left res <- SCR.runClientM getDeleteEmpty baseUrl manager
311344 case res of
312− FailureResponse (Status 404 "Not Found") _ _ -> return ()
345+ FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
313346 _ -> fail $ "expected 404 response, but got " <> show res
314347
315348 it "reports DecodeFailure" $ \(_, baseUrl) -> do
@@ -360,7 +393,7 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
360393 let getBasic = client basicAuthAPI
361394 let basicAuthData = BasicAuthData "not" "password"
362395 Left FailureResponse{..} <- SCR.runClientM (getBasic basicAuthData) baseUrl manager
363− responseStatus `shouldBe` Status 403 "Forbidden"
396+ responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
364397
365398genAuthSpec :: Spec
366399genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
@@ -377,7 +410,7 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
377410 let getProtected = client genAuthAPI
378411 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
379412 Left FailureResponse{..} <- SCR.runClientM (getProtected authRequest) baseUrl manager
380− responseStatus `shouldBe` (Status 401 "Unauthorized")
413+ responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
381414
382415-- * utils
383416
@@ -408,25 +441,3 @@ pathGen = fmap NonEmpty path
408441 filter (not . (`elem` ("?%[]/#;" :: String))) $
409442 filter isPrint $
410443 map chr [0..127]
411−
412−class GetNth (n :: Nat) a b | n a -> b where
413− getNth :: Proxy n -> a -> b
414−
415−instance OVERLAPPING_
416− GetNth 0 (x :<|> y) x where
417− getNth _ (x :<|> _) = x
418−
419−instance OVERLAPPING_
420− (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
421− getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x
422−
423−class GetLast a b | a -> b where
424− getLast :: a -> b
425−
426−instance OVERLAPPING_
427− (GetLast b c) => GetLast (a :<|> b) c where
428− getLast (_ :<|> b) = getLast b
429−
430−instance OVERLAPPING_
431− GetLast a a where
432− getLast a = a