on master help sign in
Add tests for Servant.Client.Generic
commit3cc667892c28752dfe94f42053404ec53dc235a3 authorCatherine Galkina <catherine@getshoptv.com> dateMon 21 Nov 2016, 14:27 (10 years ago) parent31e1ceb
2 files changed+67
servant-client/servant-client.cabal+1 servant-client/test/Servant/ClientSpec.hs+66
servant-client/servant-client.cabal+1
@@ -98,3 +98,4 @@ test-suite spec
9898 , transformers-compat
9999 , wai
100100 , warp
101+ , generics-sop
servant-client/test/Servant/ClientSpec.hs+66
@@ -36,6 +36,7 @@ import Data.Char (chr, isPrint)
3636import Data.Foldable (forM_)
3737import Data.Monoid hiding (getLast)
3838import Data.Proxy
39+import qualified Generics.SOP as SOP
3940import GHC.Generics (Generic)
4041import qualified Network.HTTP.Client as C
4142import Network.HTTP.Media
@@ -55,6 +56,7 @@ import Web.FormUrlEncoded (FromForm, ToForm)
5556import Servant.API
5657import Servant.API.Internal.Test.ComprehensiveAPI
5758import Servant.Client
59+import Servant.Client.Generic
5860import qualified Servant.Common.Req as SCR
5961import Servant.Server
6062import Servant.Server.Experimental.Auth
@@ -69,6 +71,7 @@ spec = describe "Servant.Client" $ do
6971 wrappedApiSpec
7072 basicAuthSpec
7173 genAuthSpec
74+ genericClientSpec
7275
7376-- * test data types
7477
@@ -222,6 +225,53 @@ genAuthServerContext = genAuthHandler :. EmptyContext
222225genAuthServer :: Application
223226genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
224227
228+-- * generic client stuff
229+
230+type GenericClientAPI
231+ = QueryParam "sqr" Int :> Get '[JSON] Int
232+ :<|> Capture "foo" String :> NestedAPI1
233+
234+data GenericClient = GenericClient
235+ { getSqr :: Maybe Int -> SCR.ClientM Int
236+ , mkNestedClient1 :: String -> NestedClient1
237+ } deriving Generic
238+instance SOP.Generic GenericClient
239+instance (Client GenericClientAPI ~ client) => ClientLike client GenericClient
240+
241+type NestedAPI1
242+ = QueryParam "int" Int :> NestedAPI2
243+ :<|> QueryParam "id" Char :> Get '[JSON] Char
244+
245+data NestedClient1 = NestedClient1
246+ { mkNestedClient2 :: Maybe Int -> NestedClient2
247+ , idChar :: Maybe Char -> SCR.ClientM Char
248+ } deriving Generic
249+instance SOP.Generic NestedClient1
250+instance (Client NestedAPI1 ~ client) => ClientLike client NestedClient1
251+
252+type NestedAPI2
253+ = "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
254+ :<|> "void" :> Post '[JSON] ()
255+
256+data NestedClient2 = NestedClient2
257+ { getSum :: Int -> Int -> SCR.ClientM Int
258+ , doNothing :: SCR.ClientM ()
259+ } deriving Generic
260+instance SOP.Generic NestedClient2
261+instance (Client NestedAPI2 ~ client) => ClientLike client NestedClient2
262+
263+genericClientServer :: Application
264+genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
265+ (\ mx -> case mx of
266+ Just x -> return (x*x)
267+ Nothing -> throwE $ ServantErr 400 "missing parameter" "" []
268+ )
269+ :<|> nestedServer1
270+ )
271+ where
272+ nestedServer1 _str = nestedServer2 :<|> (maybe (throwE $ ServantErr 400 "missing parameter" "" []) return)
273+ nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
274+
225275{-# NOINLINE manager #-}
226276manager :: C.Manager
227277manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
@@ -392,6 +442,22 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
392442 Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)
393443 responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
394444
445+genericClientSpec :: Spec
446+genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
447+ describe "Servant.Client.Generic" $ do
448+
449+ let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))
450+ NestedClient1{..} = mkNestedClient1 "example"
451+ NestedClient2{..} = mkNestedClient2 (Just 42)
452+
453+ it "works for top-level client function" $ \(_, baseUrl) -> do
454+ (left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25
455+
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 ()
460+
395461-- * utils
396462
397463startWaiApp :: Application -> IO (ThreadId, BaseUrl)