@@ -36,6 +36,7 @@ import Data.Char (chr, isPrint)
36import Data.Foldable (forM_)
36import Data.Foldable (forM_)
37import Data.Monoid hiding (getLast)
37import Data.Monoid hiding (getLast)
38import Data.Proxy
38import Data.Proxy
39+import qualified Generics.SOP as SOP
39import GHC.Generics (Generic)
40import GHC.Generics (Generic)
40import qualified Network.HTTP.Client as C
41import qualified Network.HTTP.Client as C
41import Network.HTTP.Media
42import Network.HTTP.Media
@@ -55,6 +56,7 @@ import Web.FormUrlEncoded (FromForm, ToForm)
55import Servant.API
56import Servant.API
56import Servant.API.Internal.Test.ComprehensiveAPI
57import Servant.API.Internal.Test.ComprehensiveAPI
57import Servant.Client
58import Servant.Client
59+import Servant.Client.Generic
58import qualified Servant.Common.Req as SCR
60import qualified Servant.Common.Req as SCR
59import Servant.Server
61import Servant.Server
60import Servant.Server.Experimental.Auth
62import Servant.Server.Experimental.Auth
@@ -69,6 +71,7 @@ spec = describe "Servant.Client" $ do
69 wrappedApiSpec
71 wrappedApiSpec
70 basicAuthSpec
72 basicAuthSpec
71 genAuthSpec
73 genAuthSpec
73-- * test data types
76-- * test data types
@@ -222,6 +225,53 @@ genAuthServerContext = genAuthHandler :. EmptyContext
222genAuthServer :: Application
225genAuthServer :: Application
223genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
226genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
228+-- * generic client stuff
230+type GenericClientAPI
231+ = QueryParam "sqr" Int :> Get '[JSON] Int
232+ :<|> Capture "foo" String :> NestedAPI1
234+data GenericClient = GenericClient
235+ { getSqr :: Maybe Int -> SCR.ClientM Int
236+ , mkNestedClient1 :: String -> NestedClient1
238+instance SOP.Generic GenericClient
239+instance (Client GenericClientAPI ~ client) => ClientLike client GenericClient
242+ = QueryParam "int" Int :> NestedAPI2
243+ :<|> QueryParam "id" Char :> Get '[JSON] Char
245+data NestedClient1 = NestedClient1
246+ { mkNestedClient2 :: Maybe Int -> NestedClient2
247+ , idChar :: Maybe Char -> SCR.ClientM Char
249+instance SOP.Generic NestedClient1
250+instance (Client NestedAPI1 ~ client) => ClientLike client NestedClient1
253+ = "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
254+ :<|> "void" :> Post '[JSON] ()
256+data NestedClient2 = NestedClient2
257+ { getSum :: Int -> Int -> SCR.ClientM Int
258+ , doNothing :: SCR.ClientM ()
260+instance SOP.Generic NestedClient2
261+instance (Client NestedAPI2 ~ client) => ClientLike client NestedClient2
263+genericClientServer :: Application
264+genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
266+ Just x -> return (x*x)
267+ Nothing -> throwE $ ServantErr 400 "missing parameter" "" []
272+ nestedServer1 _str = nestedServer2 :<|> (maybe (throwE $ ServantErr 400 "missing parameter" "" []) return)
273+ nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
225{-# NOINLINE manager #-}
275{-# NOINLINE manager #-}
226manager :: C.Manager
276manager :: C.Manager
227manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
277manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
@@ -392,6 +442,22 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
392 Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)
442 Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)
393 responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
443 responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
445+genericClientSpec :: Spec
446+genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
447+ describe "Servant.Client.Generic" $ do
449+ let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))
450+ NestedClient1{..} = mkNestedClient1 "example"
451+ NestedClient2{..} = mkNestedClient2 (Just 42)
453+ it "works for top-level client function" $ \(_, baseUrl) -> do
454+ (left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25
456+ it "works for nested clients" $ \(_, baseUrl) -> do
457+ (left show <$> (runClientM (idChar (Just 'c')) (ClientEnv manager baseUrl))) `shouldReturn` Right 'c'
458+ (left show <$> (runClientM (getSum 3 4) (ClientEnv manager baseUrl))) `shouldReturn` Right 7
459+ (left show <$> (runClientM doNothing (ClientEnv manager baseUrl))) `shouldReturn` Right ()
395-- * utils
461-- * utils
397startWaiApp :: Application -> IO (ThreadId, BaseUrl)
463startWaiApp :: Application -> IO (ThreadId, BaseUrl)