git.iko.soy/servant
on 0802221 help sign in
servant/test/Servant/ClientSpec.hs
133 lines 4.4 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.Proxy
12import Data.Typeable
13import Network.Socket
14import Network.URI
15import Network.Wai
16import Network.Wai.Handler.Warp
17import Test.Hspec
19import Servant.API
20import Servant.Client
21import Servant.Server
23import Servant.ServerSpec
25type Api =
26 "get" :> Get Person
27 :<|> "capture" :> Capture "name" String :> Get Person
28 :<|> "body" :> ReqBody Person :> Post Person
29 :<|> "param" :> QueryParam "name" String :> Get Person
30api :: Proxy Api
31api = Proxy
33server :: Application
34server = serve api (
35 return alice
36 :<|> (\ name -> return $ Person name 0)
37 :<|> return
38 :<|> (\ name -> case name of
39 Just "alice" -> return alice
40 Just name -> left (400, name ++ " not found")
41 Nothing -> left (400, "missing parameter"))
42 )
44withServer :: (URIAuth -> IO a) -> IO a
45withServer action = withWaiDaemon (return server) (action . mkHost "localhost")
47getGet :: URIAuth -> EitherT String IO Person
48getCapture :: String -> URIAuth -> EitherT String IO Person
49getBody :: Person -> URIAuth -> EitherT String IO Person
50getQueryParam :: Maybe String -> URIAuth -> EitherT String IO Person
51(getGet :<|> getCapture :<|> getBody :<|> getQueryParam) = client api
53spec :: Spec
54spec = do
55 it "Servant.API.Get" $ withServer $ \ host -> do
56 runEitherT (getGet host) `shouldReturn` Right alice
58 it "Servant.API.Capture" $ withServer $ \ host -> do
59 runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0)
61 it "Servant.API.ReqBody" $ withServer $ \ host -> do
62 let p = Person "Clara" 42
63 runEitherT (getBody p host) `shouldReturn` Right p
65 it "Servant.API.QueryParam" $ withServer $ \ host -> do
66 runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
67 Left result <- runEitherT (getQueryParam (Just "bob") host)
68 result `shouldContain` "bob not found"
70 context "client correctly handles error status codes" $ do
71 let test :: WrappedApi -> Spec
72 test (WrappedApi api) =
73 it (show (typeOf api)) $
74 withWaiDaemon (return (serve api (left (500, "error message")))) $
75 \ (mkHost "localhost" -> host) -> do
76 let getResponse :: URIAuth -> EitherT String IO ()
77 getResponse = client api
78 Left result <- runEitherT (getResponse host)
79 result `shouldContain` "error message"
80 mapM_ test $
81 (WrappedApi (Proxy :: Proxy Delete)) :
82 (WrappedApi (Proxy :: Proxy (Get ()))) :
83 (WrappedApi (Proxy :: Proxy (Post ()))) :
84 (WrappedApi (Proxy :: Proxy (Put ()))) :
85 []
87data WrappedApi where
88 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
89 HasClient api, Client api ~ (URIAuth -> EitherT String IO ()),
90 Typeable api) =>
91 Proxy api -> WrappedApi
94-- * utils
96withWaiDaemon :: IO Application -> (Port -> IO a) -> IO a
97withWaiDaemon mkApplication action = do
98 application <- mkApplication
99 bracket (acquire application) free (\ (_, _, port) -> action port)
100 where
101 acquire application = do
102 (notifyStart, waitForStart) <- lvar
103 (notifyKilled, waitForKilled) <- lvar
104 thread <- forkIO $ (do
105 (krakenPort, socket) <- openTestSocket
106 let settings =
107 setPort krakenPort $ -- set here just for consistency, shouldn't be
108 -- used (it's set in the socket)
109 setBeforeMainLoop (notifyStart krakenPort)
110 defaultSettings
111 runSettingsSocket settings socket application)
112 `finally` notifyKilled ()
113 krakenPort <- waitForStart
114 return (thread, waitForKilled, krakenPort)
115 free (thread, waitForKilled, _) = do
116 killThread thread
117 waitForKilled
119 lvar :: IO (a -> IO (), IO a)
120 lvar = do
121 mvar <- newEmptyMVar
122 let put = putMVar mvar
123 wait = readMVar mvar
124 return (put, wait)
126openTestSocket :: IO (Port, Socket)
127openTestSocket = do
128 s <- socket AF_INET Stream defaultProtocol
129 localhost <- inet_addr "127.0.0.1"
130 bind s (SockAddrInet aNY_PORT localhost)
131 listen s 1
132 port <- socketPort s
133 return (fromIntegral port, s)