git.iko.soy/typeable/servant
on cdbe95b help sign in
typeable/servant/test/Servant/ClientSpec.hs
256 lines 9.0 kB history raw
1{-# LANGUAGE GADTs #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE ViewPatterns #-}
4{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE OverloadedStrings #-}
7{-# OPTIONS_GHC -fcontext-stack=25 #-}
8module Servant.ClientSpec where
10import Control.Concurrent
11import Control.Exception
12import Control.Monad.Trans.Either
13import Data.Aeson
14import Data.ByteString.Lazy (ByteString)
15import Data.Char
16import Data.Foldable (forM_)
17import Data.Proxy
18import Data.Typeable
19import GHC.Generics
20import Network.HTTP.Types
21import Network.Socket
22import Network.Wai
23import Network.Wai.Handler.Warp
24import Test.Hspec
25import Test.Hspec.QuickCheck
26import Test.QuickCheck
28import Servant.API
29import Servant.Client
30import Servant.Server
32-- * test data types
34data Person = Person {
35 name :: String,
36 age :: Integer
37 }
38 deriving (Eq, Show, Generic)
40instance ToJSON Person
41instance FromJSON Person
43alice :: Person
44alice = Person "Alice" 42
46type Api =
47 "get" :> Get Person
48 :<|> "delete" :> Delete
49 :<|> "capture" :> Capture "name" String :> Get Person
50 :<|> "body" :> ReqBody Person :> Post Person
51 :<|> "param" :> QueryParam "name" String :> Get Person
52 :<|> "params" :> QueryParams "names" String :> Get [Person]
53 :<|> "flag" :> QueryFlag "flag" :> Get Bool
54 :<|> "matrixparam" :> MatrixParam "name" String :> Get Person
55 :<|> "matrixparams" :> MatrixParams "name" String :> Get [Person]
56 :<|> "matrixflag" :> MatrixFlag "flag" :> Get Bool
57 :<|> "rawSuccess" :> Raw
58 :<|> "rawFailure" :> Raw
59 :<|> "multiple" :>
60 Capture "first" String :>
61 QueryParam "second" Int :>
62 QueryFlag "third" :>
63 ReqBody [(String, [Rational])] :>
64 Get (String, Maybe Int, Bool, [(String, [Rational])])
65api :: Proxy Api
66api = Proxy
68server :: Application
69server = serve api (
70 return alice
71 :<|> return ()
72 :<|> (\ name -> return $ Person name 0)
73 :<|> return
74 :<|> (\ name -> case name of
75 Just "alice" -> return alice
76 Just name -> left (400, name ++ " not found")
77 Nothing -> left (400, "missing parameter"))
78 :<|> (\ names -> return (zipWith Person names [0..]))
79 :<|> return
80 :<|> (\ name -> case name of
81 Just "alice" -> return alice
82 Just name -> left (400, name ++ " not found")
83 Nothing -> left (400, "missing parameter"))
84 :<|> (\ names -> return (zipWith Person names [0..]))
85 :<|> return
86 :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
87 :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
88 :<|> \ a b c d -> return (a, b, c, d)
89 )
91withServer :: (BaseUrl -> IO a) -> IO a
92withServer action = withWaiDaemon (return server) action
94getGet :: BaseUrl -> EitherT String IO Person
95getDelete :: BaseUrl -> EitherT String IO ()
96getCapture :: String -> BaseUrl -> EitherT String IO Person
97getBody :: Person -> BaseUrl -> EitherT String IO Person
98getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
99getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
100getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
101getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
102getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
103getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
104getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)
105getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)
106getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
107 -> BaseUrl
108 -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
109( getGet
110 :<|> getDelete
111 :<|> getCapture
112 :<|> getBody
113 :<|> getQueryParam
114 :<|> getQueryParams
115 :<|> getQueryFlag
116 :<|> getMatrixParam
117 :<|> getMatrixParams
118 :<|> getMatrixFlag
119 :<|> getRawSuccess
120 :<|> getRawFailure
121 :<|> getMultiple)
122 = client api
124spec :: Spec
125spec = do
126 it "Servant.API.Get" $ withServer $ \ host -> do
127 runEitherT (getGet host) `shouldReturn` Right alice
129 it "Servant.API.Delete" $ withServer $ \ host -> do
130 runEitherT (getDelete host) `shouldReturn` Right ()
132 it "Servant.API.Capture" $ withServer $ \ host -> do
133 runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0)
135 it "Servant.API.ReqBody" $ withServer $ \ host -> do
136 let p = Person "Clara" 42
137 runEitherT (getBody p host) `shouldReturn` Right p
139 it "Servant.API.QueryParam" $ withServer $ \ host -> do
140 runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
141 Left result <- runEitherT (getQueryParam (Just "bob") host)
142 result `shouldContain` "bob not found"
144 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
145 runEitherT (getQueryParams [] host) `shouldReturn` Right []
146 runEitherT (getQueryParams ["alice", "bob"] host)
147 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
149 context "Servant.API.QueryParam.QueryFlag" $
150 forM_ [False, True] $ \ flag ->
151 it (show flag) $ withServer $ \ host -> do
152 runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
154 it "Servant.API.MatrixParam" $ withServer $ \ host -> do
155 runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice
156 Left result <- runEitherT (getMatrixParam (Just "bob") host)
157 result `shouldContain` "bob not found"
159 it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do
160 runEitherT (getMatrixParams [] host) `shouldReturn` Right []
161 runEitherT (getMatrixParams ["alice", "bob"] host)
162 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
164 context "Servant.API.MatrixParam.MatrixFlag" $
165 forM_ [False, True] $ \ flag ->
166 it (show flag) $ withServer $ \ host -> do
167 runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
169 it "Servant.API.Raw on success" $ withServer $ \ host -> do
170 runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess")
172 it "Servant.API.Raw on failure" $ withServer $ \ host -> do
173 runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure")
175 modifyMaxSuccess (const 20) $ do
176 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
177 property $ forAllShrink pathGen shrink $ \ a -> \ b c d ->
178 ioProperty $ do
179 withServer $ \ host -> do
180 result <- runEitherT (getMultiple a b c d host)
181 return $
182 result === Right (a, b, c, d)
185 context "client correctly handles error status codes" $ do
186 let test :: WrappedApi -> Spec
187 test (WrappedApi api) =
188 it (show (typeOf api)) $
189 withWaiDaemon (return (serve api (left (500, "error message")))) $
190 \ host -> do
191 let getResponse :: BaseUrl -> EitherT String IO ()
192 getResponse = client api
193 Left result <- runEitherT (getResponse host)
194 result `shouldContain` "error message"
195 mapM_ test $
196 (WrappedApi (Proxy :: Proxy Delete)) :
197 (WrappedApi (Proxy :: Proxy (Get ()))) :
198 (WrappedApi (Proxy :: Proxy (Post ()))) :
199 (WrappedApi (Proxy :: Proxy (Put ()))) :
200 []
202data WrappedApi where
203 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
204 HasClient api, Client api ~ (BaseUrl -> EitherT String IO ()),
205 Typeable api) =>
206 Proxy api -> WrappedApi
209-- * utils
211withWaiDaemon :: IO Application -> (BaseUrl -> IO a) -> IO a
212withWaiDaemon mkApplication action = do
213 application <- mkApplication
214 bracket (acquire application) free (\ (_, _, baseUrl) -> action baseUrl)
215 where
216 acquire application = do
217 (notifyStart, waitForStart) <- lvar
218 (notifyKilled, waitForKilled) <- lvar
219 thread <- forkIO $ (do
220 (krakenPort, socket) <- openTestSocket
221 let settings =
222 setPort krakenPort $ -- set here just for consistency, shouldn't be
223 -- used (it's set in the socket)
224 setBeforeMainLoop (notifyStart krakenPort)
225 defaultSettings
226 runSettingsSocket settings socket application)
227 `finally` notifyKilled ()
228 krakenPort <- waitForStart
229 let baseUrl = (BaseUrl Http "localhost" 80){baseUrlPort = krakenPort}
230 return (thread, waitForKilled, baseUrl)
231 free (thread, waitForKilled, _) = do
232 killThread thread
233 waitForKilled
235 lvar :: IO (a -> IO (), IO a)
236 lvar = do
237 mvar <- newEmptyMVar
238 let put = putMVar mvar
239 wait = readMVar mvar
240 return (put, wait)
242openTestSocket :: IO (Port, Socket)
243openTestSocket = do
244 s <- socket AF_INET Stream defaultProtocol
245 localhost <- inet_addr "127.0.0.1"
246 bind s (SockAddrInet aNY_PORT localhost)
247 listen s 1
248 port <- socketPort s
249 return (fromIntegral port, s)
251pathGen :: Gen String
252pathGen = listOf $ elements $
253 filter (not . (`elem` "?%[]/#")) $
254 filter isPrint $
255 map chr [0..127]