test suite: quickcheck property for a more complex client function
This commit is contained in:
parent
10fa62e666
commit
fd636ead19
2 changed files with 32 additions and 3 deletions
|
@ -90,6 +90,7 @@ test-suite spec
|
||||||
, http-types
|
, http-types
|
||||||
, network >= 2.6
|
, network >= 2.6
|
||||||
, network-uri >= 2.6
|
, network-uri >= 2.6
|
||||||
|
, QuickCheck
|
||||||
, servant
|
, servant
|
||||||
, string-conversions
|
, string-conversions
|
||||||
, text
|
, text
|
||||||
|
|
|
@ -8,15 +8,17 @@ module Servant.ClientSpec where
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad.Trans.Either
|
import Control.Monad.Trans.Either
|
||||||
import Data.Foldable
|
import Data.Char
|
||||||
|
import Data.Foldable (forM_)
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Network.URI
|
import Network.URI
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
import Network.Wai.Handler.Warp
|
import Network.Wai.Handler.Warp
|
||||||
import Prelude hiding (mapM_)
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
import Test.Hspec.QuickCheck
|
||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.Client
|
import Servant.Client
|
||||||
|
@ -31,6 +33,12 @@ type Api =
|
||||||
:<|> "param" :> QueryParam "name" String :> Get Person
|
:<|> "param" :> QueryParam "name" String :> Get Person
|
||||||
:<|> "params" :> QueryParams "names" String :> Get [Person]
|
:<|> "params" :> QueryParams "names" String :> Get [Person]
|
||||||
:<|> "flag" :> QueryFlag "flag" :> Get Bool
|
:<|> "flag" :> QueryFlag "flag" :> Get Bool
|
||||||
|
:<|> "multiple" :>
|
||||||
|
Capture "first" String :>
|
||||||
|
QueryParam "second" Int :>
|
||||||
|
QueryFlag "third" :>
|
||||||
|
ReqBody [(String, [Rational])] :>
|
||||||
|
Get (String, Maybe Int, Bool, [(String, [Rational])])
|
||||||
api :: Proxy Api
|
api :: Proxy Api
|
||||||
api = Proxy
|
api = Proxy
|
||||||
|
|
||||||
|
@ -45,6 +53,7 @@ server = serve api (
|
||||||
Nothing -> left (400, "missing parameter"))
|
Nothing -> left (400, "missing parameter"))
|
||||||
:<|> (\ names -> return (zipWith Person names [0..]))
|
:<|> (\ names -> return (zipWith Person names [0..]))
|
||||||
:<|> return
|
:<|> return
|
||||||
|
:<|> \ a b c d -> return (a, b, c, d)
|
||||||
)
|
)
|
||||||
|
|
||||||
withServer :: (URIAuth -> IO a) -> IO a
|
withServer :: (URIAuth -> IO a) -> IO a
|
||||||
|
@ -56,12 +65,16 @@ getBody :: Person -> URIAuth -> EitherT String IO Person
|
||||||
getQueryParam :: Maybe String -> URIAuth -> EitherT String IO Person
|
getQueryParam :: Maybe String -> URIAuth -> EitherT String IO Person
|
||||||
getQueryParams :: [String] -> URIAuth -> EitherT String IO [Person]
|
getQueryParams :: [String] -> URIAuth -> EitherT String IO [Person]
|
||||||
getQueryFlag :: Bool -> URIAuth -> EitherT String IO Bool
|
getQueryFlag :: Bool -> URIAuth -> EitherT String IO Bool
|
||||||
|
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
|
||||||
|
-> URIAuth
|
||||||
|
-> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
|
||||||
( getGet
|
( getGet
|
||||||
:<|> getCapture
|
:<|> getCapture
|
||||||
:<|> getBody
|
:<|> getBody
|
||||||
:<|> getQueryParam
|
:<|> getQueryParam
|
||||||
:<|> getQueryParams
|
:<|> getQueryParams
|
||||||
:<|> getQueryFlag)
|
:<|> getQueryFlag
|
||||||
|
:<|> getMultiple)
|
||||||
= client api
|
= client api
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
|
@ -91,6 +104,15 @@ spec = do
|
||||||
it (show flag) $ withServer $ \ host -> do
|
it (show flag) $ withServer $ \ host -> do
|
||||||
runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
|
runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
|
||||||
|
|
||||||
|
modifyMaxSuccess (const 20) $ do
|
||||||
|
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
|
||||||
|
property $ forAllShrink pathGen shrink $ \ a -> \ b c d ->
|
||||||
|
ioProperty $ do
|
||||||
|
withServer $ \ host -> do
|
||||||
|
result <- runEitherT (getMultiple a b c d host)
|
||||||
|
return $
|
||||||
|
result === Right (a, b, c, d)
|
||||||
|
|
||||||
|
|
||||||
context "client correctly handles error status codes" $ do
|
context "client correctly handles error status codes" $ do
|
||||||
let test :: WrappedApi -> Spec
|
let test :: WrappedApi -> Spec
|
||||||
|
@ -156,3 +178,9 @@ openTestSocket = do
|
||||||
listen s 1
|
listen s 1
|
||||||
port <- socketPort s
|
port <- socketPort s
|
||||||
return (fromIntegral port, s)
|
return (fromIntegral port, s)
|
||||||
|
|
||||||
|
pathGen :: Gen String
|
||||||
|
pathGen = listOf $ elements $
|
||||||
|
filter (not . (`elem` "?%[]/#")) $
|
||||||
|
filter isPrint $
|
||||||
|
map chr [0..127]
|
||||||
|
|
Loading…
Reference in a new issue