client test suite: testing ReqBody

This commit is contained in:
Sönke Hahn 2014-10-30 13:08:41 +00:00
parent 14e6a49912
commit a0c675f603

View file

@ -13,8 +13,8 @@ import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Test.Hspec import Test.Hspec
import Servant.Client
import Servant.API import Servant.API
import Servant.Client
import Servant.Server import Servant.Server
import Servant.ServerSpec import Servant.ServerSpec
@ -22,6 +22,7 @@ import Servant.ServerSpec
type Api = type Api =
"get" :> Get Person "get" :> Get Person
:<|> "capture" :> Capture "name" String :> Get Person :<|> "capture" :> Capture "name" String :> Get Person
:<|> "body" :> ReqBody Person :> Post Person
api :: Proxy Api api :: Proxy Api
api = Proxy api = Proxy
@ -29,22 +30,28 @@ server :: Application
server = serve api ( server = serve api (
return alice return alice
:<|> (\ name -> return $ Person name 0) :<|> (\ name -> return $ Person name 0)
:<|> return
) )
withServer :: (URIAuth -> IO a) -> IO a withServer :: (URIAuth -> IO a) -> IO a
withServer action = withWaiDaemon (return server) (action . mkHost "localhost") withServer action = withWaiDaemon (return server) (action . mkHost "localhost")
getA :: URIAuth -> EitherT String IO Person getGet :: URIAuth -> EitherT String IO Person
getB :: String -> URIAuth -> EitherT String IO Person getCapture :: String -> URIAuth -> EitherT String IO Person
(getA :<|> getB) = client api getBody :: Person -> URIAuth -> EitherT String IO Person
(getGet :<|> getCapture :<|> getBody) = client api
spec :: Spec spec :: Spec
spec = do spec = do
it "Servant.API.Get" $ withServer $ \ host -> do it "Servant.API.Get" $ withServer $ \ host -> do
runEitherT (getA host) `shouldReturn` Right alice runEitherT (getGet host) `shouldReturn` Right alice
it "Servant.API.Capture" $ withServer $ \ host -> do it "Servant.API.Capture" $ withServer $ \ host -> do
runEitherT (getB "Paula" host) `shouldReturn` Right (Person "Paula" 0) runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.ReqBody" $ withServer $ \ host -> do
let p = Person "Clara" 42
runEitherT (getBody p host) `shouldReturn` Right p
-- * utils -- * utils