git.iko.soy/servant
on c8def82 help sign in
servant/test/Servant/ClientSpec.hs
187 lines 6.3 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE TypeOperators #-}
3{-# LANGUAGE GADTs #-}
4{-# LANGUAGE ViewPatterns #-}
6module Servant.ClientSpec where
8import Control.Concurrent
9import Control.Exception
10import Control.Monad.Trans.Either
11import Data.Char
12import Data.Foldable (forM_)
13import Data.Proxy
14import Data.Typeable
15import Network.Socket
16import Network.Wai
17import Network.Wai.Handler.Warp
18import Test.Hspec
19import Test.Hspec.QuickCheck
20import Test.QuickCheck
22import Servant.API
23import Servant.Client
24import Servant.Server
25import Servant.Common.BaseUrl
27import Servant.ServerSpec
29type Api =
30 "get" :> Get Person
31 :<|> "capture" :> Capture "name" String :> Get Person
32 :<|> "body" :> ReqBody Person :> Post Person
33 :<|> "param" :> QueryParam "name" String :> Get Person
34 :<|> "params" :> QueryParams "names" String :> Get [Person]
35 :<|> "flag" :> QueryFlag "flag" :> Get Bool
36 :<|> "multiple" :>
37 Capture "first" String :>
38 QueryParam "second" Int :>
39 QueryFlag "third" :>
40 ReqBody [(String, [Rational])] :>
41 Get (String, Maybe Int, Bool, [(String, [Rational])])
42api :: Proxy Api
43api = Proxy
45server :: Application
46server = serve api (
47 return alice
48 :<|> (\ name -> return $ Person name 0)
49 :<|> return
50 :<|> (\ name -> case name of
51 Just "alice" -> return alice
52 Just name -> left (400, name ++ " not found")
53 Nothing -> left (400, "missing parameter"))
54 :<|> (\ names -> return (zipWith Person names [0..]))
55 :<|> return
56 :<|> \ a b c d -> return (a, b, c, d)
57 )
59withServer :: (BaseUrl -> IO a) -> IO a
60withServer action = withWaiDaemon (return server) action
62getGet :: BaseUrl -> EitherT String IO Person
63getCapture :: String -> BaseUrl -> EitherT String IO Person
64getBody :: Person -> BaseUrl -> EitherT String IO Person
65getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
66getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
67getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
68getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
69 -> BaseUrl
70 -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
71( getGet
72 :<|> getCapture
73 :<|> getBody
74 :<|> getQueryParam
75 :<|> getQueryParams
76 :<|> getQueryFlag
77 :<|> getMultiple)
78 = client api
80spec :: Spec
81spec = do
82 it "Servant.API.Get" $ withServer $ \ host -> do
83 runEitherT (getGet host) `shouldReturn` Right alice
85 it "Servant.API.Capture" $ withServer $ \ host -> do
86 runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0)
88 it "Servant.API.ReqBody" $ withServer $ \ host -> do
89 let p = Person "Clara" 42
90 runEitherT (getBody p host) `shouldReturn` Right p
92 it "Servant.API.QueryParam" $ withServer $ \ host -> do
93 runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
94 Left result <- runEitherT (getQueryParam (Just "bob") host)
95 result `shouldContain` "bob not found"
97 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
98 runEitherT (getQueryParams [] host) `shouldReturn` Right []
99 runEitherT (getQueryParams ["alice", "bob"] host)
100 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
102 context "Servant.API.QueryParam.QueryFlag" $
103 forM_ [False, True] $ \ flag ->
104 it (show flag) $ withServer $ \ host -> do
105 runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
107 modifyMaxSuccess (const 20) $ do
108 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
109 property $ forAllShrink pathGen shrink $ \ a -> \ b c d ->
110 ioProperty $ do
111 withServer $ \ host -> do
112 result <- runEitherT (getMultiple a b c d host)
113 return $
114 result === Right (a, b, c, d)
117 context "client correctly handles error status codes" $ do
118 let test :: WrappedApi -> Spec
119 test (WrappedApi api) =
120 it (show (typeOf api)) $
121 withWaiDaemon (return (serve api (left (500, "error message")))) $
122 \ host -> do
123 let getResponse :: BaseUrl -> EitherT String IO ()
124 getResponse = client api
125 Left result <- runEitherT (getResponse host)
126 result `shouldContain` "error message"
127 mapM_ test $
128 (WrappedApi (Proxy :: Proxy Delete)) :
129 (WrappedApi (Proxy :: Proxy (Get ()))) :
130 (WrappedApi (Proxy :: Proxy (Post ()))) :
131 (WrappedApi (Proxy :: Proxy (Put ()))) :
132 []
134data WrappedApi where
135 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
136 HasClient api, Client api ~ (BaseUrl -> EitherT String IO ()),
137 Typeable api) =>
138 Proxy api -> WrappedApi
141-- * utils
143withWaiDaemon :: IO Application -> (BaseUrl -> IO a) -> IO a
144withWaiDaemon mkApplication action = do
145 application <- mkApplication
146 bracket (acquire application) free (\ (_, _, baseUrl) -> action baseUrl)
147 where
148 acquire application = do
149 (notifyStart, waitForStart) <- lvar
150 (notifyKilled, waitForKilled) <- lvar
151 thread <- forkIO $ (do
152 (krakenPort, socket) <- openTestSocket
153 let settings =
154 setPort krakenPort $ -- set here just for consistency, shouldn't be
155 -- used (it's set in the socket)
156 setBeforeMainLoop (notifyStart krakenPort)
157 defaultSettings
158 runSettingsSocket settings socket application)
159 `finally` notifyKilled ()
160 krakenPort <- waitForStart
161 let baseUrl = (BaseUrl Http "localhost" 80){baseUrlPort = krakenPort}
162 return (thread, waitForKilled, baseUrl)
163 free (thread, waitForKilled, _) = do
164 killThread thread
165 waitForKilled
167 lvar :: IO (a -> IO (), IO a)
168 lvar = do
169 mvar <- newEmptyMVar
170 let put = putMVar mvar
171 wait = readMVar mvar
172 return (put, wait)
174openTestSocket :: IO (Port, Socket)
175openTestSocket = do
176 s <- socket AF_INET Stream defaultProtocol
177 localhost <- inet_addr "127.0.0.1"
178 bind s (SockAddrInet aNY_PORT localhost)
179 listen s 1
180 port <- socketPort s
181 return (fromIntegral port, s)
183pathGen :: Gen String
184pathGen = listOf $ elements $
185 filter (not . (`elem` "?%[]/#")) $
186 filter isPrint $
187 map chr [0..127]